commit 3132f65611823cabf3149d2a9ef7f3d4c7bacd18 Author: sam Date: Tue Aug 19 19:19:38 2003 +0000 * Imported original elk 3.0 tree. git-svn-id: svn://svn.zoy.org/elk/trunk@1 55e467fa-43c5-0310-a8a2-de718669efc6 diff --git a/BUGS b/BUGS new file mode 100644 index 0000000..711e0a9 --- /dev/null +++ b/BUGS @@ -0,0 +1,35 @@ +Generational/Incremental Garbage Collector + + The generational, incremental garbage collector still is considered + experimental, although it stands up well in some real applications. + Here is a list of known problems: + + o On a Sun (Sun-4/SunOS4 or 5) when compiling Elk with gcc (2.6.3 + or older), the generational garbage collector sometimes loops + (when working in non-incremental mode). This can be circumvented + by compiling src/proc.c (yes, proc.c, not heap.c) without the -O + option. We are not sure yet whether this is a bug in Elk or in gcc. + + o Running out of memory when expanding the heap shouldn't be handled + as a fatal error. Instead, the garbage collector should clean up + and then invoke Uncatchable_Error() to return control to the Scheme + program. + + o The return value of ExpandHeap() is sometimes ignored. + + o When running the program + + (garbage-collect-status 'generational 'incremental) + (define (f) (make-list 10000 'a) (f)) + (f) + + the pairs in the lists become stable quickly and aren't reclaimed, + as the current algorithm favors heap expansions over full collections. + + o With the same test program, the GC sometimes crashes with SIGSEGV + after having expanded the heap to 9MB. + + o Under HP-UX 9.0 and AIX 4.1, the GC doesn't work in incremental mode + (a broken-heart is passed to Memoize_Frame() after an ExpandHeap()). + + o The percentage displayed at the end of a GC run is sometimes wrong. diff --git a/CHANGES b/CHANGES new file mode 100644 index 0000000..863fe83 --- /dev/null +++ b/CHANGES @@ -0,0 +1,508 @@ +Changes from release 2.2 to release 3.0 + + General: + + o A new C/C++ Programmer's Manual for Elk is now available + (60+ pages with many examples). See doc/README (item `cprog') + and doc/cprog. + + o The documentation has been prepared for translation to HTML + using the (Elk-based) `unroff' package. + + o Elk now uses a new Scheme object representation (a `struct' rather + than an `unsigned long') to make it work on 64-bit architectures + and to allow for larger heaps, a wider range of fixnums, and more + first-class Scheme types. + o As a consequence, the `pointer_constant_high_bits' are gone, as + is util/pchb.c. + + o Elk has been ported to and tested on these new platforms (config + files are included in the distribution): + + DEC/Alpha, OSF/1 + HP 9000, HP-UX 10.0 + i386/486, BSDI BSD/OS + i386/486, Linux + IBM PowerPC, AIX 4.1 + + o A number of config files for obsolete platforms have been removed + from the distribution; config files for platforms where Elk 3.0 + could not be tested are in config/untested. util/sgihack.c is gone. + + o Extension initialization and finalization functions now begin + with `elk_init_' rather than just `init_' to avoid name conflicts. + + o The directory `contrib' has been removed from the distribution, + as most of the contributions either were no longer maintained + or have been made an official part of the distribution. + contrib/eval-string is now available as lib/misc/elk-eval.c. + + o Site/platform-specific information such as the various X11 `load + libraries', machine name, operating system name, as well as the + Elk version number are now available as Scheme variables in + scm/siteinfo.scm. The file is created automatically and can be + loaded via `(require 'siteinfo)'. + + o Most of the improvements in scm/debug-new.scm have been merged + into the baseline debug.scm and the former has been removed. + The inspector now starts at the correct frame when called after + an error. + + o examples/CC/class.c is a simple Elk extension demonstrating + encapsulation of a C++ class in a Scheme type. + + o The file README has been renamed ROADMAP; RELEASE is now README. + + Interpreter kernel: + + o Many bugs have been fixed, and the code has been made `64-bit clean'. + + o New functions for application writers to read/set the `error tag' + displayed in error messages and the application name (Get_Error_Tag, + Set_Error_Tag, Set_App_Name). + + o When dynamically loading objects, the C++ static constructors are + now called _before_ all extension initializers. Ditto for C++ + destructors and extension finalizers. + + o New function for application/extension writers to load a file + whose name is given as a C string (Load_File). + o Load_Source_Port has been made `official' and may be used from + outside the interpreter. + + o New functions for application/extension writers to convert + Scheme numbers to C unsigned int/long: Get_Unsigned, + Get_Unsigned_Long, Get_Exact_Unsigned, Get_Exact_Unsigned_Long. + New function Get_Exact_Long. + + o The `round' primitive now rounds to even for numbers halfway + between two integers. + + o The reader doesn't impose a limit on the length of strings and + symbols any longer. + + o The dynamic loading implementations now use the environment + variable TMPDIR if present. + + o `dump' now works under SGI Irix 5.x. + + o New constants ELK_MINOR and ELK_MAJOR for application/extension + writers. + + o Symbols containing special characters now print correctly when + output with `write'. + + o Various optimizations in the interpreter's inner loop to compensate + for the performance loss caused by the struct-based object + representation on some platforms. + + Extensions: + + o The X11 extensions now work with X11 Release 6, Sun OpenWindows 3.x, + and Sun Motif. + + o Extension-specific include files (unix.h, xlib.h, xt.h) are now + installed in a subdirectory $install_dir/include/extensions + for use by applications. + + o The object files for Athena or Motif widgets are now loaded + by means of `require'. + + o New regular expression extension (see doc/regexp and + examples/regexp). + + o The file hunk.c has been removed from lib/misc, as it no longer + serves any purpose. + + o Several bugs have been fixed in the UNIX and X11 extensions. + + + +Changes from release 2.1 to release 2.2 + + General: + + o Elk ported to new platforms: SGI Irix 5.1, HP-UX 9.0 + + o All Scheme files now end with the suffix `.scm' + o Introduced new symbols in the config files to be used by the + UNIX extension + o Reorganized the include files. Split external declarations + into `private' (intern.h) and `public' (extern.h) declarations + to be used by extensions + + o It's no longer necessary to specify multiple destination + directories in the site file (only install_dir; subdirectories + are created automatically) + o `init_objects' is gone from the site file, see INSTALL for a + new, simpler way to link extensions or an application with Elk + statically + o New directory $install_dir/lib is created with files module.o, + standalone.o and shell scripts linkscheme, makedl, and ldflags + (see INSTALL) + + o Elk can now be used by applications that must have their own + main() function. See INSTALL for details. + + Interpreter kernel: + + o New primitives to allow blocking of signals from within Scheme + code: disable-interrupts, enable-interrupts + o Changed Disable_Interrupts and Enable_Interrupts macros to + allow nesting and to handle signals used by extensions + (specifically by the new UNIX extension) + o Extended representation of continuations to carry current + interrupt nesting level and restore it when being called + o (Re-)enable interrupts in toplevel on error + o Added default signal handlers for SIGPIPE and SIGHUP to clean + up temporary files + + o New primitive: `features' + o `require' now appends .scm to feature name to obtain file name + (if no file name has been specified and if the feature name + doesn't have a suffix yet) + o Features elk:dump and elk:load-object are provided by the + interpreter if dump and dynamic loading are supported + + o Implemented Register_Onfork() and Call_Onfork() to provide + `fork handlers' (used, for instance, by the UNIX extension) + o Added fork handlers to the dynamic loading implementations to + create links for the temporary files + + o Added a close function to I/O ports to allow for pipe-based ports + o New primitive: char-ready? + + o Added a check to the code that restarts a dumped interpreter + to detect that the start address of the stack has been moved + with respect to the original invocation (this happens between + Sun-4c and Sun-4m architectures, for instance) + + o Modified math.c to implement the distinction between exact and + inexact numbers as required by the language definition + o New primitives: exact->inexact, inexact->exact + o The number prefixes #e and #i are now supported + o Floating point numbers are no longer automatically reduced to + integers; new conversion function Make_Flonum(double) in + addition to Make_Reduced_Flonum(double) + o Added new conversion functions to cleanly distinguish between + C ints and longs: Get_Long(Object), Make_Long(long), + Make_Unsigned_Long(unsigned long), and functions to convert + bignums from/to C longs + o New conversion functions for exact integers: + Get_Exact_Integer(Object) and Get_Exact_Long(Object) + + o Removed the unique `void' type; #v is now converted into the empty + symbol by the reader; void? remains for compatibility + + o Implemented reader table for #-syntax + o New function Define_Reader() to allow extensions to register + their own read syntaxes (used by the new bitstring extension) + o Exported parts of the reader to simplify writing new reader + functions in extensions + + o New functions/macros to convert Scheme strings and/or symbols + into C strings (to be used by extension writers): Get_String, + Get_Strsym, Get_String_Stack, Get_Strsym_Stack; see src/cstring.c + o Now obsolete: Declare_C_Strings, Dispose_C_Strings, Make_C_String + + o Bug fixes: + o fixed a few bugs in the implementation of continuations and + tail call optimization and in the generational, incremental + garbage collector + o there was a bug in the interaction between the garbage + collector and `dump' + o identified additional critical sections to be protected + from delivery of signals + o initscheme.scm wasn't resolved against the load-path + o quasiquotation now also works for vectors (kudos to + Tor Lillqvist for suggesting a simple fix) + o a bug in src/load-ld.c could cause the first static variable + in a dynamically loaded .o file to not be zeroed + + Extensions: + + o New UNIX extension; see doc/unix for the reference manual and + examples/unix for a few demonstration programs + + o New record extension; see doc/record for the reference manual. + The `struct' extension is now obsolete + + o New arbitrary-length bitstring extension; see doc/bitstring + for the manual + + +Changes from release 2.0 to release 2.1 + + General: + + o New configuration files for the 386/486-PC running 386BSD and + DOS/DJGPP, for Suns running Solaris 2.1 (SunOS 5.1, and for + the Convex C230 running ConvexOS. + o Reorganized the config files and the site file to allow for + configuration of the generational, incremental garbage collector + o Introduced several new symbols in the config files to simplify + installation on several systems + o Added new targets to all Makefiles to allow `cross-localization' + of the source tree (see comments in DOS section in MACHINES) + + Interpreter kernel: + + o Added a generational, incremental garbage collector + o New primitives: garbage-collect-status, collect-incremental + o Reorganized the source files to accommodate the new garbage + collector and to separate garbage collector specific code + from code common to both garbage collectors + + o Empty list no longer counts as false; added primitive + `empty-list-is-false-for-backward-compatibility' + + o Changed delimiter character in load-path argument of -p option + from comma to colon + o Initialize load-path from ELK_LOADPATH environment variable + (if present) + + o Added argument to -v option to control which messages to print + (linker command, init/finit functions) + o It's no longer considered an error if an object file contains + no initializers + + o Completely rewritten implementations of `dump' for ELF (SysVR4, + Solaris 2.x), ECOFF (Ultrix, Irix), and HP9000 a.out formats; + the HP version now correctly handles shared libraries + o Added support for dynamic loading under SysVR4 and Solaris 2.x + (see comments in MACHINES) + o Added code to read symbol table of object files on the Convex + + o Bug fixes: + o dynamic-wind was completely broken; fixed it + o fixed a bug in the code that checks for the stack growing + direction (caused dumped images to crash on startup) + o fixed a bug in the equal? predicate (could enter an + infinite loop when applied to environments) + o Fixed a number of portability problems, among them: + o added O_BINARY flag to open() calls and "b" mode to fopen() + calls where necessary + o added support for the many different ways to purge a file + pointer and tty file descriptor (src/read.c, src/print.c) + + o Integrated the functionality of the `libutil.a' library from + older releases into the interpreter kernel (conversion of + symbols and lists of symbols to bit masks and vice versa; + routines to manage a pool of weak pointers to objects, used + mainly by the Elk X extensions + + Extensions: + + o Removed libutil.a (lib/util/*); moved the code into the + interpreter kernel (src/terminate.c; src/symbol.c); removed + libutil.a from the default load-libraries + o Renamed lib/misc/c++.[co] to lib/misc/newhandler.[co] (c++.c isn't + a valid filename under DOS) + o Added finit function to lib/misc/monitor.c to switch off + monitoring and write mon.out on exit + + Elk/X: + + o The X extensions are no longer pre-linked against the required + X libraries (by means of ld -r); resolving against system libs + now always takes place at load time + o make-gcontext and copy-gcontext now can be called with a drawable + (i.e. pixmap or window) + o New primitives: alloc-color alloc-named-color + o Removed window-unique-id primitive + o Fixed a few bugs in the Xt extension (editres now works with + Scheme programs); removed an artificial limitation + o Defined a GC visit function for widgets that visits each widget's + parents and the children of composite widgets + o Added support for Motif gadgets + + +Changes from release 1.5 to release 2.0 + + General: + + o The build and install process has been improved significantly (see + file INSTALL) + o Added a new directory "config" that holds the system-specific + configuration files and the site-file + o Added a build shell script and a unified Makefile to all + directories; "build" creates the ``real'' Makefiles containing + system- and site-specific details during the make process + o Added install, lint, clean, and distclean targets to all + Makefiles + o Placed files that are needed during runtime (dynamically loadable + object files, Scheme files, the interpreter itself) into separate + directories; added "make install" to put files there + + o Simplified porting Elk to new systems (assembly language support + and a stack-extending version of "alloca" are no longer required) + o Tested on several new systems (IBM RS/6000, HP9000/700, SGI, + Sony; see the file MACHINES) + + o Placed new files CONTRIBUTORS, MIGRATE, and TODO into the toplevel + directory of the distribution + o Added a directory "util" that contains tools to simplify porting + Elk to new environments and other utilities that are useful on + some systems + o Added a directory "scripts" that holds the shell scripts used + to link instances of the interpreter and extensions. + o Removed "stk" directory with test programs (no longer needed) + + o Added ANSI C prototypes and C++ "extern C" to all include files + + Interpreter kernel: + + o Placed include files into a separate directory (include) + o Reorganized the source files (separate source files for different + a.out formats and different dynamic loading mechanisms) + o Changed the way new Scheme objects are allocated to support the + generational garbage collector (not yet present in Elk) + o Rewrote the code implementing continuations to support full + call/cc on all machines + o Fixed tail recursion optimization + o Added support for POSIX signals (as alternative to BSD reliable + signals) + o Removed several artificial limitations (such as max. number of + before-GC and after-GC functions and statically GC-linked objects) + o Removed code that depended on max. number of open files per process + o Added bi-directional ports (input-output-ports); new primitive: + open-input-output-port + o New primitive: port-line-number + o Reader now prints line number on syntax error + o Max. length of a pathname is now determined correctly (using the + POSIX incantations if applicable) + o Added code to support dynamic loading under HP-UX (src/load-shl.c) + o Added code to call extension finalization functions and C++ + destructors on termination + o Fixed and improved the code to call extension initialization + functions and C++ constructors on startup or when loading + extensions + o Improved the mechanism to suppress initialization of statically + linked extensions on startup ("dont_init_if_name" in config/site) + o Can use ANSI "atexit" as alternative to redefining "exit" + o Added option -p to specify load path + o Scheme file "initscheme" is now loaded before the toplevel is + loaded + o Changed "rand" to use rand() if random() isn't there + o re-entrant-continuations? primitive is no longer needed (returns + always #t now) + o Added a general mechanism to register termination functions for + individual objects (e.g. to close files on GC); see src/terminate.c + o linkscheme shell script improved; added code to support the + stupid AIX linker + o Fixed numerous things that caused lint or "gcc -ansi" to complain + o Changed the dynamic loading, "dump", and a.out symbol table reading + code in numerous places to make it work on new systems and to make + it more readable and maintainable + + Extensions: + + o Combined lib/util/symbol.o and lib/util/objects.o into new library + libutil.a; put this library into the default "load-libraries" + o Moved lib/util/string.c and lib/util/string.h into the interpreter + o Moved files from lib directory into new subdirectory "misc" + o Added POSIX sysconf stuff to unix.c to determine max. number of + open files per process + + Elk/X: + + o Made the code mostly "lint clean" and "gcc -ansi clean" + o Fixed bogus variable definitions in xlib.h and xt.h + o Xlib: added support for client-message event + o Xt: added code to avoid a bug in Motif 1.1.4 + o Xt: added optional "mask" argument to context-add-input + o Removed site-dependent information from scm/xwidgets (file is + now created from scm/xwidgets.src during the build process) + o Renamed widget .d files that were longer than 14 characters; + added ALIASES file for each widget set containing mappings from + real widget names to short names + + Documentation: + + o Added sub-directory "paper" containing a draft version of a + paper about Elk + + User-contributed extensions: + + o A foreign function interface, an Elk Shell, and a vector extension + have been contributed by J. P. Lewis (contrib/zelk). + + +Changes from release 1.4 to release 1.5 + + General: + o Added a "contrib" directory for user-contributed extensions + that I have not fully tested and/or integrated into Elk + o Renamed ORIGIN to COPYRIGHT + + Interpreter kernel: + o Added support for the Amiga, A/UX and System V Release 4 + (ELF a.out format) + o Added special load-library for MIPS (-lc_G0) + o Extension-interface: replaced Val() by Var_Set()/Var_Get() + o Modified load, autoload, and require so that multiple .o-files + can be loaded simultaneously + o Added -1+ as a synonym for 1- + o Bug fixes: + o fixed a GC-related bug + o fixed a bug that occurred when allocating a very large heap + o fixed a bug in case-insensitive string comparison + o fixed a bug in macro "when" + o changed and clarified semantics of print-depth/print-length + o IEEE 1178/R^4RS compatibility: + o replaced close-port by close-input-port and close-output-port + o added primitives caaaar .. cddddr + o added peek-char primitive + o added -i option for case-insensitive operation + o Removed -bc option + o Removed CBREAK-hack in read-char + + Elk/X: + o Fixed several GC-related bugs (objects belonging to Xlib/Xt are + no longer terminated by garbage collector when unreferenced) + o Fixed a bug in the interface to the Grip widget + o Modified code to load widgets to make use of new capability to + load multiple .o-files + + Documentation: + o Interpreter kernel: documented new functions, clarified + some sections + o Xlib/Xt: documented X-related behavior of garbage collector, + pointed out GC-related pitfalls + + +Changes from release 1.3 to release 1.4 + + Interpreter kernel: + o Support for the NeXT machines added + o New primitive list? provided + o Two bugs in the tail recursion code fixed + o -v option to trace /bin/ld-calls + o man-page written + + Elk/X: + o Tested under X11R5 + o X11R3 and earlier versions are no longer supported + o The HP-widget code has been removed from the distribution + + o New Xlib-primitives: install-colormap uninstall-colormap + list-installed-colormaps xlib-release-5-or-later? + + o Xt interface now supports actions and accelerator tables + o Bug in set-context-fallback-resources! fixed + o New Xt-functions: widget-name widget-translate-coordinates + application-initialize context-add-action install-accelerators + install-all-accelerators xt-release-5-or-later? + + o Support for new widget classes: menubutton panner porthole repeater + simplemenu sme smebsb smeline stripchart tree + o vpaned renamed to paned + + o Example programs have been moved into a new examples directory + with sub-directories for Scheme, Xlib, Xaw, Motif + + o New Xaw example programs that demonstrate the new widget classes, + accelerators, actions, etc. + + Other extensions: + o Interface to the GNU gdbm-library diff --git a/CONTRIBUTORS b/CONTRIBUTORS new file mode 100644 index 0000000..a99ecd0 --- /dev/null +++ b/CONTRIBUTORS @@ -0,0 +1,29 @@ +Numerous users of the Extension Language Kit (too many to mention them +all) have contributed ideas, suggestions for improvements, bug reports, +source code, useful feedback, as well as other kinds of support to this +and earlier releases. Their help has made the present version of Elk +Extension Language Kit a genuinely collective effort. + +I'm especially obliged to my former colleague Carsten Bormann, who +has significantly influenced the design of Elk since the beginning +of the project in 1987. Carsten also wrote most of the bignum code. + +I also would like to thank Claus Bathe of NME Berlin for securing the +permission from his management to publish Elk 1.2 (from which the +present version has been derived), and Prof. Dr. Sigram Schindler for +providing the work environment for my research work at Technische +Universitaet Berlin. + +In addition, I would like to thank Nick Betteridge, Stephen Bevan, +Alan Bishop, Tim Bradshaw, Paul Breslaw, Dennis Brueni, Thomas Dickey, +Ted Dunning, Gerhard Eckel, Walter Eder, Joe Esch, Mikel Evins, +Ed Ferguson, Ram Firestone, Robert Forsman, Ken Fox, Thomas Gellekum, +Robert Glickstein, George Hartzell, Robert Henry, Don Hopkins, +Xiaoli Huang, Bill Janssen, Rob Jellinghaus, Robert Joop, Kazuhiko Kato, +Doo-Hwan Kim, Bengt Kleberg, Richard Kreutzer, Richard Kuhns, Dinh Le, +John Lewis, Tor Lillqvist, Christopher Maeda, Steven Majewski, +Craig McPheeters, Zdzislaw Meglicki, Perry Metzger, Lars Nyman, +Richard O'Keefe, Bob Pendelton, Flip Phillips, Norbert Preining, +Dave Richards, Robert Sanders, Supreet Singh, Martin Stut, Brian Taylor, +Scott Watson, and Mike Wray. I apologize for any omissions from +this--necessarily incomplete--list. diff --git a/COPYRIGHT b/COPYRIGHT new file mode 100644 index 0000000..95ddc54 --- /dev/null +++ b/COPYRIGHT @@ -0,0 +1,28 @@ +Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin +(except for the contents of the directory `doc/usenix'). + +This software was derived from Elk 1.2, which was Copyright 1987, 1988, +1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written +by Oliver Laumann (me) for TELES Telematic Services, Berlin, in a joint +project between TELES and Nixdorf Microprocessor Engineering, Berlin). + +Oliver Laumann, TELES GmbH, and Nixdorf Computer AG, as co-owners or +individual owners of copyright in this software, grant to any person or +company a worldwide, royalty free, license to + + i) copy this software, + ii) prepare derivative works based on this software, + iii) distribute copies of this software or derivative works, + iv) perform this software, or + v) display this software, + +provided that this notice is not removed and that neither Oliver Laumann +nor Teles nor Nixdorf are deemed to have made any representations as to +the suitability of this software for any purpose nor are held responsible +for any defects of this software. + +THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE. + +Berlin, June 20, 1995 + +Oliver Laumann diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..2b12483 --- /dev/null +++ b/INSTALL @@ -0,0 +1,168 @@ +Compilation and Installation Instructions for Elk +------------------------------------------------- + + +1. Change to the directory "config" and choose the configuration file for + your type of system. + + The names of the config files have three parts separated by dashes: + machine-os-compiler. "machine" identifies the type of hardware, "os" is + the operating system name and version, and "compiler" identifies the C + compiler to be used to compile Elk. + + When you have selected a config file, make a symbolic link "system" to + it (or a hard link, or copy it), for example: + + ln -s alpha-osf1-cc system + + If you can't find a suitable config file for your system, create a new + one by copying one of the existing files (preferably one that resembles + your platform). Edit the new file and change the definitions that need + to be changed for your type of platform. + + Alternatively, you may find a suitable config file in config/untested. + These config files have been provided by users of earlier Elk releases, + or they are for platforms to which I don't have access any longer. In + any case, they may or may not work, as the current Elk release has not + been tested with any of these. + + +2. Edit the file config/site and have a look at the definitions. Change + "install_dir" to point to the directory under which the Elk runtime + system will be installed on your system. Also, remove -L/usr/X11/lib + from all definitions if the X libraries reside in a standard location. + + config/sites holds a few locally used site files for different + operating systems; you may find these useful (in particular the libx* + definitions). + + +3. Change back to the directory where you unpacked the distribution and + have a look at the SUBDIRS definition in the Makefile. Delete any + components that you don't want to install (for example, delete + lib/xm and lib/xm/xt if you don't have Motif and/or don't want the + Motif extension). + + +4. You may want to look up your type of platform in the file MACHINES for + further information and potential pitfalls with specific compilers and + operating system versions. + + +5. Run "make install" (or just "make" and then "make install"). + + +6. Invoke the Scheme interpreter ($install_dir/scheme) and test it by + typing a few Scheme expressions or by loading some of the example + programs from the "examples" directory tree. + + If your platform supports dynamic loading of object files, test it by + loading, for example, one of the programs from examples/unix. You + may also want to run some of the X11 demonstration programs to check + whether the X11 extensions work. + + If freezing of a running program into a new executable ("dump") is + supported, test it by typing "(dump 'newelk)", then quit the interpreter, + and finally invoke newelk and see if it works. + + +7. If your system does not support dynamic loading of object files, you + may want to create an instance of the interpreter that is linked + with a number of extensions statically. For example, to create an + interpreter with the UNIX extension, you can change to $install_dir and + type: + + lib/linkscheme unixelk runtime/obj/unix.o runtime/obj/record.o + + (see below for more information). Invoke the newly created unixelk + interpreter and test it with the examples programs in examples/unix. + + + +Roadmap for $install_dir (files that are created by running "make install") +--------------------------------------------------------------------------- + + ++-- bin ---- scheme The Scheme interpreter proper +| +| ++-- include -- The include files to be included by Elk extensions and by +| applications using Elk (actually, only "scheme.h" is used; +| scheme.h then includes the right files). config.h is created +| automatically; do not edit it. The include files may or may +| not use function prototypes, depending on the config file you +| used for building Elk. +| +| ++-- runtime --+-- scm -- The Scheme files used by Elk during runtime, such +| | as the interactive toplevel and the debugger +| | +| `-- obj -- The dynamically loadable objects used at runtime. +| The directory may be empty if your platform does +| not support dynamic loading. There are sub- +| directories for the Athena widgets and Motif +| extensions holding one object per widget class +| +| ++-- lib --+-- standalone.o The Scheme interpreter as an object file. This + | file can be linked with extensions or with your + | application to produce a runnable executable. + | On startup the executable automatically invokes + | extension initializers (beginning with elk_init_) + | and C++ static constructors by scanning its own + | symbol table (ditto for finalizers/destructors). + | You may want to use the script linkscheme to link + | with standalone.o, as additional libraries may + | be required. + | + +-- module.o Like standalone.o, except that it doesn't have + | a main() function. main() must be provided by + | your application and must call Elk_Init(): + | + | Elk_Init(int argv, char **argv, int initflag, + | char *file); + | + | argc/argv are the arguments of your main(). You + | may change them, but argv[0] MUST be the original + | argv[0] (Elk_Init takes its address to determine + | the stackbase. If initflag is non-zero, Elk_Init + | calls the extension initializers as described + | above. file is zero or the name of a Scheme file + | to be loaded by Elk_Init. + | + +-- linkscheme Shell script to link standalone.o with a number + | of object files (extensions or your application) + | and libraries. The first argument is the name of + | the output file; all other arguments are passed + | to the linker. + | + +-- makedl Shell script to create a dynamically loadable + | object from one or more .o files. The first + | argument is the output file name. + | + `-- ldflags Prints the flags to be used when linking files + with Elk (with standalone.o or module.o). You + may use this in your Makefiles. + +For more details, read the C/C++ Programmer's Manual (doc/cprog). + + + +How the Makefiles in the Elk distribution are organized +------------------------------------------------------- + +Each source directory contains a small Makefile with a few standard rules; +all these Makefiles are basically identical. The actual rules are in +Makefile.local in each directory; Makefile.local is automatically created +on the fly by a shell script `build' in each directory whenever +Makefile.local is out-of-date with respect to config/system or config/site. + +The `build' scripts "localize" the information in each Makefile.local by +performing variable substitutions based on the definitions in config/system +and config/site. `build' also localizes a few other files that contain +site-specific information, such as include/config.h and scm/siteinfo.scm. + +`make clean' causes everything to be rebuilt the next time `make' is invoked. +`make distclean' also deletes the Makefile.local instances, causing each +Makefile.local and all other files with site-specific contents to be rebuilt +as well. diff --git a/MACHINES b/MACHINES new file mode 100644 index 0000000..e928df3 --- /dev/null +++ b/MACHINES @@ -0,0 +1,245 @@ +Sun-3 and Sun-4, SunOS 4.1 + + o Tested with /bin/cc, various gcc versions, and with the Sun + SPARCompiler 2.0.1 (acc). + + o For compiling Elk with gcc and the generational garbage collector, + see the remark in the file BUGS. + + o Dumped executables created on a Sun-4m (SPARCstation 10 or + SPARCstation 600) do not run on other Sun-4 architectures and + vice versa. + + +Sun-4, SunOS 5.2 (Solaris 2.2) + + o Tested with various gcc versions and with ANSI SPARCompiler 2.0.1. + If you have gcc, however, you should use it rather than the Sun + compiler. gcc produces much faster code. + + o The Motif extension has been tested with both vanilla OSF Motif 1.2 + as well as Sun's version of Motif (which usually lives in /usr/dt). + The X11 extensions have been tested with OpenWindows in addition + to X Consortium X11R6. + + o Certain versions of gcc complain about syntax errors in code that + uses sigset_t (from ), although this should not happen + unless -ansi is given. A possible fix is to add add -D__STDC__=0 + to the cflags in the config file. + + o "dump" works, but it doesn't know anything about shared objects + (the dl library doesn't support a way to get hold of the text and + data segments of dlopen()ed shared objects). Thus it's a bad idea + to invoke "dump" if any object files have been loaded into the + interpreter. + + o Dynamic loading is based on the dlopen() function of the "dl" + library. Here is a short overview of the implementation of + dlopen-based dynamic loading: + + To load an object file, the linker is called by the interpreter + to produce a shared object from the .o file. This shared object + is then loaded by means of dlopen(). + + To allow object files to reference symbols defined by object + files loaded earlier (the standard dynamic loading semantics + of Elk), the interpreter keeps tmp the output files (shared + objects) of all previous linker invocations in /tmp and uses + these as input to a each linker invocation. As a result, one + new temp file is created each time an object file is loaded. + + As the linker combines dynamically loadable object files and + (optional) libraries into shared objects, all dynamically loadable + files must have been compiled with -fpic or -K PIC (to create + position independent code). Also, all involved libraries must + either be shared libraries or must contain position independent + code as well. For example, if you want to use the Motif extension, + your Xm library must have been compiled with -fpic. + + A bug in Solaris 2.1 causes dlopen() to fail if more than + 8 shared objects are loaded (which in turn causes the "load" + primitive of Elk to signal an error). This restriction doesn't + exit in newer versions of Solaris 2. + + You can use the -v option of Elk to see the actual linker options + when an object file is loaded. + + +DECstation 5100, Ultrix 4.2 + + o Prototypes have been disabled in the config file, as cc has trouble + with certain forms of prototype declarations (this looks like a bug). + + o The LDFLAGS "-Wl,-D,800000" are required for dynamic loading to work. + + o You have to create "-G 0" versions of all X libraries to be able to + dynamically load the X11 extensions of Elk (the MIPS linker requires + this). + + +DEC/Alpha, OSF/1 + + o This platform uses ELF and the dlopen()-style linker interface. + See the section on Solaris 2 above for remarks on dynamic loading. + + +SGI IRIS Indy, Irix 5.3 + + o See SunOS 5.x above for information about dynamic loading and dump. + + o examples/unix/calc.scm doesn't work, because /usr/bin/dc uses + buffered output if stdout is not a terminal. + + o For Irix 5.2, -lSM and -lICE must be removed from the libx* + definitions in config/site (the X11 version seems to be X11R5). + + +HP 9000/700, HP-UX 9.0 and HP-UX 10.0 + + o Dynamic loading is based on the shl_load() interface to the dynamic + linker of HP-UX. If you are writing your own extensions, compile + them with the option +z and use $install_dir/lib/makedl to link them. + The load-libraries are simply shl_loaded before the files passed to + the "load" primitives. Each load-library is only loaded once. + + o wait3 has been set to `no' in the system file, because this function + has a non-standard third argument in HP-UX 9.0. + + o The "dump" implementation for HP-UX which used to work well under + HP-UX 8.x doesn't really work any longer, because HP in their + infinite wisdom have removed the MAP_REPLACE flag for mmap() in + HP-UX 9.x. + + o HP-UX 10 does have a stack-extending alloca() (in contrast to + HP-UX 9.0), but it has a serious bug and therefore is not used + by Elk (the function overwrites its argument if it is a register + variable). + + o The incremental garbage collector doesn't work (see the file BUGS). + + o The Athena widgets are not included with HP-UX 9.0; delete "lib/xaw" + from the Makefile. + + o You may want to use the HP-UX site file from config/sites. + + +IBM RS/6000, AIX 3.2 + + o Neither "dump" nor dynamic loading work. It is not clear whether + the dynamic loading semantics of Elk can be implemented with the + dynamic linker interface of AIX at all. + + o To support linking the interpreter with extensions statically, + you *have* to use the $install_dir/lib/linkscheme shell script; + it contains special code to build an `export list' to prevent + the AIX linker from `garbage collecting' the extensions. + + o -O has been omitted from the CFLAGS, as the optimizer seems to + have bugs. + + +PowerPC, AIX 4.1 (xlc and gcc) + + o No dynamic loading, no dump (see AIX 3.2 above). + + o The incremental garbage collector doesn't work (see the file BUGS). + + o If you are using gcc, and if your gcc uses the AIX linker, the + linker prints tons of bogus messages about duplicate symbols; they + can be ignored safely. You may also have to change the `*-aix4*-cc' + in the shell script `linkscheme' into `*-aix4*-gcc' to enable the + hack involving the linker export list. + + +NeXT workstation, MACH/NeXT-OS 3.3 + + o Dynamic loading is implemented by means of the rld_load() library + function. Due to what looks like a bug in rld_load(), it only + works sometimes. In particular, it is not possible to load the + UNIX extension. + + The source of the problem seems to be that sometimes the string table + of the newly loaded object file gets truncated when being mapped into + memory by rld_load(). You can observe the problem by inserting a + statement like "write(1, strtab, sym_cmd->strsize);" right after + the line beginning with "strtab =" in src/stab-macho.c. + + o Linking extensions statically with the interpreter doesn't work + either; there are no symbols in the symbol table when it is read + on startup of the executable. This seems to be related to the + bug described above. + + These two problems render Elk virtually unusable on the NeXT. + + +386/486-PC, Linux 1.2.8 + + o Dynamic loading does not work any longer, because the linker has + changed. It doesn't seem to support incremental loading any more + at all. dlopen() seems to exist now, but how does one create + a shared object from an ordinary .o file? Someone who knows + Linux well may want to look into this... + + o `dump' doesn't work either. It did work in earlier Linux versions. + + o Because of a bug in `make', all Makefiles had to be changed to + explicitly run the shell for invoking the `build' shell scripts. + + o examples/unix/calc.scm doesn't work, because /usr/bin/dc uses + buffered output if stdout is not a terminal. + + +386/486-PC, 32-bit gcc (DJGPP) and `go32' DOS extender + + o Elk 3.0 has not been tested on this platform. + + o As the typical DOS machine doesn't have a fully functional UNIX + shell, sed, etc., you have to cross-localize the source tree on a + UNIX machine (i.e. create all the localized Makefiles, create + include/config.h, etc.). To do so, just copy the DOS config file + to config/system (or make a link), edit config/site, and call + + make localized.zip + + This cleans the source tree, performs the necessary localizations, + and packages a minimal distribution into a zip file. You can + then FTP the zip file to the DOS machine and run `make' there. + The zip file basically contains the interpreter sources, the Scheme + files needed at runtime, the extensions in lib/misc, and the + localized Makefiles and include files. + + o There are a few trouble spots you should watch out for. Some versions + of `make' under DOS (Ndmake?) can't handle the macro $(MAKE) that + is defined at the beginning of all Makefiles. If this is the case + on your system, forget the Makefiles and run "make -f Makefile.local" + in each directory. You may have to replace $(O) in src/Makefile.local + by *.o to avoid command lines that are too long for the DOS shell. + You have to delete the line beginning with "../../scripts/makedl" + in misc/Makefile.local. + + +X Window System + + o You need either X11R4, X11R5, X11R6, or (on Suns) OpenWindows 3.x to + use the Elk/X11 extensions. The current release of Elk has been + tested with X11R6 and OpenWindows. + + If you are still running X11R4, edit the file lib/xaw/build and + remove the lines referring to the Athena widgets that are new in + X11R5 (panner, porthole, repeater, and tree). + + If you are running X11R5 or older, you may want to edit lib/xaw/build + and add lines for the `clock' widget. Also, remove -lSM and -lICE + from the definitions in config/site. examples/xaw/porthole.scm + and examples/xaw/viewport.scm don't work with X11R6, as they are + using the clock widget which doesn't exist any longer. + + +Motif Widgets + + o You need at least Motif 1.1 to use the Elk/Motif extension. + The current release of Elk has been tested with OSF/Motif 1.2 + and, under Solaris 2.4, with Sun Motif (/usr/dt). + + Make sure that X11 has been compiled with the symbol MotifBC set + to YES in site.def. diff --git a/MIGRATE b/MIGRATE new file mode 100644 index 0000000..2a5b97a --- /dev/null +++ b/MIGRATE @@ -0,0 +1,209 @@ +This file lists changes in the interpreter kernel that affect the C/C++ +interface to applications using Elk and to Elk extensions, and (in +rare cases) the Scheme level interface. + +Changes in release 3.0: + + o To avoid name conflicts, the names of extension initialization + (finalization) functions now begin with elk_init_ (elk_finit_). + You will have to edit your source and change the function names + accordingly. + + o The Scheme object representation ("Object") has been changed from + an unsigned long to a struct. Although the changes are backwards + compatible with the Elk 2.2 interface and should, in general, not + affect your C/C++ code, you should be aware of a few potential + trouble spots: + + o Code can no longer assume sizeof(Object) == sizeof(int). + Thus, all arguments and return values of type Object must + be declared properly. + + o You can no longer cast an `int' into an Object or vice versa. + + o You cannot compare Objects directly; use the EQ macro. + + o POINTER_CONSTANT_HIGH_BITS is gone (but you weren't supposed + to use this anyway...) + + o Initializing a local (auto) Object variable in the declaration + doesn't work any longer if you are using a K&R C compiler. + + o You can no longer enforce allocation of a specific type slot + by Define_Type(). The first argument to Define_Type() now _must_ + be zero. + + o The constant MAX_TYPE has become meaningless and will be removed + in the future. Also, SETFIXNUM and SETTYPE do not exist any + longer (SET can be used instead); SETPOINTER is obsolete. + + o There are a few new interface functions that your code may benefit + from (such as Set_App_Name); see CHANGES and the new C/C++ + Programmer's Manual (doc/cprog). + + o A few `P_*' functions have been renamed in the interpreter for + consistency. See include/compat.h. + + o In Elk 2.2, the primitives c[ad]*r and cxr just returned () + if the list was too short. Proper error checking has been + added. If your Scheme code suddenly produces errors in calls + to c[ad]*r, check the arguments. + + o All the names of converters for callbacks in lib/xaw/*.d and + lib/xm/*.d now have a prefix `callback:'. This was required + to resolve name conflicts with the converters for ordinary + resources. If you are using custom widgets or have added your + own converters to existing widgets, you will have to add the + prefix. + + +Changes in release 2.2: + + o All Scheme files in the distribution now end with the suffix .scm; + `require' now appends .scm to the feature name if no file name has + been specified. You should rename your Scheme files accordingly + (if you haven't done yet anyway). + + o Declarations that are private to the interpreter (and are not + supposed to be used by extensions) have been moved from + include/extern.h into include/intern.h. You should make sure + that extensions only use functions and variables defined in + the new include/extern.h. + + o If you have an extension that invokes fork() and that may execute + Scheme primitives in the child process, make sure that the new + function `Call_Onfork()' is invoked in the child process to call + the `fork handlers' which may have been registered by the + interpreter or by other extensions. + + o The interpreter kernel now exports functions to convert C longs + into Scheme numbers and vice versa. See CHANGES for the list of + new functions. + + o The new function Define_Reader() may be used by extensions to + define their own `#' read syntaxes. See lib/bitstring.c for an + example. + + o The macros Make_C_String, Declare_C_String, and Dispose_C_String + are now obsolete (but are retained for compatibility for a + limited time). You should use the new, improved functions/macros + mentioned in CHANGES and in src/cstring.c. + + o Get_Integer() and the new Get_Long() can be called with inexact + integers (such as the result of truncate). If you are writing + a Scheme primitive that requires its argument(s) to be *exact* + integers, use Get_Exact_Integer() or Get_Exact_Long(). + + o Elk 2.2 now correctly supports inexact integers. This may cause + Scheme code such as + + (vector-ref '#(a b c) (truncate 1.5)) + + which used to work in earlier versions of Elk to fail, as + truncate returns an inexact integer in this example. One simple + way to fix this is to use inexact->exact to convert the inexact + integer into an exact one. + + o As extensions (such as the new UNIX extension) are now allowed + to use signals, it is important that you protect critical code + sections by calls to Disable_Interrupts/Enable_Interrupts (in C) + or disable-interrupts/enable-interrupts (in Scheme). + + o The representation of Void has changed-- it is no longer a + separate, pointer-less type (like Null), but a symbol with + an empty name. As a result you now have to GC_Link variables + holding Void. + + o The old (undocumented) `struct' extension is obsolete; you + should use the new record extension (see doc/record). + + o The primitives `file-status' and `getenv' have been removed. + file-status can be approximated by functions from the new UNIX + extension like this: + + (require 'unix) + + (define (file-status file) + (let ((stat (unix-errval (unix-stat file)))) + (if (unix-error? stat) + 'non-existent + (stat-type stat)))) + + Use unix-getenv from the UNIX extension in place of the old + getenv primitive (note, though, that unix-getenv must be called + with a string; it doesn't accept a symbol). + + o The `linkscheme' shell script gets installed into a different + directory (lib) now and works in a slightly different way. + The `linkext' script is now called lib/makedl. `init_objects' + is gone; see INSTALL for a new mechanism to link extensions + with the interpreter statically. + + +Changes in release 2.1: + + o The library libutil.a (which was part of the default libraries + in earlier versions) has been removed; the code has been + integrated into the interpreter kernel. + + If you have pre-linked dynamically loadable extensions against + this library or against object files in lib/misc, just remove + the relevant commands from your Makefiles. + + o The semantics of the Truep() macro have changed; the empty + list no longer counts as false (see comment in CHANGES). + + +Changes in release 2.0: + + o The Elk include file "scheme.h" now is in a different directory + (include), so you have to change the -I option in your Makefiles. + + o is no longer included by "scheme.h", so you have + to include it in your extensions if it is required. + + o lib/string.h is included automatically if you include scheme.h. + + o It is no longer necessary to pre-link extensions against + lib/util/objects.o or lib/util/symbol.o. The files now are in + a library (libutil.a); extensions are linked against this + library automatically when they are loaded into Elk. + + o The way new Scheme objects are allocated has changed as a + side-effect of adding the necessary hooks for the generational + garbage collector (which is not yet present in Elk 2.0). + + The function Get_Bytes has been replaced by the new function + Alloc_Object. Alloc_Object already returns a Scheme `Object'; + there is no need to use SET any longer. The arguments are the + object's size in bytes, the type, and a flag indicating whether + the object is constant (constant objects may be placed into a + read-only portion of the memory in later versions of Elk). + + So you have to replace old code to allocate an object of type + T_Foo that looked like this: + + Object o; char *p; + + p = Get_Bytes (sizeof (struct S_Foo)); + SET(o, T_Foo, (struct S_Foo *)p); + + by this: + + Object o = Alloc_Object (sizeof (struct S_Foo), T_Foo, 0); + + (use 1 instead of 0 if the new object is considered immutable). + + o If you store weak pointers to objects and forward the pointers + explicitly in an after-GC function, you are now required to use + a set of new macros. See src/terminate.c and lib/util/objects.c + for examples. + + o The empty list is no longer regarded as false. To simplify + testing, you can evaluate + + (empty-list-is-false-for-backward-compatibility #t) + + to enable the old (no longer standard-conforming) semantics. + A call to this function with an argument of #f reverts to + the default behavior. diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..6ebfd98 --- /dev/null +++ b/Makefile @@ -0,0 +1,115 @@ +# SUBDIRS lists the components of Elk that are compiled and installed by +# running "make" and "make install". The subdirectory "src" holds the +# interpreter proper; a mininum configuration requires the SUBDIRS include, +# scripts, src, and scm. +# +# Subdirectories if lib/ hold the standard extensions. Delete them or +# parts of them from SUBDIRS if you don't want them to be compiled and +# installed; delete lib/xm and lib/xm/xt if you don't have Motif on your +# system. + +SUBDIRS= include\ + scripts\ + src\ + scm\ + lib/misc\ + lib/unix\ + lib/xlib\ + lib/xt\ + lib/xaw\ + lib/xm\ + lib/xm/xt + +# ---------------------------------------------------------------------- + +SHELL= /bin/sh +MAKE= make +GTAR= gtar +TAR= tar +GZIP= gzip +ZIP= zip + +default: + @for i in $(SUBDIRS) ;\ + do \ + echo Making $$i...; \ + ( cd $$i ; $(MAKE) ) || exit $$?; \ + done + +install: + @for i in $(SUBDIRS) ;\ + do \ + echo Installing $$i...; \ + ( cd $$i ; $(MAKE) install ) || exit $$?; \ + done + +localize: + @for i in $(SUBDIRS) ;\ + do \ + echo Localizing $$i...; \ + ( cd $$i ; $(MAKE) localize ) || exit $$?; \ + done + +lint: + @for i in $(SUBDIRS) ;\ + do \ + echo Linting $$i...; \ + ( cd $$i ; $(MAKE) lint ) || exit $$?; \ + done + +clean: + @for i in $(SUBDIRS) ;\ + do \ + echo Cleaning $$i...; \ + ( cd $$i ; $(MAKE) clean ) || exit $$?; \ + done + +distclean: + @for i in $(SUBDIRS) ;\ + do \ + echo Cleaning $$i...; \ + ( cd $$i ; $(MAKE) distclean ) || exit $$?; \ + done + + +# Package up all localized files (Makefile.local, include files, etc.) +# and source files into a zip file (to be compiled on a DOS system). +# The X11 extensions are not included. + +LOCALF= Makefile config/system config/site include/*.h lib/misc/Makefile*\ + lib/misc/*.c scm/[a-z]* src/Makefile* `ls -1 src/*.c |grep -v hp9k` + +localized.zip: + $(MAKE) distclean + $(MAKE) localize + $(ZIP) -kr $@ $(LOCALF) + + +# Make a full distribution + +DISTF= README ROADMAP CHANGES INSTALL MACHINES COPYRIGHT CONTRIBUTORS\ + PATCHLEVEL TODO BUGS MIGRATE Makefile config doc examples include lib\ + scm scripts src util + +dist: + echo elk-`util/getversion README'` > .rel + rm -rf `cat .rel` + mkdir `cat .rel` + for i in $(DISTF) ;\ + do \ + (cd `cat .rel`; ln -s ../$$i) \ + done + if [ -f config/site.dist ]; then \ + cp config/site config/site.old; \ + cp config/site.dist config/site; \ + fi + if [ ! -f ExcludeFiles ]; then \ + $(TAR) -cvf `cat .rel`.tar -h `cat .rel`; \ + else \ + $(GTAR) -cvf `cat .rel`.tar -h -X ExcludeFiles `cat .rel`; \ + fi + $(GZIP) -f `cat .rel`.tar + rm -rf `cat .rel` .rel + if [ -f config/site.old ]; then \ + mv config/site.old config/site; \ + fi diff --git a/PATCHLEVEL b/PATCHLEVEL new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/PATCHLEVEL @@ -0,0 +1 @@ +3 diff --git a/README b/README new file mode 100644 index 0000000..d1c5a68 --- /dev/null +++ b/README @@ -0,0 +1,193 @@ +This is release 3.0 of Elk, the Extension Language Kit. + + +What is Elk? +------------ + +Elk is an implementation of the Scheme programming language. +In contrast to existing, stand-alone Scheme systems Elk has been +designed specifically as an embeddable, reusable extension language +subsystem for applications written in C or C++. + +Developers using Elk can deliver applications with different components +written in different languages, such as an efficient core written in +C or C++ and an extensible user interface layer implemented in Scheme. +To help building hybrid application architectures, Elk supports a +tightly-knit interworking of the C/C++ parts of applications with +Scheme code. + +Elk is also useful as a stand-alone Scheme implementation, in particular +as a platform for rapid prototyping of X11-based Scheme programs. + +The Elk project was started in 1987 to support ISOTEXT, a multimedia +document editor that has been developed at the Technical University of +Berlin. The first freely available version, Elk 1.0, was published in +USENET in September 1989. Since then, Elk has been successfully used as +the extension language framework for numerous applications (commercial +products as well as free software projects). + + +Getting Elk +----------- + +You can obtain the Elk 3.0 distribution as well as additional information +about Elk in the World Wide Web at + + http://www.informatik.uni-bremen.de/~net/elk + +The distribution is also available for anonymous FTP from a number of +servers including these: + + ftp://ftp.x.org/contrib/devel_tools/elk-3.0.tar.gz + ftp://ftp.uni-bremen.de/pub/programming/languages/scheme/elk/elk-3.0.tar.gz + + +A non-trivial example application using Elk as its extension language +is available as source and pre-compiled binaries (`unroff' is a troff +translator with back-ends for HTML and the -ms and -man macros): + + http://www.informatik.uni-bremen.de/~net/unroff + + +What is new in Elk 3.0? +----------------------- + +The major improvements in Elk 3.0 are a new Scheme object representation +and a new, completely rewritten C/C++ Programmer's Manual for Elk. + +The new object representation has been suggested by Craig McPheeters, +who also contributed an initial set of patches. Its advantages are: + + o the heap size is no longer limited (except by the amount of + virtual memory that can be addressed); + o `fixnums' now occupy an entire C int; + o the number of Scheme types is no longer limited to 128 + o the new format improves compile-time checking and eases debugging; + o Elk now ports easily to 64-bit platforms such as the DEC/Alpha. + +The new C/C++ Programmer's Manual is a complete specification of the +C/C++ interface to Elk; it is intended for authors of extensible, +Elk-based applications and for extension writers. Topics range from +the general architecture of extensible applications and the use of +dynamic loading to advanced techniques such as weak data structures and +cooperation with the garbage collector. + +Also new in Elk 3.0 is a POSIX-style regular expression extension. +Elk has been ported to a number of new platforms (among them Linux, +BSD/OS, AIX 4.1, and HP-UX 10.0). A full list of changes is in the +distribution (see the files CHANGES and MIGRATE). + + +Elk features +------------ + + o Full incremental, dynamic loading + + This facility enables Scheme code to load compiled Scheme extensions + into the running interpreter (or into the application) on demand. + Complex Elk-based applications can be decomposed into dynamically + loadable components to avoid large, monolithic executables. + Furthermore, user-supplied extension need not be written entirely in + Scheme; they may include an efficient, low-level layer written in C + or C++. + + Dynamic loading in Elk is supported on many platforms and is not + restricted to a dlopen() interface. Elk provides automatic + initialization of dynamically loaded extensions and takes care of + C++ static constructors/destructors embedded in object files. + + o Freezing of fully customized applications into executable files + + Elk provides a new Scheme primitive `dump' which freezes the dynamic + runtime image of the Scheme interpreter into an executable file + (including an enclosing application if present). This facility + resembles unexec() in Emacs, but the new executable resumes execution + by returning from the call to `dump' by which that executable was + created (not unlike fork() in UNIX). Dynamic loading and `dump' + increase the usability of Elk as the backbone of complex applications. + + o Powerful C/C++ interface for language interoperability + + Elk provides for a tight integration of the C/C++ core of applications + (or extensions) with the extension language. Applications can define + their own Scheme primitives (three calling disciplines are supported), + define application-specific first-class Scheme types with customized + print and read functions, convert objects between Scheme types and + C/C++ types in various ways, implement weak data structures, raise + Scheme errors, define Scheme variables and symbols, evaluate + S-expressions encoded as C strings, and utilize the garbage collector. + + o Full Scheme bindings for X11 and Motif + + Several dynamically loadable extensions provide full Scheme access to + the X11/OpenWindows Xlib, to the application programmer interface of + the Xt intrinsics, and to the Athena and OSF/Motif widget sets. + Using these extensions, the graphical user-interfaces of Elk-based + applications can be built entirely in the extension language. + + o UNIX interface + + Elk provides Scheme access to most UNIX system calls and common C + library functions. The UNIX extension supports a wide range of + different UNIX platforms without restricting its functionality to the + lowest common denominator or to the POSIX 1003.1 functions. + + o Stop-and-copy and generational, incremental garbage collection + + Elk employs two garbage collection strategies selectable at compile + time: a traditional stop-and-copy garbage collector and a generational + garbage collector which is more efficient and thus reduces the time the + application is disrupted by a garbage collection. On platforms with + advanced memory management, `incremental' mode can be enabled for the + generational garbage collector to further reduce wait times. + + o Non-standard Scheme features + + In addition to the standard Scheme core, Elk supports first-class + environments, error handling, provide/require and autoloading, + fluid bindings and dynamic-wind, simple `eval-twice'-style macros, + property lists, string ports and bidirectional ports, shell-style + `tilde expansion' in filenames, an interactive top-level written + in Scheme, a Scheme debugger and a pretty printer, arbitrary length + bitstrings, and Scheme records. + + o Comprehensive documentation + + The distribution includes 230+ pages of fully indexed documentation. + All manuals exist as troff input files which can be translated to HTML + (with `unroff') for online browsing in addition to producing typeset- + quality printed versions. + + o Distributed in legally unencumbered form + + The copyright/license agreement permits free redistribution and use + of Elk in commercial products. + + +Why is Elk using Scheme? +------------------------ + +As extensions can get as large and complex as freestanding programs, +extension language programmers (usually the users of the application) +deserve the same language features that other programmers are +accustomed to. By using a general-purpose programming language rather +than a specialized scripting language, non-trivial extensions can +benefit from the structuring functionality inherent in real programming +languages (such as Lisp). + +Members of the Lisp language family are particularly suitable as an +extension language: Lisp has a simple syntax but powerful semantics, +it allows for small implementations, and its interactive nature +supports rapid prototyping and encourages users to explore and test +solutions to problems in an incremental way. + +Consequently, Lisp has become increasingly popular for this purpose, to +the point where the abundance of different dialects has grown into a +problem. Of the standardized dialects of Lisp, only Scheme is suitably +modest, yet sufficiently general, to serve as a reusable extension +language for a wide range of applications. Scheme is orthogonal and +well-defined, and it is small enough to not dominate the application it +serves and to be fully understood with acceptable effort. + + +Oliver Laumann diff --git a/ROADMAP b/ROADMAP new file mode 100644 index 0000000..25e997d --- /dev/null +++ b/ROADMAP @@ -0,0 +1,114 @@ +This directory holds the source code and documentation for the latest +release of Elk, the Extension Language Kit. See the file README for +an overview of Elk. + +Here is a brief roadmap for the subdirectories and files included in +the distribution. + + +elk-3.0 --+-- README Explains the purpose and release status of Elk + | + +-- CHANGES Lists the changes between this and earlier releases + | of Elk + | + +-- MIGRATE Explains how C/C++ code (applications or extensions) + | written for older versions of Elk may have to be + | modified to make it work with this version + | + +-- INSTALL Instructions for configuring, compiling, and + | installing Elk; a brief description of the files that + | get installed in the process; and a description of + | the structure of the Makefiles and the purpose of + | Makefile.local and `build' in each source directory + | + +-- MACHINES Additional, platform-specific advice for installing + | and using Elk, such as compiler bugs, unsupported + | features, problems with older OS versions and other + | pitfalls + | + +-- BUGS Information about known problems with this release + | + +-- TODO Ideas, improvements and projects for future releases + | + +-- COPYRIGHT The copyright status of the distribution + | + +-- CONTRIBUTORS + | A list of people who have contributed significantly + | to Elk; acknowledgments and credits + | + +-- PATCHLEVEL The current patchlevel + | + +-- config/ Holds the configuration files with machine- and + | site-specific information required for building + | Elk. See INSTALL for details. + | + +-- include/ The include files to be #included by applications + | that use Elk as their extension language, and by + | extensions to Elk. Including scheme.h from this + | directory causes all the other .h files to be + | included in the right order. The include files may + | or may not use ANSI/ISO-C prototypes, depending on + | the config file you have chosen. + | + +-- scripts/ Shell scripts to link the Scheme interpreter with + | extensions (useful on platforms that to not support + | dynamic loading of objects), and to create + | dynamically loadable objects from .o files. See + | INSTALL and scripts/README for details. + | + +-- src/ The C source files of the Scheme interpreter + | + +-- scm/ Scheme files that are loaded during runtime. These + | are copied to a destination directory specified in + | config/site when Elk is installed. + | + +-- lib --, This directory tree holds the C source for various + | | Elk extensions that can be loaded into the Scheme + | | interpreter or linked with an application + | | + | +-- xlib/ The C source files of the X11 Xlib extension + | | + | +-- xt/ The C source files of the Xt (X11 Toolkit + | | Intrinsics) extension + | | + | +-- xaw/ The Scheme interfaces to the X11 Athena widgets. + | | There is one .d file for each widget class. + | | Each of these is compiled into a C source file + | | when running `make' and then compiled into a + | | dynamically loadable object. + | | + | +-- xm/ The .d files for the Motif widgets + | | + | +-- unix/ The C source files of the UNIX extension + | | + | `-- misc/ The C source files of the record extension, the + | bitstring extension, the regular expression + | extension, and various other dynamically + | loadable Elk extensions + | + +-- doc/ The directory tree holding the documentation for + | Elk as troff input files and pre-generated + | PostScript files. See doc/README for a roadmap + | of the `doc' tree. + | + | + +-- examples --, A collection of demonstration programs for Elk + | | and the various extensions (mostly in Scheme) + | | + | +-- scheme Basic Scheme demos (collected from USENET + | | and other sources) + | | + | +-- xlib Programs demonstrating the Xlib, Athena, + | +-- xaw and Motif extensions + | +-- xm + | | + | +-- unix Example programs for the UNIX extension + | | + | +-- regexp A demonstration of the regexp extension + | | + | `-- CC A few simple C++ programs demonstrating + | use of Elk with C++ applications (see + | README in this directory) + | + `-- util/ Various utilities, some of which may aid in preparing + a config file for an as yet unsupported platform. diff --git a/TODO b/TODO new file mode 100644 index 0000000..cd36ed3 --- /dev/null +++ b/TODO @@ -0,0 +1,58 @@ +Interpreter kernel + + o Documentation strings. Put them into an extra field in S_Compound. + New primitives: procedure-documentation, macro-documentation. + + o It should not matter to an extension writer whether a primitive is + written in Scheme or in C -- primitives should not be invoked directly + via the P_ functions. Instead, a more general mechanism is needed. + + o include/misc.h: Reader_Tweak_Stream() should call Primitive_Error() + if ferror() is true. + + o Implement a pure heap for constant objects (should be placed into + read-only text segment by "dump"). + + o Generic print, equal, etc. functions should be provided for + extensions. + + o Treat # as comment character if file starts with #! (hard to + implement, as this requires the reader to detect beginning of line). + + o map and for-each should also work for other data structures + (such as vectors). + + o Dump for NEXT-OS/MACH. + + +Extensions + + o Motif: add support for new widgets and new functions. + + o A socket/networking extension. + + o A UNIX process interface, like that in GNU Emacs. + + o A foreign function interface generator as described in the CFI's + ``A Scheme-Based Extension Language Environment''. + + +Projects + + o Symbol completion would be very useful (but hard to implement). + + o A reasonable debugger and a better trace facility are needed. + + o An interface to Tcl/Tk. + + o The error-handler should be invoked with a symbol identifying the + error as an argument. The symbol has an error text property + holding the full text. + + o Ports: the accessor functions should be part of the port object. + + o Hash tables. Need to be rehashed on each GC. Table object + holds hash function, compare function, etc. + + o It should be possible to define new types in Scheme (not only in + extensions). New primitive: define-type (similar to define-structure?). diff --git a/config/386pc-bsdi-gcc b/config/386pc-bsdi-gcc new file mode 100644 index 0000000..52a65de --- /dev/null +++ b/config/386pc-bsdi-gcc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=386pc-bsdi-gcc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format= + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=ld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=yes + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=_ + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size= + file_text_start='N_TXTOFF(hdr)' + mem_text_start='N_TXTADDR(hdr)' + text_length_adj=0 + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=fpurge +flush_tty=tiocflush + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=arg4 + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=no +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=gcc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O2' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime= +vfork=yes +gethostname=yes +uname= +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=yes +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=int diff --git a/config/alpha-osf1-cc b/config/alpha-osf1-cc new file mode 100644 index 0000000..6b10f1d --- /dev/null +++ b/config/alpha-osf1-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=alpha-osf1-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=no-standard-return-type + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=no + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=ecoff + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=dl + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared="-shared -expect_unresolved '*'" + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=1024 + file_text_start=1024 + mem_text_start=0 + text_length_adj=0 + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tiocflush + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=siginfo + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-std1' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=no +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=yes +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/dec5100-ultrix4.2-cc b/config/dec5100-ultrix4.2-cc new file mode 100644 index 0000000..81a2eda --- /dev/null +++ b/config/dec5100-ultrix4.2-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=dec5100-ultrix4.2-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=no + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=ecoff + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=ld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc_G0' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h='' + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=yes + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=sigcontext + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags=-D_NO_PROTO + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags='-G 0' + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags='-G 0' + + +# The linker flags used to link the interpreter. + +ldflags='-lm -Wl,-D,800000' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=no + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=no +utime_h=yes +regcomp=no + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=int diff --git a/config/hp9k700-hpux10.0-cc b/config/hp9k700-hpux10.0-cc new file mode 100644 index 0000000..2055467 --- /dev/null +++ b/config/hp9k700-hpux10.0-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=hp9k700-hpux10.0-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=no + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=no + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=no +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=no +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=hp9k + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=shl + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries= + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size= + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size='(1024*1024)' + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=hpux + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=no + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h= +pragma_alloca= + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-Ae -O -DARRAY_BROKEN' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags=+z + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-Wl,-E -lm -ldld' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=no +wait4=no +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/hp9k700-hpux9.0-cc b/config/hp9k700-hpux9.0-cc new file mode 100644 index 0000000..b91b1c4 --- /dev/null +++ b/config/hp9k700-hpux9.0-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=hp9k700-hpux9.0-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=no + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=no + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=no + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=no +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=no +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=hp9k + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=shl + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries= + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size= + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size='(1024*1024)' + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=hpux + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=no + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h= +pragma_alloca= + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-Ae -O -DARRAY_BROKEN' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags=+z + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-Wl,-E -lm -ldld' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=no +rename=yes +waitpid=yes +wait3=no +wait4=no +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/i486-linux-gcc b/config/i486-linux-gcc new file mode 100644 index 0000000..0dffefa --- /dev/null +++ b/config/i486-linux-gcc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=i486-linux-gcc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=no + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=no + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include= + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=no +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format= + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=ld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc -lgcc -lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags="-x -static" + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h='' + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=yes + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=_ + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=1024 + file_text_start='N_TXTOFF(hdr)' + mem_text_start='0' + text_length_adj='0' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize=4096 + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio= +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=no + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr= + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc='gcc' + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O2' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-static -lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=yes + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=no +uname=yes +mktemp=yes +tmpnam=yes +tempnam= +getcwd=yes +getwd= +rename=yes +waitpid=yes +wait3= +wait4=yes +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/next-mach3.3-cc b/config/next-mach3.3-cc new file mode 100644 index 0000000..6fdfa09 --- /dev/null +++ b/config/next-mach3.3-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=next-mach3.3-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=no + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=no + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=no + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=no + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=macho + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=rld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='/lib/libsys_s.a' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=_ + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=no + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tiocflush + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=no + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr= + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=no +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-seglinkedit -lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=no +mktemp=yes +tmpnam=yes +tempnam=no +getcwd=no +getwd=yes +rename=yes +waitpid=no +wait3=yes +wait4=yes +utime_h=no +regcomp=no + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=int diff --git a/config/powerpc-aix4.1-gcc b/config/powerpc-aix4.1-gcc new file mode 100644 index 0000000..c4a0191 --- /dev/null +++ b/config/powerpc-aix4.1-gcc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=power-aix4.1-gcc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize= + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=xcoff + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj= + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=. + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=no + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize=4096 + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=aix + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=no +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=gcc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags=-O + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lld -lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=yes + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=no +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=no +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/powerpc-aix4.1-xlc b/config/powerpc-aix4.1-xlc new file mode 100644 index 0000000..d48fdac --- /dev/null +++ b/config/powerpc-aix4.1-xlc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=power-aix4.1-xlc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize= + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=xcoff + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj= + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=. + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=no + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize=4096 + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=aix + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=no +pragma_alloca=yes + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags=-O + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lld -lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=yes + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=no +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=no +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/powerpc-solaris2.5-cc b/config/powerpc-solaris2.5-cc new file mode 100644 index 0000000..87500bb --- /dev/null +++ b/config/powerpc-solaris2.5-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=powerpc-solaris2.5-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=no + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=no + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=elf + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=dl + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared="-G -z text" + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries= + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=yes + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=siginfo + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=/opt/SUNWspro/bin/cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=/usr/ccs/bin/ld + + +# The C compiler flags used for all files. + +cflags='-O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags='-K PIC' + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm -lelf -ldl' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=yes + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=no +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=yes +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/rs6000-aix3.2-cc b/config/rs6000-aix3.2-cc new file mode 100644 index 0000000..2abf859 --- /dev/null +++ b/config/rs6000-aix3.2-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=rs6000-aix3.2-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize= + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=xcoff + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj= + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=. + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=no + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize=4096 + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect= + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=aix + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=no +pragma_alloca=yes + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags= + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lld -lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=yes + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=no +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=no +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/sgi-irix5.3-cc b/config/sgi-irix5.3-cc new file mode 100644 index 0000000..e588699 --- /dev/null +++ b/config/sgi-irix5.3-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=sgi-irix5.3-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max= + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=no +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=elf + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=dl + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared="-shared" + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries= + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=yes + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=siginfo + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm -lelf' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=no +vfork=no +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=no +utime_h=yes +regcomp=no + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/sgi-irix6.2-cc b/config/sgi-irix6.2-cc new file mode 100644 index 0000000..b5dfa61 --- /dev/null +++ b/config/sgi-irix6.2-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=sgi-irix6.2-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max= + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=elf + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=dl + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared="-shared -dont_warn_unused" + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries= + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=yes + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=siginfo + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm -lelf' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=no +vfork=no +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=no +utime_h=yes +regcomp=yes + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/site b/config/site new file mode 100644 index 0000000..1927634 --- /dev/null +++ b/config/site @@ -0,0 +1,81 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather site- and installation-specific +# information required for building the Makefiles. +# +# This script is read after the "system" file, therefore you can place +# variable settings here to override those from "system". +# +# Some variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# The directory where all files are installed by running "make install". +# The subdirectories bin, lib, include, and runtime (with various +# subdirectories) are created automatically, but $install_dir isn't. +# Make sure $install_dir doesn't point to the top of the source tree +# (i.e. choose a subdirectory or a directory outside the source tree). + +install_dir=/usr/local/elk + + +# Libraries against which to link the X11 extension (typically -lX11). +# +# Any of the following library lists may be prefixed by something like +# -L/usr/X11/lib if the X-libraries do not reside in a standard directory; +# an additional -R/usr/X11/lib and -lsocket may be required in case of +# SunOS 5.x/SysVR4). + +libxlib='-L/usr/local/X11/lib -lX11' + + +# Libraries against which to link the Xt extension (typically +# -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11). -lXaw is needed to get the +# correct definition of the vendor shell widget class + +libxt='-L/usr/local/X11/lib -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11' + + +# Libraries against which to link the Athena widgets extension (typically +# identical to libxt above) + +libxaw='-L/usr/local/X11/lib -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11' + + +# Libraries against which to link the Motif extension (typically like +# libaw above with Xaw replaced by Xm) + +libxmotif='-L/usr/local/X11/lib -lXm -lXmu -lXt -lSM -lICE -lXext -lX11' + + +# Additional flags (typically -Isomething) to be supplied to the C +# compiler when compiling an X11 application, or a Motif application, +# respectively. + +x11_incl=-I/usr/local/X11/include +motif_incl= + + +# Set "gdbm" to "yes" if you have the GNU gdbm library installed and +# want the gdbm extension to be compiled. "gdbm_inc" gives additional +# C compiler flags required to compile a program using gdbm. + +gdbm= +gdbm_incl="-I/usr/gnu/include/gdbm" + + +# Do you want to use the generational garbage collector? If not, the +# stop-and-copy garbage collector will be used. + +generational_gc=yes + + +# The default heap size of the Scheme interpreter in KBytes (if the +# stop-and-copy garbage collector is used). + +default_heap_size=1024 diff --git a/config/sites/alpha-osf1 b/config/sites/alpha-osf1 new file mode 100644 index 0000000..fa22d7c --- /dev/null +++ b/config/sites/alpha-osf1 @@ -0,0 +1,81 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather site- and installation-specific +# information required for building the Makefiles. +# +# This script is read after the "system" file, therefore you can place +# variable settings here to override those from "system". +# +# Some variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# The directory where all files are installed by running "make install". +# The subdirectories bin, lib, include, and runtime (with various +# subdirectories) are created automatically, but $install_dir isn't. +# Make sure $install_dir doesn't point to the top of the source tree +# (i.e. choose a subdirectory or a directory outside the source tree). + +install_dir=/user/net/elk + + +# Libraries against which to link the X11 extension (typically -lX11). +# +# Any of the following library lists may be prefixed by something like +# -L/usr/X11/lib if the X-libraries do not reside in a standard directory; +# an additional -R/usr/X11/lib and -lsocket may be required in case of +# SunOS 5.x/SysVR4). + +libxlib='-lX11' + + +# Libraries against which to link the Xt extension (typically +# -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11). -lXaw is needed to get the +# correct definition of the vendor shell widget class + +libxt='-lXaw -lXmu -lXt -lXext -lX11' + + +# Libraries against which to link the Athena widgets extension (typically +# identical to libxt above) + +libxaw='-lXaw -lXmu -lXt -lXext -lX11' + + +# Libraries against which to link the Motif extension (typically like +# libaw above with Xaw replaced by Xm) + +libxmotif='-lXm -lXmu -lXt -lXext -lX11' + + +# Additional flags (typically -Isomething) to be supplied to the C +# compiler when compiling an X11 application, or a Motif application, +# respectively. + +x11_incl= +motif_incl= + + +# Set "gdbm" to "yes" if you have the GNU gdbm library installed and +# want the gdbm extension to be compiled. "gdbm_inc" gives additional +# C compiler flags required to compile a program using gdbm. + +gdbm= +gdbm_incl="-I/usr/gnu/include/gdbm" + + +# Do you want to use the generational garbage collector? If not, the +# stop-and-copy garbage collector will be used. + +generational_gc=yes + + +# The default heap size of the Scheme interpreter in KBytes (if the +# stop-and-copy garbage collector is used). + +default_heap_size=1024 diff --git a/config/sites/dec5100-ultrix b/config/sites/dec5100-ultrix new file mode 100644 index 0000000..0b8b866 --- /dev/null +++ b/config/sites/dec5100-ultrix @@ -0,0 +1,81 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather site- and installation-specific +# information required for building the Makefiles. +# +# This script is read after the "system" file, therefore you can place +# variable settings here to override those from "system". +# +# Some variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# The directory where all files are installed by running "make install". +# The subdirectories bin, lib, include, and runtime (with various +# subdirectories) are created automatically, but $install_dir isn't. +# Make sure $install_dir doesn't point to the top of the source tree +# (i.e. choose a subdirectory or a directory outside the source tree). + +install_dir=/usr/local/elk + + +# Libraries against which to link the X11 extension (typically -lX11). +# +# Any of the following library lists may be prefixed by something like +# -L/usr/X11/lib if the X-libraries do not reside in a standard directory; +# an additional -R/usr/X11/lib and -lsocket may be required in case of +# SunOS 5.x/SysVR4). + +libxlib='-L/usr/local/X11/lib -lX11_G0' + + +# Libraries against which to link the Xt extension (typically +# -lXaw -lXmu -lXt -lXext -lX11). -lXaw is needed to get the correct +# definition of the vendor shell widget class + +libxt='-L/usr/local/X11/lib -lXaw_G0 -lXmu_G0 -lXt_G0 -lXext_G0 -lX11_G0' + + +# Libraries against which to link the Athena widgets extension (typically +# identical to libxt above) + +libxaw='-L/usr/local/X11/lib -lXaw_G0 -lXmu_G0 -lXt_G0 -lXext_G0 -lX11_G0' + + +# Libraries against which to link the Motif extension (typically like +# libaw above with Xaw replaced by Xm) + +libxmotif='-L/usr/local/X11/lib -lXm_G0 -lXmu_G0 -lXt_G0 -lXext_G0 -lX11_G0' + + +# Additional flags (typically -Isomething) to be supplied to the C +# compiler when compiling an X11 application, or a Motif application, +# respectively. + +x11_incl= +motif_incl= + + +# Set "gdbm" to "yes" if you have the GNU gdbm library installed and +# want the gdbm extension to be compiled. "gdbm_inc" gives additional +# C compiler flags required to compile a program using gdbm. + +gdbm= +gdbm_incl="-I/usr/gnu/include/gdbm" + + +# Do you want to use the generational garbage collector? If not, the +# stop-and-copy garbage collector will be used. + +generational_gc=yes + + +# The default heap size of the Scheme interpreter in KBytes (if the +# stop-and-copy garbage collector is used). + +default_heap_size=1024 diff --git a/config/sites/hp9k700-hpux9.0 b/config/sites/hp9k700-hpux9.0 new file mode 100644 index 0000000..e0df5a7 --- /dev/null +++ b/config/sites/hp9k700-hpux9.0 @@ -0,0 +1,81 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather site- and installation-specific +# information required for building the Makefiles. +# +# This script is read after the "system" file, therefore you can place +# variable settings here to override those from "system". +# +# Some variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# The directory where all files are installed by running "make install". +# The subdirectories bin, lib, include, and runtime (with various +# subdirectories) are created automatically, but $install_dir isn't. +# Make sure $install_dir doesn't point to the top of the source tree +# (i.e. choose a subdirectory or a directory outside the source tree). + +install_dir=/usr/local/elk + + +# Libraries against which to link the X11 extension (typically -lX11). +# +# Any of the following library lists may be prefixed by something like +# -L/usr/X11/lib if the X-libraries do not reside in a standard directory; +# an additional -R/usr/X11/lib and -lsocket may be required in case of +# SunOS 5.x/SysVR4). + +libxlib=/usr/lib/X11R5/libX11.sl + + +# Libraries against which to link the Xt extension (typically +# -lXaw -lXmu -lXt -lXext -lX11). -lXaw is needed to get the correct +# definition of the vendor shell widget class + +libxt='/usr/lib/X11R5/libXt.sl /usr/lib/X11R5/libX11.sl' + + +# Libraries against which to link the Athena widgets extension (typically +# identical to libxt above) + +libxaw= + + +# Libraries against which to link the Motif extension (typically like +# libaw above with Xaw replaced by Xm) + +libxmotif='/usr/lib/Motif1.2/libXm.sl /usr/lib/X11R5/libXt.sl /usr/lib/X11R5/libX11.sl' + + +# Additional flags (typically -Isomething) to be supplied to the C +# compiler when compiling an X11 application, or a Motif application, +# respectively. + +x11_incl=-I/usr/include/X11R5 +motif_incl=-I/usr/include/Motif1.2 + + +# Set "gdbm" to "yes" if you have the GNU gdbm library installed and +# want the gdbm extension to be compiled. "gdbm_inc" gives additional +# C compiler flags required to compile a program using gdbm. + +gdbm= +gdbm_incl="-I/usr/gnu/include/gdbm" + + +# Do you want to use the generational garbage collector? If not, the +# stop-and-copy garbage collector will be used. + +generational_gc=yes + + +# The default heap size of the Scheme interpreter in KBytes (if the +# stop-and-copy garbage collector is used). + +default_heap_size=1024 diff --git a/config/sites/sun-sunos4.1 b/config/sites/sun-sunos4.1 new file mode 100644 index 0000000..27f7e72 --- /dev/null +++ b/config/sites/sun-sunos4.1 @@ -0,0 +1,81 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather site- and installation-specific +# information required for building the Makefiles. +# +# This script is read after the "system" file, therefore you can place +# variable settings here to override those from "system". +# +# Some variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# The directory where all files are installed by running "make install". +# The subdirectories bin, lib, include, and runtime (with various +# subdirectories) are created automatically, but $install_dir isn't. +# Make sure $install_dir doesn't point to the top of the source tree +# (i.e. choose a subdirectory or a directory outside the source tree). + +install_dir=/usr/local/elk + + +# Libraries against which to link the X11 extension (typically -lX11). +# +# Any of the following library lists may be prefixed by something like +# -L/usr/X11/lib if the X-libraries do not reside in a standard directory; +# an additional -R/usr/X11/lib and -lsocket may be required in case of +# SunOS 5.x/SysVR4). + +libxlib='-L/usr/local/X11/lib -lX11' + + +# Libraries against which to link the Xt extension (typically +# -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11). -lXaw is needed to get the +# correct definition of the vendor shell widget class + +libxt='-L/usr/local/X11/lib -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11' + + +# Libraries against which to link the Athena widgets extension (typically +# identical to libxt above) + +libxaw='-L/usr/local/X11/lib -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11' + + +# Libraries against which to link the Motif extension (typically like +# libaw above with Xaw replaced by Xm) + +libxmotif='-L/usr/local/X11/lib -lXm -lXmu -lXt -lSM -lICE -lXext -lX11' + + +# Additional flags (typically -Isomething) to be supplied to the C +# compiler when compiling an X11 application, or a Motif application, +# respectively. + +x11_incl= +motif_incl= + + +# Set "gdbm" to "yes" if you have the GNU gdbm library installed and +# want the gdbm extension to be compiled. "gdbm_inc" gives additional +# C compiler flags required to compile a program using gdbm. + +gdbm= +gdbm_incl="-I/usr/gnu/include/gdbm" + + +# Do you want to use the generational garbage collector? If not, the +# stop-and-copy garbage collector will be used. + +generational_gc=yes + + +# The default heap size of the Scheme interpreter in KBytes (if the +# stop-and-copy garbage collector is used). + +default_heap_size=1024 diff --git a/config/sites/sun-sunos5 b/config/sites/sun-sunos5 new file mode 100644 index 0000000..30882e5 --- /dev/null +++ b/config/sites/sun-sunos5 @@ -0,0 +1,81 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather site- and installation-specific +# information required for building the Makefiles. +# +# This script is read after the "system" file, therefore you can place +# variable settings here to override those from "system". +# +# Some variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# The directory where all files are installed by running "make install". +# The subdirectories bin, lib, include, and runtime (with various +# subdirectories) are created automatically, but $install_dir isn't. +# Make sure $install_dir doesn't point to the top of the source tree +# (i.e. choose a subdirectory or a directory outside the source tree). + +install_dir=/usr/local/elk + + +# Libraries against which to link the X11 extension (typically -lX11). +# +# Any of the following library lists may be prefixed by something like +# -L/usr/X11/lib if the X-libraries do not reside in a standard directory; +# an additional -R/usr/X11/lib and -lsocket may be required in case of +# SunOS 5.x/SysVR4). + +libxlib='-R/usr/local/X11/lib -L/usr/local/X11/lib -lX11 -lsocket' + + +# Libraries against which to link the Xt extension (typically +# -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11). -lXaw is needed to get the +# correct definition of the vendor shell widget class + +libxt='-R/usr/local/X11/lib -L/usr/local/X11/lib -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11 -lsocket' + + +# Libraries against which to link the Athena widgets extension (typically +# identical to libxt above) + +libxaw='-R/usr/local/X11/lib -L/usr/local/X11/lib -lXaw -lXmu -lXt -lSM -lICE -lXext -lX11 -lsocket' + + +# Libraries against which to link the Motif extension (typically like +# libaw above with Xaw replaced by Xm) + +libxmotif='-R/usr/local/X11/lib -L/usr/local/X11/lib -lXm -lXmu -lXt -lXext -lSM -lICE -lX11 -lsocket' + + +# Additional flags (typically -Isomething) to be supplied to the C +# compiler when compiling an X11 application, or a Motif application, +# respectively. + +x11_incl=-I/usr/local/X11/include +motif_incl=-I/usr/local/X11/include + + +# Set "gdbm" to "yes" if you have the GNU gdbm library installed and +# want the gdbm extension to be compiled. "gdbm_inc" gives additional +# C compiler flags required to compile a program using gdbm. + +gdbm= +gdbm_incl="-I/usr/gnu/include/gdbm" + + +# Do you want to use the generational garbage collector? If not, the +# stop-and-copy garbage collector will be used. + +generational_gc=yes + + +# The default heap size of the Scheme interpreter in KBytes (if the +# stop-and-copy garbage collector is used). + +default_heap_size=1024 diff --git a/config/sun-sunos4.1-acc b/config/sun-sunos4.1-acc new file mode 100644 index 0000000..e074ad5 --- /dev/null +++ b/config/sun-sunos4.1-acc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=sun-sunos4.1-acc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format= + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=ld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=_ + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=arg4 + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=acc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O -Xa' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm -Bstatic' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=yes + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=yes +utime_h=yes +regcomp=no + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=int diff --git a/config/sun-sunos4.1-cc b/config/sun-sunos4.1-cc new file mode 100644 index 0000000..6a8cfc7 --- /dev/null +++ b/config/sun-sunos4.1-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=sun-sunos4.1-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format= + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=ld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=_ + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=arg4 + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags=-D_NO_PROTO + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm -Bstatic' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=no + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=yes +utime_h=yes +regcomp=no + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=int diff --git a/config/sun-sunos4.1-gcc b/config/sun-sunos4.1-gcc new file mode 100644 index 0000000..37d77d9 --- /dev/null +++ b/config/sun-sunos4.1-gcc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=sun-sunos4.1-gcc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format= + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=ld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=_ + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=arg4 + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=gcc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-ansi -O -fschedule-insns2' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm -static' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=yes +utime_h=yes +regcomp=no + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=int diff --git a/config/sun-sunos5-acc b/config/sun-sunos5-acc new file mode 100644 index 0000000..7839a19 --- /dev/null +++ b/config/sun-sunos5-acc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=sun-sunos5-acc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=no + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=no + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=no + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=no +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=no +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=elf + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=dl + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared="-G -z text" + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries= + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=siginfo + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=/usr/ccs/bin/ld + + +# The C compiler flags used for all files. + +cflags='-O -Xa -D__svr4__' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags='-K PIC' + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm -lelf -ldl' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=yes + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=no +vfork=yes +gethostname=no +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=no +rename=yes +waitpid=yes +wait3=no +wait4=no +utime_h=yes +regcomp=no + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/sun-sunos5-gcc b/config/sun-sunos5-gcc new file mode 100644 index 0000000..56a182d --- /dev/null +++ b/config/sun-sunos5-gcc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=sun-sunos5-gcc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=no + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=no + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=no + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=no +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=no +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=elf + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=dl + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared="-G -z text" + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries= + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=siginfo + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=gcc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=/usr/ccs/bin/ld + + +# The C compiler flags used for all files. + +cflags='-O -fschedule-insns2' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags='-fpic' + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm -lelf -ldl' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=no +vfork=yes +gethostname=no +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=no +rename=yes +waitpid=yes +wait3=no +wait4=no +utime_h=yes +regcomp=no + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/untested/386pc-386bsd-gcc b/config/untested/386pc-386bsd-gcc new file mode 100644 index 0000000..5d322f9 --- /dev/null +++ b/config/untested/386pc-386bsd-gcc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=386pc-386bsd-gcc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format= + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=ld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=yes + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=_ + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=4096 + file_text_start=4096 + mem_text_start=0 + text_length_adj=0 + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=fpurge +flush_tty=tiocflush + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=arg4 + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=no +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=gcc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-Di386 -O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime= +vfork=yes +gethostname=yes +uname= +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=yes +utime_h=yes +regcomp=no + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=int diff --git a/config/untested/386pc-dos-gcc b/config/untested/386pc-dos-gcc new file mode 100644 index 0000000..c630321 --- /dev/null +++ b/config/untested/386pc-dos-gcc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=386pc-dos-gcc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include= + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals= + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format= + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=ld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags=-x + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=yes + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=_ + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=yes + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGMENT_SIZE + file_text_start='sizeof(struct exec)' + mem_text_start='(4096+sizeof(struct exec))' + text_length_adj=0 + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty= + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size='(512*1024)' + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=no + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=arg4 + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=no +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=gcc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday= +ftime= +vfork=no +gethostname= +uname= +mktemp= +tmpnam= +tempnam= +getcwd= +getwd= +rename= +waitpid= +wait3= +wait4= +utime_h= +regcomp= + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=int diff --git a/config/untested/convex230-convexos10-cc b/config/untested/convex230-convexos10-cc new file mode 100644 index 0000000..a4b207c --- /dev/null +++ b/config/untested/convex230-convexos10-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=convex230-convexos10-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=convex + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj= + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with=_ + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=no + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=1024 + file_text_start=1024 + mem_text_start=0 + text_length_adj=0 + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=no + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tiocflush + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=no + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr= + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=yes + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=no +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=yes + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=yes +mktemp=yes +tmpnam=yes +tempnam=no +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=yes +wait4=no +utime_h=yes +regcomp= + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/untested/cray-unicos-cc b/config/untested/cray-unicos-cc new file mode 100644 index 0000000..9cc6f1d --- /dev/null +++ b/config/untested/cray-unicos-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=cray-unicos-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=no + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include= + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=no + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=no +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format= + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj= + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared="-G -z text" + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries= + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=no + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio= +flush_tty= + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size=2000000 + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=yes + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr=siginfo + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=no + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h=yes +pragma_alloca=no + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=yes + + +# The C compiler used to compile the source code. + +cc=cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=/usr/ccs/bin/ld + + +# The C compiler flags used for all files. + +cflags='-O ' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags='-K PIC' + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm -lelf -ldl' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=yes + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=no +vfork=yes +gethostname=no +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=yes +rename=yes +waitpid=yes +wait3=no +wait4=no +utime_h=yes +regcomp= + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/untested/mx300i-svr4-cc b/config/untested/mx300i-svr4-cc new file mode 100644 index 0000000..f8f2168 --- /dev/null +++ b/config/untested/mx300i-svr4-cc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=mx300i-svr4-cc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=no + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=no + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=no + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=yes + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=no +sysconf_open_max=yes + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=yes + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=no +sysconf_pagesize=yes + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=posix + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=elf + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj= + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h=unused + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=yes + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tcflsh + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=no + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr= + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=no + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h= +pragma_alloca= + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=/usr/ccs/bin/cc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags=-D_NO_PROTO + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-dn -lm -lelf' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=yes + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=no +vfork=yes +gethostname=no +uname=yes +mktemp=yes +tmpnam=yes +tempnam=yes +getcwd=yes +getwd=no +rename=yes +waitpid=yes +wait3=no +wait4=no +utime_h=yes +regcomp= + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=gid_t diff --git a/config/untested/sony3200-news4-gcc b/config/untested/sony3200-news4-gcc new file mode 100644 index 0000000..91a1d1d --- /dev/null +++ b/config/untested/sony3200-news4-gcc @@ -0,0 +1,367 @@ +# This is a shell script. It is sourced by the build scripts in the +# various subdirectories to gather system-, compiler-, and OS-specific +# information required for building the Makefiles. +# +# Most variables in this script are interpreted as boolean variables and +# indicate presence or absence of one specific feature. The value "yes" +# is regarded as "true", all other values (including no value or even +# non-existence of the variable) are interpreted as "false". +# +# Do not forget to quote values that contain shell meta syntax. +# +# ----------------------------------------------------------------------- + + +# $system should contain the name of this file. It may be used by some +# of the build scripts to do things that are specific to one single +# type of system. + +system=sony3200-news4-gcc + + +# Does the system support the vprintf library function? If not, +# availability of the (non-portable) _doprnt function is assumed. + +vprintf=yes + + +# Does the directory(3) library follow the POSIX conventions (i.e. +# requires the include file and uses "struct dirent")? +# If not, the (obsolete) BSD-style interface with and +# "struct direct" is assumed. + +dirent=yes + + +# Does the system have the random/srandom library functions? If not, +# rand/srand will be used instead. + +random=yes + + +# Does the system have the index library function? If not, strchr +# will be used. + +index=yes + + +# Does the system have the bcopy, bzero, and bcmp library functions? +# If not, memcpy/memset/memcmp will be used. + +bstring=yes + + +# Does using the access system call require to be included? +# (Look into the manual page for access if in doubt.) + +include_unistd_h=no + + +# If the FIONREAD ioctl command is defined, which file must be included? + +fionread_include='' + + +# What is the name of the a.out include file? + +aout_h='' + + +# The following variables control how certain system limits are obtained +# during runtime. +# +# If getdtablesize() is available to determine the maximum number of open +# files per process, set getdtablesize=yes. +# Alternatively, if POSIX-style sysconf() can be called with _SC_OPEN_MAX, +# set sysconf_open_max=yes. +# If neither is set to "yes", an educated guess will be made. + +getdtablesize=yes +sysconf_open_max=no + +# If POSIX-style pathconf() can be invoked with _PC_PATH_MAX to determine +# the maximum pathname length, set pathconf_path_max=yes. + +pathconf_path_max=no + +# If the system page size can be determined by calling getpagesize() +# set getpagesize=yes. +# Alternatively, if sysconf() can be invoked with _SC_PAGESIZE, set +# sysconf_pagesize=yes. +# These two variables are only required if the generational garbage +# collector is used. + +getpagesize=yes +sysconf_pagesize=no + + +# Set reliable_signals=bsd if your system supports BSD-style reliable +# signals (has sigblock and related functions); set reliable_signals=posix +# for POSIX-style signals (sigprocmask, sigsets); otherwise old V7/SysV +# signal semantics are assumed. + +reliable_signals=bsd + + +# To support dynamic loading of object files and "dump", the system's +# a.out format has to be known. Choose one of the following: +# +# coff ecoff xcoff elf macho hp9k convex +# +# Other values of "aout_format" are interpreted as BSD-style a.out format. + +aout_format=ecoff + + +# Which mechanism should be used to dynamically load object files? +# Possible values currently are: +# +# ld BSD-style incremental loading based on ld -A +# rld NeXT-style rld_load() +# shl HP-UX shl_load() +# dl SysVR4/SunOS5 dlopen() +# +# Leave load_obj empty if dynamic loading is not supported. + +load_obj=ld + + + # The following variables are only relevant if load_obj is set. + + # Linker options to produce a shared object from a .o file. + # Only used if load_obj=dl. + + ldflags_shared= + + # The libraries against which dynamically loaded files are resolved + # at the time they are loaded. + + load_libraries='-lc' + + # Additional flags to be passed to the linker for an incremental + # linker run (ld -A). Ignored unless load_obj=ld. + + incremental_ldflags= + + # Systems with "aout_format=ecoff" may require a call to the cacheflush + # system call after an object file has been loaded. Which include file + # has to be included in this case? + + cachectl_h= + + # Is the ANSI-C atexit function supported to register an exit handler? + # If not, the exit library function will be redefined and will end in + # a call to _exit. + + atexit=no + + +# Do the names of external functions in the symbol table always begin +# with a special character (such as underline)? If so, syms_begin_with +# should hold this character, otherwise leave it empty. + +syms_begin_with= + + +# The symbol prefixes of extension initialization and finalization +# functions (without the initial $syms_begin_with). Do not change +# these unless the compiler or linker restricts the length of symbols! + +init_prefix=elk_init_ +finit_prefix=elk_finit_ + + +# Is the "dump" function supported? + +can_dump=no + + +# The following variables are only relevant if "can_dump=yes". + + # Is the fchmod system call broken or unavailable? + + fchmod_broken=no + + # These four variables are only relevant if the system has the BSD-style + # a.out format. + # segment_size is the segment size of the system's memory management + # unit, i.e. the number to a multiple of which the size of an a.out + # segment (e.g. .text) is rounded up. + # file_text_start is the file offset at which the text segment starts + # in an a.out file. + # mem_text_start is the starting address of the text segment in memory. + # text_length_adj must be set to "sizeof (struct exec)" if the length of + # the text segment stored in the a.out header includes the a.out header + # itself. + + segment_size=SEGSIZ + file_text_start='sizeof(struct exec)' + mem_text_start='(PAGSIZ+sizeof(struct exec))' + text_length_adj='sizeof(struct exec)' + + # Only relevant if "aout_format=coff": the system's pagesize. + + coff_pagesize= + + # Only relevant if "aout_format=hp9k" and "load_obj=shl" + + hp_shared_libraries=yes + + # Print debug messages when dumping + + debug_dump=yes + + +# Is the "termio" terminal interface supported by the system? If not, +# BSD-style tty handling will be used. + +termio=yes + + +# flush_stdio and flush_tty indicate how clear-input/output-port can +# flush (purge) a FILE pointer and a TTY file descriptor. +# Possible values of flush_stdio: +# bsd assume old BSD-style FILE* (with _cnt, _ptr, _base) +# fpurge use 4.4BSD-style fpurge stdio library function +# Possible values of flush_tty: +# tiocflush use TIOCFLUSH ioctl from +# tcflsh use TCFLSH ioctl from +# Leave the variable(s) empty if flushing is not supported. + +flush_stdio=bsd +flush_tty=tiocflush + + +# The interpreter uses the getrlimit function to determine the maximum +# stack size of the running program. If this function is not supported, +# set max_stack_size to a (fixed) maximum stack size (in bytes). + +max_stack_size= + + +# Is the mprotect system call supported? The generational garbage collector +# requires mprotect to implement incremental GC. $mprotect is ignored if +# generational_gc is set to "no" in the site file. Set mprotect=mmap if +# mprotect is supported, but only for mmap()ed memory. + +mprotect=no + + +# How can a SIGSEGV or SIGBUS signal handler find out the address of +# the faulting memory reference? This variable is only used if +# $mprotect is "yes" or "mmap". Possible values are: +# +# siginfo handler is called with siginfo_t structure (enabled +# by a call to sigaction) +# sigcontext address is in the sigcontext structure (3rd arg, sc_badvaddr) +# arg4 address is delivered to handler as argument #4 +# aix use an AIX-specific hack to get hold of the bad address +# hpux use a HP-UX-specific hack + +sigsegv_addr= + + +# Does the system support the alloca library function, and does this +# function actually extend the stack? If in doubt, extract alloca.o +# from the C library and check if it contains the symbols malloc and free. +# If this is the case, forget it. + +use_alloca=no + + +# Must be included to use alloca? Is "#pragma alloca" required? + +include_alloca_h= +pragma_alloca= + + +# Does the system (or compiler) require certain objects (e.g. doubles) +# to be aligned at 8-byte boundaries? If not, 4-byte alignment will +# be assumed. + +align_8byte=no + + +# The C compiler used to compile the source code. + +cc=gcc + + +# The name of the linker. This is usually just "ld", or /usr/ccs/bin/ld +# in SVR4-based systems. + +ld=ld + + +# The C compiler flags used for all files. + +cflags='-O -DSEEK_SET=1' + + +# Are extra C compiler flags (such as -D_NO_PROTO) required to compile +# Motif applications? + +motif_cflags= + + +# Are extra C compiler flags (such as -G 0) required to compile +# dynamically loadable files? + +obj_cflags= + + +# Are extra linker flags (such as -G 0) required to link several object +# files together to one dynamically loadable file? + +obj_ldflags= + + +# The linker flags used to link the interpreter. + +ldflags='-lm' + + +# The lint flags. + +lintflags='-abxh' + + +# Are function prototypes in the header files required? If prototypes=yes, +# prototypes are used unconditionally; if prototypes=no, prototypes are +# not used; otherwise prototypes are only used if the source code is +# compiled with an ANSI-C- or C++-compiler. + +prototypes=no + + +# Does your C preprocessor support the ANSI-C ## operator, although +# __STDC__ is not defined? + +ansi_cpp=no + + +# The UNIX extension likes to know which of the following system calls, +# library functions, and include files are supported by the system. + +gettimeofday=yes +ftime=yes +vfork=yes +gethostname=yes +uname=no +mktemp=yes +tmpnam=no +tempnam=no +getcwd=yes +getwd=yes +rename=yes +waitpid=no +wait3=yes +wait4=yes +utime_h=no +regcomp= + + +# Element type of the gidset argument of getgroups(); typically int +# or gid_t. Only needed by the UNIX extension. + +getgroups_type=int diff --git a/doc/README b/doc/README new file mode 100644 index 0000000..10d2605 --- /dev/null +++ b/doc/README @@ -0,0 +1,67 @@ +This directory tree contains the documentation for Elk as troff source +and PostScript hardcopy files. + +You need a troff and the ms macro package to build the documentation +from the troff source (see the Makefile in each subdirectory). The +files ending in .ps are pre-generated PostScript files; you can send +them directly to a PostScript printer or browse them with a PostScript +previewer. The PostScript file have been generated with GNU groff. + +As a courtesy to our US audience, the PostScript files are in US +letter format. If you don't like this (and your groff default is A4), +deactivate the ".pl 11i" directives in util/tmac.scheme, +usenix/usenix.ms, and man/elk.1 (i.e. insert a comment token before it) +and rebuild the document(s). + +All the documents have been prepared for translation to HTML using +the Elk-based `unroff' package (see ../README for availability +information). + + +kernel/ The Scheme Reference for Elk. It describes the Scheme language + dialect implemented by the Scheme interpreter included in + Elk (a superset of the official language). + +usenix/ A paper about Elk that has appeared in USENIX Computing + Systems (vol. 7, no. 4, pp. 419-449, 1994). + +man/ This directory holds a brief online manual page for the Scheme + interpreter component. You may want to install in `/usr/man' + on your system. The manual page essentially describes the + command line options of the interpreter. + +xlib/ The reference manual for the Xlib extension to Elk. + +xt/ The reference manual for the Xt (X11 Toolkit Intrinsics) + extension to Elk. + +unix/ The reference manual for the UNIX extension. + +record/ The reference manual for the record extension. + +bitstring/ The reference manual for the bit string extension. + +regexp/ The reference manual for the regular expression extension. + +oops/ A manual for the simple Scheme-based object oriented programming + tool included in Elk (oops.scm). + +cprog/ The C/C++ Programmer's Manual for Elk. This comprehensive + manual describes the facilities of the C/C++ interface of + Elk. Topics range from the general architecture of Elk-based + applications and defining application-specific Scheme types + and primitives, to more advanced subjects such as interacting + with the garbage collector. The audience are authors of + Elk-based applications and extension writers. + + This manual is a replacement for the document that lived in + a subdirectory `ex' in earlier version of Elk. + +util/ A collection of troff macro files and other utilities needed + for typesetting the documentation in the above directories. + + There is a small C program `mkindex.c' that is required to + build the C/C++ Programmer's Manual (cprog/cprog.ms); you + will have to compile it by calling "make" if you must typeset + the manual. See the comment at the beginning of util/mkindex.c + for a brief explanation of what it does. diff --git a/doc/bitstring/Makefile b/doc/bitstring/Makefile new file mode 100644 index 0000000..d487d26 --- /dev/null +++ b/doc/bitstring/Makefile @@ -0,0 +1,24 @@ +MANUAL= bitstring +TROFF= groff -ms -t +UNROFF= unroff -ms + +$(MANUAL).ps: $(MANUAL).ms index.ms + (cat $(MANUAL).ms ../util/tmac.index index.ms; echo ".Tc")\ + | $(TROFF) 2> /dev/null > $(MANUAL).ps + +$(MANUAL).html: $(MANUAL).ms + (cat $?; echo ".Tc") | $(UNROFF) document=$(MANUAL) + +index.ms: $(MANUAL).ms index.raw + sort -f -t# +1 -3 +0n index.raw | awk -f ../util/fixindex.awk\ + | awk -f ../util/block.awk >index.ms + +index.raw: $(MANUAL).ms + $(TROFF) $(MANUAL).ms 2> index.raw >/dev/null + +check: + checknr -c.Ul.Pr.Sy.Va.Sh.Ix.Id.Ch -a.Ss.Se.[[.]] $(MANUAL).ms |\ + grep -v "Empty command" + +clean: + rm -f index.raw index.ms $(MANUAL).ps $(MANUAL).html diff --git a/doc/bitstring/bitstring.ms b/doc/bitstring/bitstring.ms new file mode 100644 index 0000000..0beb076 --- /dev/null +++ b/doc/bitstring/bitstring.ms @@ -0,0 +1,209 @@ +.so ../util/tmac.scheme +.Ul +.TL +Reference Manual for the +.sp .5 +Elk Bit String Extension +.AU +Oliver Laumann +. +.Ch "Introduction" +. +.PP +The bit string extension to Elk defines a new data type \f2bitstring\fP +(a sequence of zero or more bits) and functions to create and +manipulate bit strings. +The bits in a bit string are numbered beginning from zero up to the +number of bits minus one; bit number 0 is the +.Ix "least significant bit" +.Ix LSB +least significant bit (LSB), and the highest numbered bit is the +.Ix "most significant bit" +.Ix MSB +most significant bit (MSB). +.PP +The +.Ix "print representation" +print representation of bit strings is introduced by the sequence +`#*'; the bits are printed starting with the most significant bit. +Likewise, in the reader the sequence `#*' introduces a bit string +constant. +.LP +Example: +.Ss +#*0100110111 +.sp .5 +#* \f2(empty bit string)\fP +.Se +. +.Ch "Using the Bit String Extension" +. +.PP +To load the bit string extension, evaluate the expression +.Ss +(require 'bitstring) +.Se +.PP +This causes the files +.Ix bitstring.scm +\f2bitstring.scm\fP and +.Ix bitstring.o +\f2bitstring.o\fP to be loaded (\f2bitstring.o\fP must be statically +linked with the interpreter on platforms that do not support dynamic +loading of object files). +.PP +Loading the bit string extension causes the +.Ix feature +features \f2bitstring\fP and \f2bitstring.o\fP to be provided. +. +.Ch "Creating Bit Strings" +. +.Pr make-bitstring length init +.LP +\f2make-bitstring\fP returns a new bit string of the given length. +If init is #t, all bits are initialized to 1; if init is #f, all +bits are initialized to 0. +. +.Pr bitstring-copy bitstring +.LP +This procedure returns a copy of the specified bit string. +. +.Pr bitstring-append bitstring\*1 bitstring\*2 +.LP +\f2bitstring-append\fP returns a new bit string holding the +.Ix concatenation +concatenation of the specified bit string arguments. +. +.Ch "Bit String Predicates" +. +.Pr bitstring? obj +.LP +This +.Ix "type predicate" +type predicate returns #t if \f2obj\fP is a bit string, #f otherwise. +. +.Pr bitstring=? bitstring\*1 bitstring\*2 +.LP +This procedure returns #t if the bit string arguments are of the same +length and contain the same bits, #f otherwise. +. +.Pr bitstring-zero? bitstring +.LP +\f2bitstring-zero?\fP returns #t if the specified bit string +contains only 0 bits, #f otherwise. +. +.Ch "Integer Conversions" +. +.[[ +.Pr unsigned-integer\(mi>bitstring length i +.Pr signed-integer\(mi>bitstring length i +.]] +.LP +Both procedures convert the exact integer argument \f2i\fP into a bit +string of \f2length\fP bits and return the bit string. +\f2length\fP must be large enough to hold the bit string +representation of \f2i\fP. +The integer argument to \f2unsigned-integer->bitstring\fP must be +non-negative. +\f2signed-integer->bitstring\fP uses +.Ix "two's complement" +two's complement representation for negative integers. +. +.[[ +.Pr bitstring\(mi>unsigned-integer bitstring +.Pr bitstring\(mi>signed-integer bitstring +.]] +.LP +Both procedures convert the given bit string into an integer. +\f2bitstring->signed-integer\fP interprets the bit string as the +.Ix "two's complement" +two's complement representation of a signed integer. +. +.Ch "Selecting Components of Bit Strings" +. +.Pr bitstring-length bitstring +.LP +This procedure returns the number of bits in the specified bit string. +. +.Pr bitstring-ref bitstring index +.LP +\f2bitstring-ref\fP returns #t if the \f2index\fP-th bit in the +given bit string is 1, #f otherwise. +. +.Pr bitstring-substring bitstring from to +.LP +This procedure returns a new bit string initialized with the bits +of \f2bitstring\fP starting at the index \f2from\fP (inclusive) +and ending at the index \f2to\fP (exclusive). +. +.Ch "Modifying Bit Strings" +. +.Pr bitstring-fill! bitstring init +.LP +This procedure sets all bits in the specified bit string to 1 if +\f2init\fP is #t, or to 0 if \f2init\fP is #f. +It returns the non-printing object. +. +.Pr bitstring-set! bitstring index init +.LP +\f2bitstring-set!\fP sets the \f2index\fP-th bit in the specified +bit string to 1 if \f2init\fP is #t, or to 0 if \f2init\fP is #f. +It returns the non-printing object. +. +.Pr bitstring-move! dst-bitstring src-bitstring +.LP +\f2bitstring-move!\fP destructively copies the contents of the +bit string \f2src-bitstring\fP into \f2dst-bitstring\fP. +Both bit strings must have the same length. +It returns the non-printing object. +. +.Pr bitstring-substring-move! src-bitstring from\*1 to\*1 dst-bitstring from\*2 +.LP +This procedure destructively copies the bits from \f2src-bitstring\fP +starting at index \f2from\*1\fP (inclusive) and ending at index \f2to\*1\fP +(exclusive) into \f2dst-bitstring\fP starting at index \f2from\*2\fP +(inclusive). +.Ix overlapping +Overlapping is handled correctly. +The procedure returns the non-printing object. +. +.Ch "Bitwise Logical Operations" +. +.Pr bitstring-not bitstring +.LP +This procedure returns a new bit string initialized to the +bitwise logical negation of the given bit string. +. +.Pr bitstring-not! dst-bitstring src-bitstring +.LP +This procedure destructively overwrites the contents of \f2dst-bitstring\fP +with the bitwise logical negation of the bits in \f2src-bitstring\fP. +Both bit strings must have the same length. +\f2bitstring-not!\fP returns the non-printing object. +. +.[[ +.Pr bitstring-and bitstring\*1 bitstring\*2 +.Pr bitstring-andnot bitstring\*1 bitstring\*2 +.Pr bitstring-or bitstring\*1 bitstring\*2 +.Pr bitstring-xor bitstring\*1 bitstring\*2 +.]] +.LP +These procedures return a new bit string initialized to the bitwise logical +\f2and\fP (logical \f2and\fP with the negation, logical \f2or\fP, +logical exclusive \f2or\fP, respectively) of the two bit string arguments. +The two bit strings must have the same length. +. +.[[ +.Pr bitstring-and! dst-bitstring src-bitstring +.Pr bitstring-or! dst-bitstring src-bitstring +.Pr bitstring-andnot! dst-bitstring src-bitstring +.Pr bitstring-xor! dst-bitstring src-bitstring +.]] +.LP +These procedures are the destructive versions of the four bitwise +logical procedures described above. +They perform the corresponding logical operation on the two bit string +arguments and overwrite the contents of \f2dst-bitstring\fP with the +result. +Both bit strings must have the same length. +These procedures return the non-printing object. diff --git a/doc/bitstring/bitstring.ps b/doc/bitstring/bitstring.ps new file mode 100644 index 0000000..8e10c65 --- /dev/null +++ b/doc/bitstring/bitstring.ps @@ -0,0 +1,533 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier +%%+ font Symbol +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 6 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier +%%IncludeResource: font Symbol +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier@0 ENC0/Courier RE/Times-Roman@0 +ENC0/Times-Roman RE/Times-Italic@0 ENC0/Times-Italic RE/Times-Bold@0 ENC0 +/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(Refer)222.444 120 Q(ence Manual f)-.216 E(or the)-.3 E +(Elk Bit String Extension)225.486 138 Q/F1 10/Times-Italic@0 SF(Oliver Laumann) +255.085 162 Q/F2 11/Times-Bold@0 SF 2.75(1. Intr)72 234 R(oduction)-.198 E/F3 +11/Times-Roman@0 SF .192(The bit string e)97 252.6 R .192 +(xtension to Elk de\214nes a ne)-.165 F 2.942(wd)-.275 G .191(ata type)302.69 +252.6 R/F4 11/Times-Italic@0 SF(bitstring)2.941 E F3 .191 +(\(a sequence of zero or more)2.941 F 1.565 +(bits\) and functions to create and manipulate bit strings.)72 267.6 R 1.566 +(The bits in a bit string are numbered)7.065 F(be)72 282.6 Q .652(ginning from\ + zero up to the number of bits minus one; bit number 0 is the least signi\214c\ +ant bit)-.165 F +(\(LSB\), and the highest numbered bit is the most signi\214cant bit \(MSB\).) +72 297.6 Q .065(The print representation of bit strings is introduced by the s\ +equence `#*'; the bits are printed)97 316.2 R .922 +(starting with the most signi\214cant bit.)72 331.2 R(Lik)6.422 E -.275(ew)-.11 +G .921(ise, in the reader the sequence `#*' introduces a bit).275 F +(string constant.)72 346.2 Q(Example:)72 364.8 Q/F5 10/Courier@0 SF +(#*0100110111)100.346 387.303 Q(#*)100.346 408.303 Q F1(\(empty bit string\)) +190.346 408.303 Q F2 2.75(2. Using)72 445.303 R(the Bit String Extension)2.75 E +F3 1.76 -.88(To l)97 463.903 T(oad the bit string e).88 E(xtension, e)-.165 E +-.275(va)-.275 G(luate the e).275 E(xpression)-.165 E F5 +(\(require 'bitstring\))100.346 486.406 Q F3 .319(This causes the \214les)97 +512.006 R F4(bitstring)3.07 E(.scm)-.165 E F3(and)3.07 E F4(bitstring)3.07 E +(.o)-.165 E F3 .32(to be loaded \()3.07 F F4(bitstring)A(.o)-.165 E F3 .32 +(must be statically)3.07 F(link)72 527.006 Q(ed with the interpreter on platfo\ +rms that do not support dynamic loading of object \214les\).)-.11 E +(Loading the bit string e)97 545.606 Q(xtension causes the features)-.165 E F4 +(bitstring)2.75 E F3(and)2.75 E F4(bitstring)2.75 E(.o)-.165 E F3(to be pro) +2.75 E(vided.)-.165 E F2 2.75(3. Cr)72 575.606 R(eating Bit Strings)-.198 E +(\(mak)72 605.606 Q(e-bitstring)-.11 E F4(length init)4.583 E F2 257.742(\)p)C +-.198(ro)462.244 605.606 S(cedur).198 E(e)-.198 E F4(mak)72 624.206 Q +(e-bitstring)-.11 E F3 .203(returns a ne)2.953 F 2.953(wb)-.275 G .203 +(it string of the gi)206.847 624.206 R -.165(ve)-.275 G 2.953(nl).165 G 2.952 +(ength. If)302.451 624.206 R .202(init is #t, all bits are initialized to 1;) +2.952 F(if init is #f, all bits are initialized to 0.)72 639.206 Q F2 +(\(bitstring-copy)72 669.206 Q F4(bitstring)4.583 E F2 268.929(\)p)C -.198(ro) +462.244 669.206 S(cedur).198 E(e)-.198 E F3(This procedure returns a cop)72 +687.806 Q 2.75(yo)-.11 G 2.75(ft)211.491 687.806 S(he speci\214ed bit string.) +220.962 687.806 Q EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(bitstring-append)72 87 Q/F2 11 +/Times-Italic@0 SF(bitstring)4.583 E/F3 10/Times-Italic@0 SF(1)3.3 I F2 +(bitstring)2.75 -3.3 M F3(2)3.3 I F1 206.041(\)p)-3.3 K -.198(ro)462.244 87 S +(cedur).198 E(e)-.198 E F2(bitstring-append)72 105.6 Q F0 .032(returns a ne) +2.782 F 2.783(wb)-.275 G .033 +(it string holding the concatenation of the speci\214ed bit string ar)215.448 +105.6 R(gu-)-.198 E(ments.)72 120.6 Q F1 2.75(4. Bit)72 150.6 R(String Pr)2.75 +E(edicates)-.198 E(\(bitstring?)72 180.6 Q F2(obj)4.583 E F1 312.324(\)p)C +-.198(ro)462.244 180.6 S(cedur).198 E(e)-.198 E F0 +(This type predicate returns #t if)72 199.2 Q F2(obj)2.75 E F0 +(is a bit string, #f otherwise.)2.75 E F1(\(bitstring=?)72 229.2 Q F2 +(bitstring)4.583 E F3(1)3.3 I F2(bitstring)2.75 -3.3 M F3(2)3.3 I F1 232.782 +(\)p)-3.3 K -.198(ro)462.244 229.2 S(cedur).198 E(e)-.198 E F0 .57 +(This procedure returns #t if the bit string ar)72 247.8 R .57 +(guments are of the same length and contain the same)-.198 F +(bits, #f otherwise.)72 262.8 Q F1(\(bitstring-zer)72 292.8 Q(o?)-.198 E F2 +(bitstring)4.583 E F1 265.475(\)p)C -.198(ro)462.244 292.8 S(cedur).198 E(e) +-.198 E F2(bitstring-zer)72 311.4 Q(o?)-.495 E F0 +(returns #t if the speci\214ed bit string contains only 0 bits, #f otherwise.) +2.75 E F1 2.75(5. Integer)72 341.4 R(Con)2.75 E -.11(ve)-.44 G(rsions).11 E +(\(unsigned-integer)72 371.4 Q/F4 11/Symbol SF(-)A F1(>bitstring)A F2(length i) +4.583 E F1 207.428(\)p)C -.198(ro)462.244 371.4 S(cedur).198 E(e)-.198 E +(\(signed-integer)72 386.4 Q F4(-)A F1(>bitstring)A F2(length i)4.583 E F1 +219.66(\)p)C -.198(ro)462.244 386.4 S(cedur).198 E(e)-.198 E F0 .3 +(Both procedures con)72 405 R -.165(ve)-.44 G .3(rt the e).165 F .3(xact inte) +-.165 F .301(ger ar)-.165 F(gument)-.198 E F2(i)3.051 E F0 .301 +(into a bit string of)3.051 F F2(length)3.051 E F0 .301(bits and return the) +3.051 F .051(bit string.)72 420 R F2(length)5.551 E F0 .051(must be lar)2.801 F +.05(ge enough to hold the bit string representation of)-.198 F F2(i)2.8 E F0 +5.55(.T)C .05(he inte)434.622 420 R .05(ger ar)-.165 F(gu-)-.198 E 1.176 +(ment to)72 435 R F2(unsigned-inte)3.926 E -.11(ge)-.44 G -.22(r-).11 G +(>bitstring).22 E F0 1.177(must be non-ne)3.926 F -.055(ga)-.165 G(ti).055 E +-.165(ve)-.275 G(.).165 E F2(signed-inte)6.677 E -.11(ge)-.44 G -.22(r-).11 G +(>bitstring).22 E F0 1.177(uses tw)3.927 F(o')-.11 E(s)-.605 E +(complement representation for ne)72 450 Q -.055(ga)-.165 G(ti).055 E .33 -.165 +(ve i)-.275 H(nte).165 E(gers.)-.165 E F1(\(bitstring)72 480 Q F4(-)A F1 +(>unsigned-integer)A F2(bitstring)4.583 E F1 203.446(\)p)C -.198(ro)462.244 480 +S(cedur).198 E(e)-.198 E(\(bitstring)72 495 Q F4(-)A F1(>signed-integer)A F2 +(bitstring)4.583 E F1 215.678(\)p)C -.198(ro)462.244 495 S(cedur).198 E(e)-.198 +E F0 .9(Both procedures con)72 513.6 R -.165(ve)-.44 G .9(rt the gi).165 F +-.165(ve)-.275 G 3.65(nb).165 G .9(it string into an inte)235.23 513.6 R(ger) +-.165 E(.)-.605 E F2(bitstring->signed-inte)6.399 E -.11(ge)-.44 G(r).11 E F0 +(interprets)3.649 E(the bit string as the tw)72 528.6 Q(o')-.11 E 2.75(sc)-.605 +G(omplement representation of a signed inte)189.832 528.6 Q(ger)-.165 E(.)-.605 +E F1 2.75(6. Selecting)72 558.6 R(Components of Bit Strings)2.75 E +(\(bitstring-length)72 588.6 Q F2(bitstring)4.583 E F1 261.592(\)p)C -.198(ro) +462.244 588.6 S(cedur).198 E(e)-.198 E F0 +(This procedure returns the number of bits in the speci\214ed bit string.)72 +607.2 Q F1(\(bitstring-r)72 637.2 Q(ef)-.198 E F2(bitstring inde)4.583 E(x)-.22 +E F1 251.34(\)p)C -.198(ro)462.244 637.2 S(cedur).198 E(e)-.198 E F2 +(bitstring-r)72 655.8 Q(ef)-.407 E F0(returns #t if the)2.75 E F2(inde)2.75 E +(x)-.22 E F0(-th bit in the gi)A -.165(ve)-.275 G 2.75(nb).165 G +(it string is 1, #f otherwise.)310.48 655.8 Q F1(\(bitstring-substring)72 685.8 +Q F2(bitstring fr)4.583 E(om to)-.495 E F1 212.576(\)p)C -.198(ro)462.244 685.8 +S(cedur).198 E(e)-.198 E F0 1.018(This procedure returns a ne)72 704.4 R 3.768 +(wb)-.275 G 1.019(it string initialized with the bits of)213.358 704.4 R F2 +(bitstring)3.769 E F0 1.019(starting at the inde)3.769 F(x)-.165 E F2(fr)72 +719.4 Q(om)-.495 E F0(\(inclusi)2.75 E -.165(ve)-.275 G 2.75(\)a).165 G +(nd ending at the inde)149.275 719.4 Q(x)-.165 E F2(to)2.75 E F0(\(e)2.75 E +(xclusi)-.165 E -.165(ve)-.275 G(\).).165 E EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(7. Modifying)72 87 R(Bit Strings)2.75 E +(\(bitstring-\214ll!)72 117 Q/F2 11/Times-Italic@0 SF(bitstring init)4.583 E F1 +257.61(\)p)C -.198(ro)462.244 117 S(cedur).198 E(e)-.198 E F0 .138 +(This procedure sets all bits in the speci\214ed bit string to 1 if)72 135.6 R +F2(init)2.888 E F0 .138(is #t, or to 0 if)2.888 F F2(init)2.888 E F0 .137 +(is #f.)2.887 F .137(It returns)5.637 F(the non-printing object.)72 150.6 Q F1 +(\(bitstring-set!)72 180.6 Q F2(bitstring inde)4.583 E 2.75(xi)-.22 G(nit) +210.189 180.6 Q F1 230.66(\)p)C -.198(ro)462.244 180.6 S(cedur).198 E(e)-.198 E +F2(bitstring-set!)72 199.2 Q F0 .405(sets the)3.154 F F2(inde)3.155 E(x)-.22 E +F0 .405(-th bit in the speci\214ed bit string to 1 if)B F2(init)3.155 E F0 .405 +(is #t, or to 0 if)3.155 F F2(init)3.155 E F0 .405(is #f.)3.155 F(It)5.905 E +(returns the non-printing object.)72 214.2 Q F1(\(bitstring-mo)72 244.2 Q -.11 +(ve)-.11 G(!).11 E F2(dst-bitstring sr)4.583 E(c-bitstring)-.407 E F1 189.201 +(\)p)C -.198(ro)462.244 244.2 S(cedur).198 E(e)-.198 E F2(bitstring-mo)72 262.8 +Q(ve!)-.11 E F0(destructi)3.888 E -.165(ve)-.275 G 1.138 +(ly copies the contents of the bit string).165 F F2(sr)3.887 E(c-bitstring) +-.407 E F0(into)3.887 E F2(dst-bitstring)3.887 E F0(.)A +(Both bit strings must ha)72 277.8 Q .33 -.165(ve t)-.22 H(he same length.).165 +E(It returns the non-printing object.)5.5 E F1(\(bitstring-substring-mo)72 +307.8 Q -.11(ve)-.11 G(!).11 E F2(sr)4.583 E(c-bitstring fr)-.407 E(om)-.495 E +/F3 10/Times-Italic@0 SF(1)3.3 I F2(to)2.75 -3.3 M F3(1)3.3 I F2 +(dst-bitstring fr)2.75 -3.3 M(om)-.495 E F3(2)3.3 I F1 69.151(\)p)-3.3 K -.198 +(ro)462.244 307.8 S(cedur).198 E(e)-.198 E F0 .762(This procedure destructi)72 +326.4 R -.165(ve)-.275 G .763(ly copies the bits from).165 F F2(sr)3.513 E +(c-bitstring)-.407 E F0 .763(starting at inde)3.513 F(x)-.165 E F2(fr)3.513 E +(om)-.495 E F3(1)3.3 I F0(\(inclusi)3.513 -3.3 M -.165(ve)-.275 G(\)).165 E +.303(and ending at inde)72 341.4 R(x)-.165 E F2(to)3.053 E F3(1)3.3 I F0(\(e) +3.053 -3.3 M(xclusi)-.165 E -.165(ve)-.275 G 3.053(\)i).165 G(nto)233.247 341.4 +Q F2(dst-bitstring)3.053 E F0 .302(starting at inde)3.053 F(x)-.165 E F2(fr) +3.052 E(om)-.495 E F3(2)3.3 I F0(\(inclusi)3.052 -3.3 M -.165(ve)-.275 G 3.052 +(\). Ov).165 F(erlap-)-.165 E(ping is handled correctly)72 356.4 Q 5.5(.T)-.715 +G(he procedure returns the non-printing object.)195.321 356.4 Q F1 2.75 +(8. Bitwise)72 386.4 R(Logical Operations)2.75 E(\(bitstring-not)72 416.4 Q F2 +(bitstring)4.583 E F1 275.65(\)p)C -.198(ro)462.244 416.4 S(cedur).198 E(e) +-.198 E F0 .668(This procedure returns a ne)72 435 R 3.419(wb)-.275 G .669 +(it string initialized to the bitwise logical ne)211.609 435 R -.055(ga)-.165 G +.669(tion of the gi).055 F -.165(ve)-.275 G 3.419(nb).165 G(it)497.884 435 Q +(string.)72 450 Q F1(\(bitstring-not!)72 480 Q F2(dst-bitstring sr)4.583 E +(c-bitstring)-.407 E F1 198.749(\)p)C -.198(ro)462.244 480 S(cedur).198 E(e) +-.198 E F0 2.541(This procedure destructi)72 498.6 R -.165(ve)-.275 G 2.541 +(ly o).165 F -.165(ve)-.165 G 2.541(rwrites the contents of).165 F F2 +(dst-bitstring)5.291 E F0 2.54(with the bitwise logical)5.291 F(ne)72 513.6 Q +-.055(ga)-.165 G 1.246(tion of the bits in).055 F F2(sr)3.996 E(c-bitstring) +-.407 E F0 6.746(.B)C 1.246(oth bit strings must ha)247.522 513.6 R 1.576 -.165 +(ve t)-.22 H 1.246(he same length.).165 F F2(bitstring-not!)6.746 E F0 +(returns the non-printing object.)72 528.6 Q F1(\(bitstring-and)72 558.6 Q F2 +(bitstring)4.583 E F3(1)3.3 I F2(bitstring)2.75 -3.3 M F3(2)3.3 I F1 223.157 +(\)p)-3.3 K -.198(ro)462.244 558.6 S(cedur).198 E(e)-.198 E(\(bitstring-andnot) +72 573.6 Q F2(bitstring)4.583 E F3(1)3.3 I F2(bitstring)2.75 -3.3 M F3(2)3.3 I +F1 207.878(\)p)-3.3 K -.198(ro)462.244 573.6 S(cedur).198 E(e)-.198 E +(\(bitstring-or)72 588.6 Q F2(bitstring)4.583 E F3(1)3.3 I F2(bitstring)2.75 +-3.3 M F3(2)3.3 I F1 230.505(\)p)-3.3 K -.198(ro)462.244 588.6 S(cedur).198 E +(e)-.198 E(\(bitstring-xor)72 603.6 Q F2(bitstring)4.583 E F3(1)3.3 I F2 +(bitstring)2.75 -3.3 M F3(2)3.3 I F1 225.005(\)p)-3.3 K -.198(ro)462.244 603.6 +S(cedur).198 E(e)-.198 E F0 .017(These procedures return a ne)72 622.2 R 2.767 +(wb)-.275 G .017(it string initialized to the bitwise logical)215.063 622.2 R +F2(and)2.767 E F0(\(logical)2.767 E F2(and)2.767 E F0 .017(with the)2.767 F(ne) +72 637.2 Q -.055(ga)-.165 G .752(tion, logical).055 F F2(or)3.502 E F0 3.502 +(,l)C .752(ogical e)168.449 637.2 R(xclusi)-.165 E -.165(ve)-.275 G F2(or)3.667 +E F0 3.502(,r)C(especti)262.973 637.2 Q -.165(ve)-.275 G .753(ly\) of the tw) +.165 F 3.503(ob)-.11 G .753(it string ar)374.191 637.2 R 3.503(guments. The) +-.198 F(tw)3.503 E(o)-.11 E(bit strings must ha)72 652.2 Q .33 -.165(ve t)-.22 +H(he same length.).165 E F1(\(bitstring-and!)72 682.2 Q F2(dst-bitstring sr) +4.583 E(c-bitstring)-.407 E F1 196.296(\)p)C -.198(ro)462.244 682.2 S(cedur) +.198 E(e)-.198 E(\(bitstring-or!)72 697.2 Q F2(dst-bitstring sr)4.583 E +(c-bitstring)-.407 E F1 203.644(\)p)C -.198(ro)462.244 697.2 S(cedur).198 E(e) +-.198 E(\(bitstring-andnot!)72 712.2 Q F2(dst-bitstring sr)4.583 E(c-bitstring) +-.407 E F1 181.017(\)p)C -.198(ro)462.244 712.2 S(cedur).198 E(e)-.198 E +(\(bitstring-xor!)72 727.2 Q F2(dst-bitstring sr)4.583 E(c-bitstring)-.407 E F1 +198.144(\)p)C -.198(ro)462.244 727.2 S(cedur).198 E(e)-.198 E EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL 1.685(These procedures are the destructi)72 87 R 2.015 -.165(ve ve) +-.275 H 1.684(rsions of the four bitwise logical procedures described).165 F +(abo)72 102 Q -.165(ve)-.165 G 7.043(.T).165 G(he)114.452 102 Q 4.293(yp)-.165 +G 1.543(erform the corresponding logical operation on the tw)139.964 102 R +4.293(ob)-.11 G 1.543(it string ar)398.433 102 R 1.544(guments and)-.198 F +-.165(ove)72 117 S .167(rwrite the contents of).165 F/F1 11/Times-Italic@0 SF +(dst-bitstring)2.917 E F0 .167(with the result.)2.917 F .167 +(Both bit strings must ha)5.667 F .497 -.165(ve t)-.22 H .167(he same length.) +.165 F(These procedures return the non-printing object.)72 132 Q EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 13/Times-Bold@0 SF(Index)272.108 123 Q(B)72 174 Q F0 +(bitstring-and!,)72 204 Q/F2 12/Times-Bold@0 SF(3)2.75 E F0(bitstring-and,)72 +219 Q F2(3)2.75 E F0(bitstring-andnot!,)72 234 Q F2(3)2.75 E F0 +(bitstring-andnot,)72 249 Q F2(3)2.75 E F0(bitstring-append,)72 264 Q F2(2)2.75 +E F0(bitstring-cop)72 279 Q -.715(y,)-.11 G F2(1)3.465 E F0(bitstring-\214ll!,) +72 294 Q F2(3)2.75 E F0(bitstring-length,)72 309 Q F2(2)2.75 E F0(bitstring-mo) +72 324 Q -.165(ve)-.165 G(!,).165 E F2(3)2.75 E F0(bitstring-not!,)72 339 Q F2 +(3)2.75 E F0(bitstring-not,)72 354 Q F2(3)2.75 E F0(bitstring-or!,)72 369 Q F2 +(3)2.75 E F0(bitstring-or)72 384 Q(,)-.44 E F2(3)2.75 E F0(bitstring-ref,)72 +399 Q F2(2)2.75 E F0(bitstring-set!,)72 414 Q F2(3)2.75 E F0 +(bitstring-substring,)72 429 Q F2(2)2.75 E F0(bitstring-substring-mo)72 444 Q +-.165(ve)-.165 G(!,).165 E F2(3)2.75 E F0(bitstring-xor!,)72 459 Q F2(4)2.75 E +F0(bitstring-xor)72 474 Q(,)-.44 E F2(3)2.75 E F0(bitstring-zero?,)72 489 Q F2 +(2)2.75 E F0(bitstring.o, 1)72 504 Q(bitstring.scm, 1)72 519 Q(bitstring=?,)72 +534 Q F2(2)2.75 E F0(bitstring?,)72 549 Q F2(2)2.75 E F0(bitstring)72 564 Q/F3 +11/Symbol SF(-)A F0(>signed-inte)A(ger)-.165 E(,)-.44 E F2(2)2.75 E F0 +(bitstring)72 579 Q F3(-)A F0(>unsigned-inte)A(ger)-.165 E(,)-.44 E F2(2)2.75 E +F1(C)72 609 Q F0(concatenation, 2)72 639 Q F1(F)72 669 Q F0(feature, 1)302.4 +174 Q F1(L)302.4 204 Q F0(least signi\214cant bit, 1)302.4 234 Q(LSB, 1)302.4 +249 Q F1(M)302.4 279 Q F0(mak)302.4 309 Q(e-bitstring,)-.11 E F2(1)2.75 E F0 +(most signi\214cant bit, 1)302.4 324 Q(MSB, 1)302.4 339 Q F1(O)302.4 369 Q F0 +-.165(ove)302.4 399 S(rlapping, 3).165 E F1(P)302.4 429 Q F0 +(print representation, 1)302.4 459 Q F1(S)302.4 489 Q F0(signed-inte)302.4 519 +Q(ger)-.165 E F3(-)A F0(>bitstring,)A F2(2)2.75 E F1(T)302.4 549 Q F0(tw)302.4 +579 Q(o')-.11 E 2.75(sc)-.605 G(omplement, 2)333.761 579 Q(type predicate, 2) +302.4 594 Q F1(U)302.4 624 Q F0(unsigned-inte)302.4 654 Q(ger)-.165 E F3(-)A F0 +(>bitstring,)A F2(2)2.75 E EP +%%Page: 6 6 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 13/Times-Bold@0 SF -1.196(Ta)239.127 123 S(ble of Contents)1.196 E/F1 11 +/Times-Roman@0 SF .866(Introduction ..........................................\ +..............................................................................\ +......)72 177.6 R(1)498.5 177.6 Q(Using the Bit String Extension)72 196.2 Q +19.25(........................................................................\ +........................ 1)5.431 F(Creating Bit Strings)72 214.8 Q 19.25(.....\ +..............................................................................\ +............................... 1)2.989 F(Bit String Predicates)72 233.4 Q +19.25(........................................................................\ +........................................ 2)5.442 F(Inte)72 252 Q(ger Con)-.165 +E -.165(ve)-.44 G .118(rsions ................................................\ +..................................................................).165 F(2) +498.5 252 Q(Selecting Components of Bit Strings)72 270.6 Q 19.25(.............\ +.......................................................................... 2) +3.902 F(Modifying Bit Strings)72 289.2 Q 19.25(...............................\ +..............................................................................\ +. 3)4.815 F(Bitwise Logical Operations)72 307.8 Q 19.25(......................\ +..............................................................................\ +.. 3)3.011 F(Inde)72 326.4 Q 2.868(x.)-.165 G 19.25(..........................\ +..............................................................................\ +................................ 5)102.5 326.4 R EP +%%Trailer +end +%%EOF diff --git a/doc/cprog/Makefile b/doc/cprog/Makefile new file mode 100644 index 0000000..580c048 --- /dev/null +++ b/doc/cprog/Makefile @@ -0,0 +1,30 @@ +TROFF= groff -ms -t +UNROFF= unroff -ms +MKINDEX= ../util/mkindex + +cprog.ps: cprog.ms side.ref side.inx + $(MKINDEX) cprog.ms | sed -f side.ref | $(TROFF) 2> /dev/null > $@ + +side.ref: side + -cp side.ref side.ref.last + egrep "^s" side | sed "s/\.\//\//" >side.ref + +side.inx: side + egrep -v "^s" side | sort -f -t# +1 -3 +0n | \ + awk -f ../util/fixindex.awk | awk -f ../util/block.awk \ + >side.inx + +# | sed -e 's/[^"]*()/\\s-1\\f5&\\fP\\s0/' >side.inx + +side: cprog.ms + touch side.inx + $(MKINDEX) $? | sed -f side.ref.last | $(TROFF) 2>side >/dev/null + +cprog.html: cprog.ms side.ref + $(MKINDEX) cprog.ms |sed -f side.ref | $(UNROFF) document=cprog + +check: + cknr -c.Tc -a.Es.Ee.Cs.Ce cprog.ms + +clean: + rm -f side side.ref side.inx cprog.ps cprog.html diff --git a/doc/cprog/cprog.ms b/doc/cprog/cprog.ms new file mode 100644 index 0000000..7917276 --- /dev/null +++ b/doc/cprog/cprog.ms @@ -0,0 +1,3829 @@ +.\" $Revision: 1.25 $ +.\" +.ds Vs 3.0 +.\" +.so ../util/tmac.scheme +.\" +.\" Courier bold; used for system output in transcripts. +.ie \n(.U .fp 6 B +.el .fp 6 CB +.\" +.\" Code start. +.de Cs +.nr sF \\n(.f +.ft 5 +.ps -1 +.vs -1 +.ie \n(.U .RS +.el .in 1c +.nf +.if !\n(.U .sp .3c +.. +.\" Code end. +.de Ce +.fi +.ie \n(.U .RE +.el .in +.vs +.ps +.ft \\n(sF +.. +.\" Newline in code. +.de Cl +.sp .6 +.. +.\" Same as .Cl +.de El +.Cl +.. +.\" Example start/end. As floating keeps (used for figures +.\" in this document) and regular keeps cannot be mixed, the +.\" functionality must be simulated here. This sucks... +.de Es +.Cs +.if !\n(.U .di EE +.. +.de Ee +.Ce +.if !\n(.U \{\ +.di +.if \\n(dn-\\n(.t .sp 1000 +.nf +.EE +.fi +.sp .5 +.\} +.. +.\" .K1 header-text +.\" Major heading with TOC entry. +.de K1 +.NH +\\$1 +.XS +\\*(SN \\$1 +.XE +.. +.\" .K2 header-text +.\" Level-2 heading with TOC entry. +.de K2 +.NH 2 +\\$1 +.XS \\n(PN 2n +\\*(SN \\$1 +.XE +.. +.\" .K3 header-text +.\" Level-3 heading with TOC entry. +.de K3 +.NH 3 +\\$1 +.XS \\n(PN 4n +\\*(SN \\$1 +.XE +.. +.\" .AP appendix-text +.\" Appendix with TOC entry. +.de AP +.ie \\n(.U .NH +.el .SH +\\$1 +.XS +\\$1 +.XE +.. +.\" .Rf name value +.\" Reference anchor. Each occurrence of `name' anywhere in +.\" the document will be replaced by `value'. +.de Rf +.if !\n(.U .tm s/@(\\$1)/\\$2/g +.. +.\" +.\" Counter for Figures (auto-pre-increment). +.nr fS 0 1 +.\" +.\" Figure start. +.de Fs +.br +.ie \\n(.$ .KS +.el .KF +.sp 1.2 +\u\l'\\n(.lu_'\d +.nr sF \\n(.f +.ft 5 +.ps -1 +.vs -1 +.nf +.. +.\" .Fc caption-text +.\" Figure caption. Used at end of Figure, before .Fe. +.de Fc +.sp .2 +.fi +.ps +.vs +.ft \\n(sF +.ce 999 +\s-1\f3Figure \\n+(fS:\fP \c +\\$1\s0 +.if \\n(.$=2 \s-1\&\\$2\s0 +.ce 0 +.. +.\" .Fe name +.\" Figure end. Defines a reference anchor `name' with the +.\" number of the Figure as value. +.de Fe +.Rf \\$1 \\n(fS +.LP +\l'\\n(.lu_' +.sp +.KE +.. +.\" Relative indent start. +.de Rs +.if !\\n(.U .RS +.. +.\" Relative indent end. +.de Re +.if !\\n(.U .RE +.. +.\" +.TL +Building Extensible Applications with Elk \*- +.sp .3 +C/C++ Programmer's Manual +.AU +Oliver Laumann +.AB +Elk (\f2Extension Language Kit\fP) is a Scheme implementation designed +as an embeddable, reusable extension language subsystem for +integration into existing and future applications written in C or C++. +The programmer's interface to Elk provides for a close interworking of +the C/C++ parts of Elk-based, \f2hybrid\fP applications with extensible +Scheme code. +This manual describes the facilities of the C/C++ programmer's +interface that can be used by authors of extensible applications and +Scheme extensions. +Topics range from the architecture of Elk-based applications +and the definition of application-specific Scheme types and primitives +to more advanced subjects such as weak data structures and interacting with +the garbage collector. +Many examples throughout the text illustrate the facilities and +techniques discussed in this manual. +.AE +.\" --------------------------------------------------------------------------- +.K1 "Additional Documentation" +.PP +The official specification of the Scheme programming language is +the @[.``R\*(^4RS''] (William Clinger and Jonathan Rees (editors), +\f2Revised\*(^4 Report on the Algorithmic Language Scheme\fP, +1991). +A slightly modified version of an earlier revision of this report +was adopted as an IEEE an ANSI standard in 1990 (IEEE\|Std\|1178-1990, +\f2IEEE Standard for the Scheme Programming Language\fP, 1991). +.PP +The dialect of Scheme implemented by Elk (a superset of the +official language) is described in the \f2Reference Manual for the +Elk Extension Language Interpreter\fP that is included in the +Elk distribution as troff source and preformatted PostScript files. +Reference manuals for the various predefined Elk extensions +(such as the UNIX and X11 extensions) are also part of the distribution; +see the file ``doc/README'' for an overview of the available +documentation. +.PP +This manual supersedes the document \f2Interfacing Scheme to the +``Real World''\fP that was included in earlier versions of Elk. +.PP +An article about Elk has appeared in USENIX Computing Systems +in 1994 (Oliver Laumann and Carsten Bormann, Elk: The Extension Language Kit, +\f2USENIX Computing Systems\fP, vol.\& 7, no.\& 4, pp.\& 419\-449). +.PP +A recent example of an application that uses Elk as its extension +language implementation is freely available in source and binary +form as \f2http://www.informatik.uni-bremen.de/~net/unroff\fP. +@[.\f2unroff\fP] is a programmable, extensible troff translator with +Scheme-based back-ends for the Hypertext Markup Language. +The source code shown in Appendix B has been directly taken from the +\f2unroff\fP source; authors of Elk-based applications are +encourage to reuse this and other parts of the \f2unroff\fP +source for their own projects. +.\" --------------------------------------------------------------------------- +.K1 "Introduction" +.PP +This manual can be roughly divided into two parts. +The first part (chapters\ @(ch-arch) to\ @(ch-static)) describes the +architectural aspects of Elk-based applications and Elk extensions. +Facilities and tools for building extensible applications with Elk are +introduced here. +Readers who are already familiar with the concepts explained in +this part of the document may want to skip it and begin +reading at chapter\ @(ch-notes) or later. +The second part (covering chapters\ @(ch-notes) to\ @(ch-advanced)) +specifies the C functions and types available to application +programmers and describes techniques for building data structures that can +be interfaced to Scheme in an efficient way. +Appendix C briefly summarizes all the functions, macros, types, and +variables exported by the Elk kernel to the C/C++ programmer. +.PP +Here is a short overview of the remaining chapters of this manual. +Chapter\ @(ch-arch) discusses the architecture of extensible +applications based on Elk and their relation to Elk extensions. +Chapter\ @(ch-linking) provides an overview of the two basic +methods for integrating an application (or extensions) with Elk: +dynamic loading and static linking. +Chapter\ @(ch-dynl) describes use of dynamic loading in more detail; +topics include automatic extension initialization and C++ static +constructors embedded in dynamically loaded modules. +Chapter\ @(ch-static) describes several forms of linking user-supplied +code with Elk statically and how these affect the structure +of an application's \f2main()\fP function. +.PP +The remaining chapters are a complete specification of the +functions and types of the C/C++ programmer's interface to Elk. +Chapter\ @(ch-notes) provides introductory notes and advice for +programmers of C/C++ code interfacing to Elk (use of include +files, predefined preprocessor symbols, etc.). +Chapter\ @(ch-anatomy) describes the anatomy of Scheme objects +from the C/C++ programmer's point of view. +Chapter\ @(ch-defprim) explains how applications and extensions can +define new Scheme primitives. +Chapter\ @(ch-types) presents the standard, built-in Scheme types +implemented by Elk (numbers, pairs, vectors, etc.) and functions +for creating and accessing Scheme objects of these types from +within C/C++ code. +The facilities for defining new, first-class Scheme data types +are described in chapter\ @(ch-deftype). +Finally, chapter\ @(ch-advanced) deals with a number of more +advanced topics, such as functions for interacting with the +garbage collector, automatic finalization of inaccessible objects, +definition of user-supplied reader functions, error handling, etc. +.PP +A note on the naming conventions followed by the C identifiers +used throughout this document: +the names of all functions, macros, types, and variables exported by +Elk have their components separated by underscores and capitalized +(as in \f2Register_Object()\fP, for example). +In contrast, the names defined by examples shown in this manual only +use lower case letters, so that they can be distinguished easily from +predefined functions exported by Elk. +.\" --------------------------------------------------------------------------- +.K1 "The Architecture of Extensible Applications" +@[.=application architecture]@[.=extensible application] +.Rf ch-arch \*(SN +.PP +Extensible applications built with Elk are @[.=hybrid application] +\f2hybrid\fP in that they consist of code written in a mixture of +languages\*-code written in the application's +@[.\f2implementation language\fP] (C or C++) and code written in the +@[.\f2extension language\fP] (Scheme). +An application of this kind is usually composed of two layers, +a low-level C/C++ layer that provides the basic, +performance-critical functionality of the application, and on top of +that a higher-level layer which is written in Scheme and interpreted +at runtime. +.PP +The Scheme-language portion of an Elk-based application may range from +just a few dozen lines of Scheme code (if a simple form of +customization is sufficient) to fifty percent of the application or +more (if a high degree of extensibility is required). +As Scheme code is interpreted at runtime by an interpreter embedded +in the application, users can customize and modify the application's +Scheme layer or add and test their own Scheme procedures; +recompilation, access to the C/C++ source, or knowledge of the +implementation language are not required. +Therefore, an application can achieve highest extensibility by +restricting its low-level part to just a small core of time-critical +C/C++ code. +.PP +To enable extensions to ``work on'' an application's internal data +structures and state, the application core exports a set of new, +application-specific Scheme data types +and primitives operating on them to the Scheme layer. +These types and primitives can be thought of as a ``wrapper'' +around some of the C/C++ types and functions used by the application's core. +For example, the core of an Elk-based newsreader program would export +first-class Scheme types representing \f2newsgroups\fP, +\f2subscriptions\fP, and \f2news articles\fP; these types would +encapsulate the corresponding low-level C ``structs'' or C++ classes. +In addition, it would export a number of Scheme primitives to +operate on these types\*-to create members of them (e.\|g.\& by +reading a news article from disk), to present them to the user through +the application's user-interface, etc. +Each of these primitives would recur on one or more corresponding C or +C++ functions implementing the functionality in an efficient way. +.PP +Another job of the low-level C/C++ layer of an application is to hide +platform-specific or system-specific details by providing suitable +abstractions, so that the Scheme part can be kept portable and simple. +For example, in case of the newsreader program, extension writers +should not have to care about whether the news articles are stored in a +local file system or retrieved from a network server, or about the +idiosyncrasies of the system's networking facilities. +Most of these system-specific details can be better dealt with in a +language oriented towards systems programming, such as C, than in +Scheme. +.PP +To decide whether to make a function part of the low-level +part of an application or to write it in the extension language, +you may ask yourself the following questions: +.IP \(bu +\f2Is the function performance-critical?\&\fP +.RS +.LP +If the answer to this question is \f2yes\fP, +put the function into the C/C++ core. +For example, in case of the newsreader application, a primitive to search +all articles in a given newsgroup for a pattern is certainly +performance-critical and would therefore be written in the +implementation language, while a function to ask the user to +select an item from a list of newsgroups is not time-critical +and could be written Scheme. +.RE +.IP \(bu +\f2Does the function have to deal with platform-specific details?\&\fP +.RS +.LP +For example, a function that needs to allocate and open a UNIX +pseudo-tty or to establish a network connection needs to care +about numerous system-specific details and different kinds of +operating system facilities and will therefore be written in +C/C++ rather than in Scheme. +.RE +.IP \(bu +\f2In which language can the function be expressed more ``naturally''?\&\fP +.RS +.LP +A function that parses and tokenizes a string can be expressed more +naturally (that is, in a significantly more concise and efficient +way) in a language such as C than in Scheme. +On the other hand, functions to construct trees of news articles, to +traverse them, and to apply a function to each node are obvious +candidates for writing them in a Lisp-like language (Scheme). +.RE +.IP \(bu +\f2Are customizability and extensibility important?\&\fP +.RS +.LP +If it is likely that the application's users will want to customize +or augment a function or even replace it with their own versions, +write it in the extension language. +If, for some reason, this is impossible or not practicable, at least +provide suitable @[.``hooks''] that enable users to influence the +function's operation from within Scheme code. +.RE +.\" --------------------------------------------------------------------------- +.K2 "Scheme Extensions" +@[.=Scheme extensions] +.PP +In addition to the Scheme interpreter component, Elk consists of +a number of \f2Scheme extensions\fP. +These extensions are not specific to any kind application and are +therefore reusable. +They provide the ``glue'' between Scheme and a number of +external libraries, in particular the X11 libraries and the UNIX C +library (exceptions are the @[.record extension] and the +@[.bitstring extension] which provide a functionality of their own). +The purpose of these extensions +is to make the functionality of the external libraries +(for example, the UNIX system calls) available to Scheme as Scheme data +types and primitives operating on them. +.PP +While the Scheme extensions are useful for writing freestanding Scheme +programs (e.\|g.\& for @[.rapid prototyping] of X11-based Scheme programs), +their main job is to help building applications that +need to interface to external libraries on the extension language +level. +The @[.X11 extension]s, for instance, are intended to be used +by applications with a graphical user interface based on the +X window system. +By linking the X11 extensions (in addition to the Scheme interpreter) +with an Elk-based application, +the application's user interface can be written entirely +in Scheme and will therefore be inherently customizable and extensible. +As the Scheme extensions are reusable and can be shared between +applications, extension language code can be written in a portable +manner. +.\" --------------------------------------------------------------------------- +.K2 "Applications versus Extensions" +.PP +As far as the C/C++ programmer's interface to Elk (that is, the subject +of this manual) is concerned, there is not really a technical +difference between Scheme \f2extensions\fP on the one hand (such as the +X11 extensions), and Elk-based, extensible \f2applications\fP on the +other hand. +Both are composed of an efficient, low-level C/C++ core and, +above that, a higher-level layer written in Scheme. +In both cases, the C/C++ layer exports a set of Scheme types and +primitives to the Scheme layer (that is, to the Scheme +\f2programmer\fP) and thus needs to interact with the Scheme interpreter. +Because of this analogy, the rest of the manual will mostly drop +the distinction between applications and extensions and concentrate +on the interface between C/C++ and Elk. +.PP +The only noteworthy difference between applications and extensions +is that the former tend to have their own @[.\f2main()\fP] +function that gains control on startup, while Scheme extensions do not +have a \f2main()\fP entry point\*-they are usually loaded into the +interpreter (or application) during runtime. +This distinction will become important in the next chapter, when +the different ways of joining Elk and C/C++ code will be discussed. +.\" --------------------------------------------------------------------------- +.K1 "Linking Applications and Extensions with Elk" +.Rf ch-linking \*(SN +.PP +There are two different mechanisms for integrating compiled C/C++ code +(extensions or an application) with Elk: +@[.\f2static linking\fP] and @[.\f2dynamic loading\fP]. +The object files that make up an Elk-based application are usually +linked statically with the Scheme interpreter in the normal +way to produce an executable program. +Compiled extensions, on the other hand, are usually dynamically +loaded into the running Scheme interpreter as they are needed. +These conventions reflect the normal case; +Scheme extensions may as well be linked statically with the interpreter +.IP \(bu +to produce a ``specialized'' instance of the interpreter (for example, +when developing X11-based Scheme code, an extended version of the +interpreter may be produced by linking it statically with the +X11 extensions); +.IP \(bu +if a particular extension is required by an application from the +beginning (an application with an X-based user-interface would +be linked with the X11 extensions statically, as loading on-demand would +not be useful in this case); +.IP \(bu +on the (few) platforms where dynamic loading is not supported or +where dynamic loading has a large performance overhead. +.PP +Likewise, dynamic loading is not only useful for on-demand loading +of reusable Scheme extensions; \f2applications\fP can benefit +from this facility as well. +To reduce the size of the final executable, parts of an +application may loaded dynamically rather than linked statically if +they are used infrequently or if only a few of them are used at a time. +Dynamic loading enables the author of an extensible application to +decompose it into an arbitrary number of individual parts as an +alternative to combining them statically into a large, monolithic +executable. +An extensible newsreader program, for example, may include a separate +spelling check module that is dynamically loaded the first time it +is needed (i.\|e.\& when a newly written news article is to be +spell-checked). +.PP +The capability to dynamically load compiled C/C++ code into a running +application enables users to write @[.\f2hybrid extension]s\fP which +consist of a low-level C/C++ part and a high-level part written in +Scheme. +As a result, extensions can execute much faster (extensions to the +Emacs editor, for example, must be entirely written in Emacs-Lisp and +can therefore become slow if sufficiently complex); and +extensions can deal more easily with low-level, platform-specific +details. +.\" --------------------------------------------------------------------------- +.K1 "Dynamic Loading" +.Rf ch-dynl \*(SN +@[.=dynamic loading] +.PP +Object files (compiled C/C++ code) are loaded by means of the standard +@[.\f2load\fP primitive] of Scheme, just like ordinary Scheme files. +All you need to do is to compile your C or C++ source file, +apply the @[.\f2makedl\fP script] that comes with the Elk distribution +to the resulting object file, and load it into the interpreter or +application. +\f2makedl\fP prepares object files for dynamic loading (which is +a no-op on most platforms) and combines several object files into +one to speed up loading; arguments are the output file and one +or more input files or additional libraries (input and output file +may be identical): +.Es +\f6%\fP cc \-c \-I/usr/elk/include file.c +\f6%\fP /usr/elk/lib/makedl file.o file.o +\f6%\fP scheme +\f6>\fP (load 'file.o) +\f6>\fP +.Ee +(This examples assumes that Elk has been installed under ``/usr/elk'' +on your site. +Additional arguments may be required for the call to \f2cc\fP.) +.PP +Elk does not attempt to discriminate object code and Scheme code +based on the files' contents; the names of object files are +required to end in ``.o'', the standard suffix for object modules +in UNIX. +Scheme files, on the other hand, end in ``.scm'' by convention. +This convention is not enforced by Elk\*-everything that is not +an object file is considered to be a Scheme file. +A list of object files may be passed to the \f2load\fP primitive +which may save time on platforms where a call to the system linker +is involved. +.PP +Loading object files directly as shown above is uncommon. +Instead, the Scheme part of a @[.hybrid extension] usually loads its +corresponding object file (and all the other files that are required) +automatically, so that one can write, for example, +.Es +(require 'unix) +.Ee +to load the @[.UNIX extension]. +This expression causes the file \f2unix.scm\fP to be loaded, which +then loads the object file \f2unix.o\fP\*-the UNIX extension's low-level +part\*-automatically on startup. +Additional \f2load-libraries\fP (as explained in the next section) +may be set by the Scheme file immediately before loading the +extension's object file. +.PP +When an object file is loaded, @[.unresolved reference]s are resolved +against the symbols exported by the running interpreter or by the +combination of an application and the interpreter (the \f2base +program\fP). +This is an essential feature, as dynamically loaded extensions +must be able to reference the elementary Scheme primitives +defined by the interpreter core +and all the other functions that are available to the +extension/application programmer. +In addition, references are resolved against the symbols exported +by all previously loaded object files. +The term @[.\f2incremental loading\fP] is used for this style of dynamic +loading, as it allows building complex applications from small +components incrementally. +.\" --------------------------------------------------------------------------- +.K2 "Load Libraries" +.PP +Dynamically loadable object files usually have unresolved references +into one or more libraries, most likely at least into the standard +@[.C library]. +Therefore, when loading an object file, references are resolved not +only against the base program and previously loaded object files, +but also against a number of user-supplied @[.\f2load libraries\fP]. +The @[.X11 extension]s of Elk, for instance, need to be linked +against the respective libraries of the @[.X window system], such as +\f2libX11\fP and \f2libXt\fP. +These load libraries can be assigned to the Scheme variable +\f2load-libraries\fP which is bound in the top-level environment +of Elk. +Typically, \f2load-libraries\fP is dynamically assigned a set of +library names by means of @[.\f2fluid-let\fP] immediately before calling +\f2load\fP. +For example, the @[.Xlib extension] (\f2xlib.scm\fP) contains +code such as +.Es +(fluid-let + ((load-libraries + (string-append "\-L/usr/X11/lib \-lX11 " load-libraries))) + (load 'xlib.o)) +.Ee +to load the accompanying object file (\f2xlib.o\fP), linking it against the +system's X library in addition to whatever libraries were already in +use at that point. +The default value of \f2load-libraries\fP is ``\-lc'' (i.\|e.\& the +C library), as extensions are likely to use functions from this +library in addition to those C library functions that have already +been linked into the base program or have been pulled in by +previously loaded object files. +By using \f2string-append\fP in the example above, the specified +libraries are added to the default value of \f2load-libraries\fP rather +than overwriting it. +The exact syntax of the load libraries is platform specific. +For instance, ``\-L/usr/X11/lib'' as used above is +recognized by the system linker of most UNIX variants as an option +indicating in which directory the libraries reside on the system, +but different options or additional libraries are required on certain +platforms (as specified by the platform's ``config/site'' file +in the Elk distribution). +.\" --------------------------------------------------------------------------- +.K2 "Extension Initializers and Finalizers" +.PP +When loading an object file, Elk scans the file's symbol table +for the names of @[.extension initialization function]s or +@[.\f2extension initializer\fP]s. +These extension initializers are the initial entry points to +the newly loaded extension; their names must have the prefix +@[.``elk_init_''] (earlier the prefix ``init_'' was used; it was changed +in Elk \*(Vs to avoid name conflicts). +Each extension initializer found in the object file is invoked +to pass control to the extension. +The job of the extension initializers is to register the Scheme +types and primitives defined by the extension with the interpreter +and to perform any dynamic initializations. +.PP +As each extension may have an arbitrary number of initialization +functions rather than one single function with a fixed name, extension +writers can divide their extensions into a number of independent +modules, each of which provides its own initialization function. +The compiled modules can then be combined into one dynamically loadable +object file without having to lump all initializations into a central +initialization function. +.PP +In the same manner, extension can define an arbitrary number of +@[.\f2extension finalization function]s\fP which are called on termination +of the Scheme interpreter or application. +The names of finalization functions begin with @[.``elk_finit_'']. +Extension finalization functions are typically used for clean-up +operations such as removing temporary files. +.PP +The extension initializers (as well as the finalizers) are called +in an unspecified order. +.\" --------------------------------------------------------------------------- +.K2 "C++ Static Constructors and Destructors" +.PP +In addition to calling extension initialization functions, the +\f2load\fP primitives invokes all @[.C++ static constructor]s that are +present in the dynamically loaded object file in case it contains +compiled C++ code. +Likewise, @[.C++ static destructor]s are called automatically on +termination. +The constructors and destructors are called in an unspecified order, +but all constructors (destructors) are called before calling any +extension initializers (finalizers). +Elk recognizes the function name prefixes of static constructor and +destructor functions used by all major UNIX @[.C++ compiler]s; new prefixes +can be added if required. +.\" --------------------------------------------------------------------------- +.K1 "Static Linking" +@[.=static linking] +.Rf ch-static \*(SN +.PP +Linking user-supplied code with Elk statically can be used as an +alternative to dynamic loading on platforms that do not support it, +for applications with their own @[.\f2main()\fP], +and to avoid the overhead of loading frequently used Elk extensions. +Dynamic loading and static linking may be used in combination\*- +additional object files can be loaded in a running executable +formed by linking the Scheme interpreter with extensions or with +an application (or parts thereof). +.PP +When making the Scheme interpreter component of Elk, these executables +and object files get installed (relative to your \f2install_dir\fP +which usually is ``/usr/elk'' or ``/usr/local/elk''): +.Rs +.IP \f2bin/scheme\fP +The freestanding, plain Scheme interpreter. +.IP \f2lib/standalone.o\fP +@[.=standalone.o] +The Scheme interpreter as a relocatable object file which can be +linked with user-supplied object files to form an executable. +This object file contains a \f2main()\fP function; thus the +Scheme interpreter starts up in the normal way when the executable +is invoked. +.IP \f2lib/module.o\fP +@[.=module.o] +Like \f2standalone.o\fP, except that the object file does not +export its own \f2main()\fP function. +Therefore, the object files linked with it have to supply a \f2main()\fP. +.Re +.PP +The object file \f2standalone.o\fP is typically linked with a number +of Elk extensions (e.\|g.\& the X11 extensions), while \f2module.o\fP +is used by Elk-based applications which contribute their own +\f2main()\fP and need to be ``in control'' on startup. +.\" --------------------------------------------------------------------------- +.K2 "Linking the Scheme Interpreter with Extensions" +.PP +A shell script @[.\f2linkscheme\fP] (installed as ``lib/linkscheme'') +simplifies combining the Scheme interpreter with a number +of\*-user-supplied or predefined\*-extensions statically. +This script is called with the name of the output file (the resulting +executable) and any number of object files and libraries. +It basically links the object files and libraries with +``standalone.o'' and supplies any additional libraries that may +be required by the interpreter. +In general, this can be done just as well by calling the linker or +compiler directly, but \f2linkscheme\fP also takes care of +additional processing that needs to be performed on at least one +platform (currently AIX). +.PP +To create an instance of Elk including the Xlib, Xt, and Xaw +extensions, \f2linkscheme\fP would be used as follows (again +assuming you have installed the software under ``/usr/elk''): +.Es +\f6%\fP cd /usr/elk +\f6%\fP lib/linkscheme x11scheme runtime/obj/xt.o runtime/obj/xaw/*.o \e + \-lXaw \-lXmu \-lXt \-lSM \-lICE \-lX11 \-lXext +.Ee +.PP +The exact form of the libraries depends on your platform and X11 +version; for example, additional options may be required if X11 +is not installed in a standard location at your site. +\f2xlib.o\fP is the @[.Xlib extension], \f2xt.o\fP is the X toolkit +intrinsics (Xt) extension, and the subdirectory \f2xaw\fP holds +the object files for all the @[.Athena widgets]. +The executable \f2x11scheme\fP can now be used to run arbitrary +X11 applications using the Athena widgets without requiring +any runtime loading of object files belonging to the +@[.X11 extension]s: +.Es +\f6%\fP x11scheme +\f6>\fP (load '../examples/xaw/dialog.scm) +[Autoloading xwidgets.scm] +[Autoloading xt.scm] +[Autoloading siteinfo.scm] +\&... +.Ee +.PP +In the same way, \f2linkscheme\fP can be used to link the +Scheme interpreter with any new, user-supplied extensions, +with parts of an Elk-based application, or with any combination +thereof. +.\" --------------------------------------------------------------------------- +.K3 "Automatic Extension Initialization" +.Rf ch-autoinit \*(SN +.PP +When linking Elk with extensions, it is \f2not\fP necessary to add +calls to the @[.extension initializer]s to the Scheme interpreter's +\f2main()\fP function and recompile the interpreter; +all extensions are initialized automatically on startup. +To accomplish this kind of automatic initialization, Elk scans +its own symbol table on startup, invoking any @[.``elk_init_''] +functions and @[.C++ static constructor]s, in the +same way the symbol table of object files is scanned when +they are dynamically loaded. +@[.Extension finalizer]s and @[.C++ static destructor]s are saved +for calling on exit. +Automatic extension initialization only works if +.Rs +.IP \(bu +the executable file has a symbol table (i.\|e.\& you must not +strip it) +.IP \(bu +the executable file can be opened for reading +.IP \(bu +the interpreter can locate its executable file by scanning the +shell's directory search path. +.Re +.PP +The performance overhead caused by the initial scanning of the +symbol is small; the program's symbol table can be read or mapped +into memory efficiently (it it has not been automatically mapped +into the address space by the operating system in the first place). +.\" --------------------------------------------------------------------------- +.K2 "Linking the Scheme Interpreter with an Application" +.PP +Elk-based applications that have their own \f2main()\fP are linked with +the Scheme interpreter installed as \f2module.o\fP which, unlike +\f2standalone.o\fP, does not export a \f2main()\fP function. +No special \f2linkscheme\fP script is required to link with \f2module.o\fP; +application writers usually will add ``/usr/elk/lib/module.o'' +(or whatever the correct path is) to the list of object files +in their Makefile. +To simplify linking with Elk, a trivial script @[.\f2ldflags\fP] +(which lives in ``lib'' along with \f2linkscheme\fP) is supplied that +just echoes any additional libraries required by the Scheme +interpreter. +Application developers may use \f2ldflags\fP in their Makefiles. +.PP +As \f2module.o\fP does not have a \f2main()\fP entry point, +an application using it must initialize the interpreter from +within its own \f2main()\fP. +This is done by calling .@[.\f2Elk_Init()\fP]: +.Es +void Elk_Init(int argc, char **argv, int init_flag, char *filename); +.Ee +.PP +\f2Elk_Init()\fP is only defined by \f2module.o\fP and is essentially +a ``wrapper'' around the Scheme interpreter's \f2main()\fP. +\f2argc\fP and \f2argv\fP are the arguments to be passed to +the Scheme interpreter's \f2main()\fP. +These may or may not be the calling program's original arguments; +however, @[.\f2argv[0\]\fP] must be that from the calling program +in any case (because its address is used by Elk to determine +the program's stack base). +If \f2init_flag\fP is nonzero, the interpreter scans its symbol table +to invoke @[.extension initializer]s as described in @(ch-autoinit). +@[.C++ static constructor]s, however, are never invoked by +\f2module.o\fP (regarless of \f2init_flag\fP), because they are already +taken care of by the runtime startup in this case. +If \f2filename\fP is nonzero, it is the name of Scheme file to +be loaded by \f2Elk_Init()\fP. +.\" --------------------------------------------------------------------------- +.K3 "An Example ``main()'' Function" +.PP +Figure @(main) shows a realistic (yet somewhat simplified) example +\f2main()\fP function of an application using Elk. +.Fs +char *directory; +.El +int main(int ac, char **av) { + char **eav; + int eac = 1, c; +.El + Set_App_Name(av[0]); + eav = safe_malloc((ac+2+1) * sizeof(char *)); /* ac + -p xxx + 0 */ + eav[0] = av[0]; + while ((c = getopt(ac, av, "gh:o")) != EOF) switch (c) { + case 'o': + \f2process option...\fP + case 'g': + eav[eac++] = "-g"; break; + case 'h': + eav[eac++] = "-h"; eav[eac++] = optarg; break; + case '?': + usage(); return 1; + } + if ((directory = getenv("APP_DIR")) == 0) + directory = DEFAULT_DIR; + eav[eac++] = "-p"; + eav[eac] = safe_malloc(strlen(directory) + 11); + sprintf(eav[eac++], ".:%s/elk/scm", directory); + eav[eac] = 0; + Elk_Init(eac, eav, 0, 0); +.El + \f2initialize application's modules...\fP +.El + boot_code(); +.El + \f2application's main loop (if written in C)\fP + ... +.Fc "Example \f2main()\fP of an Elk-based application (simplified)" +.Fe main +.PP +The code shown in the example must construct a new argument +vector to be passed to \f2Elk_Init()\fP, because the application +has command line options of its own (just \f2\-o\fP in the example). +Two Elk-options (\f2\-g\fP and \f2\-h\fP) are handed to +\f2Elk_Init()\fP if present, so that a mixture of Elk-specific and +application-specific options can be given (see the manual page for +the Scheme interpreter for the meaning of Elk's options). +(\f2safe_malloc()\fP is assumed to be a wrapper around \f2malloc()\fP +with proper error-checking.) +@[.\f2Set_App_Name()\fP] is provided by Elk and is called with a name +to be displayed in front of fatal error messages by the interpreter. +.PP +When all the options have been parsed, an additional option +\f2\-p\fP is synthesized to provide a minimal initial @[.\f2load-path\fP] +for Elk. +This load-path consists of the current directory and a subdirectory +of the directory under which the application expects its files +that are needed during runtime. +An environment variable can be used to set this directory. +Defining a load-path like this has the benefit that a minimal, +self-contained Elk runtime environment (e.\|g.\& a toplevel +and the debugger) can be shipped with binary distributions of the +application so that users are not required to have Elk installed at +their sites. +.PP +When Elk has been initialized by calling \f2Elk_Init()\fP, +the application may initialize all its other modules and finally +load an initial Scheme file that ``boots'' the Scheme part of the +application (which may involve loading further Scheme files). +This initial Scheme file may be quite simple and just define a few +functions used later, or it main contain the application's entire +``driving logic'' or interactive user-interface. +This is accomplished by a function \f2boot_code()\fP which may +as simple as this: +.Es +void boot_code(void) { + char *fn = safe_malloc(strlen(directory) + 30); +.El + sprintf(fn, "%s/scm/app.scm", directory); + Set_Error_Tag("initial load"); + Load_File(fn); + free(fn); +} +.Ee +.PP +@[.\f2Load_File()\fP] is defined by Elk and loads a Scheme file +whose name is supplied as a C string. +@[.\f2Set_Error_Tag()\fP] may be used by extensions and applications to +define the symbol that is passed as the first argument to the +standard @[.error handler] when a Scheme error is signaled +(see section @(ch-error)). +.\" --------------------------------------------------------------------------- +.K2 "Who is in Control?" +.Rf ch-control \*(SN +.PP +When an application's object files are loaded into the interpreter +dynamically or are linked with the interpreter using @[.\f2linkscheme\fP], +control initially rests in the interpreter. +In contrast, when the application is linked using @[.\f2module.o\fP] +and @[.\f2Elk_Init()\fP] as shown in the previous section, it defines +its own \f2main()\fP function, and hence the application is +``in control'' on startup. +.PP +From a technical point of view, it does not really make a difference +whether control rests in the interpreter or in the application +initially. +In the first case, the main ``driving logic'' (or ``main loop'') of +the application can simply be wrapped in a Scheme primitive which +is then called by the Scheme toplevel on startup to pass control +back to the application, if this is desired. +In any case, control usually changes frequently between the Scheme +interpreter and the actual application anyway\*-the Scheme interpreter +invokes callback functions or Scheme primitives provided by the +application, which may in turn invoke Scheme procedures or load +Scheme files, and so on. +.PP +The @[.Tcl]-like style of use, where control rests in the C-part of the +application most of the time, and where this C code ``calls out'' to +the interpreter occasionally by passing it an extension language +expression or a small script, is not typical for Elk. +It is supported, though; Elk provides a simple extension +to pass a Scheme expression to the interpreter as a C string and +receive the result in the same form, similar to what \f2Tcl_Eval()\fP +does in Tcl (see section @(ch-funcall)). +In a typical Elk-based application the extension language serves +as the ``backbone'' of the application: +the application's driving logic or main loop is written entirely in +Scheme, and this Scheme code calls out to the application's C layer, +using the data types, primitives, and other callbacks exported to the +extension language by the application. +With the help of the @[.X11 extension]s, the entire (graphical) user +interface of an application can be written in Scheme easily; +control can then passed to the application's C/C++ layer whenever +an Xt callback is triggered. +In this case, the application's ``main loop'' consists of a call +to the Scheme primitive corresponding to the X toolkit function +\f2XtAppMainLoop()\fP (the main event dispatch loop). +.\" --------------------------------------------------------------------------- +.K1 "Notes for Writing C/C++ Code Using Elk" +.Rf ch-notes \*(SN +.PP +This chapter describes general conventions and usage notes for +Elk-based C/C++ code and introduces a few useful facilities that +are not directly related to Scheme. +.\" --------------------------------------------------------------------------- +.K2 "Elk Include Files" +.PP +Every C or C++ file using functions, macros, or variables defined +by Elk must @[.=include files]include the file @[.\f2scheme.h\fP]: +.Es +#include \f1or:\fP #include "scheme.h" +.Ee +.PP +This include file resides in a subdirectory \f2include\fP of +the directory where Elk has been installed on your system. +You must insert a suitable \-I option into your Makefiles to add +this directory to the C compiler's search path. +``scheme.h'' includes several other Elk-specific include files +from the same directory and, in addition, the standard C include +files @[.\f2\fP] and @[.\f2\%\fP]. +.\" --------------------------------------------------------------------------- +.K2 "Standard C and Function Prototypes" +.PP +All the examples shown in this manual are written in @[.ANSI/ISO C]. +This assumes that the Elk include files have been installed with +@[.function prototypes] enabled. +Whether or not function prototypes are enabled is controlled by +a definition in the platform- and compiler-specific ``config/system'' +file that has been selected for configuring Elk. +However, if the include files have function prototypes disabled, +prototypes are enable automatically if you are compiling your +code with a @[.C compiler] that defines the symbol @[.``_\^_STDC_\^_]'' +as non-zero, or with a @[.C++ compiler] that defines @[.``_\^_cplusplus'']\**. +.FS +Although the public include files provided by Elk can be used +by C++ code, Elk itself cannot be compiled with a C++ compiler. +The interpreter has been written in C to maximize portability. +.FE +.PP +Elk include files that have been installed with function prototypes +disabled can also be ``upgraded'' by defining the symbol +@[.``WANT_PROTOTYPES''] before including ``scheme.h''. +Similarly, include files installed without function prototypes +can be used with a non-ANSI C compiler by defining the symbol +@[.``NO_PROTOTYPES''] before including ``scheme.h''. +.\" --------------------------------------------------------------------------- +.K2 "External Symbols Defined by Elk" +.PP +As extensions or applications are linked with Elk (regarless of whether +dynamic loading or static linking is used), they can in general +reference all external symbols exported by Elk. +Of these, only the symbols described in this manual may be used safely. +Use of other (private) symbols results in non-portable code, as +the symbols may change their meaning or may even be removed from future +releases of Elk. +The same restriction applies to the macros and types defined by +the include files of Elk. +.PP +In addition to the symbols defined by the Scheme interpreter kernel, +those exported by other @[.Scheme extensions] that are present in the same +executable (or have been loaded earlier) can be referenced from within +C/C++ code. +These extensions are not subject of this manual; you should refer +to the relevant documentation and the public include files that +are part of the extensions. +.PP +If Elk is linked with an application that has its own \f2main()\fP +function, none of the functions exported by Elk must be used before +the initial call to @[.\f2Elk_Init()\fP] (except \f2Set_App_Name()\fP). +.\" --------------------------------------------------------------------------- +.K2 "Calling Scheme Primitives" +.Rf ch-prims \*(SN +.PP +A large subset of the symbols exported by the Scheme interpreter is +the set of functions implementing the @[.Scheme primitives]. +These may be used safely by extensions and applications. +There exists one C function for each Scheme primitive. +Its name is that of the corresponding primitive with the following +conversions applied: +.Rs +.IP \(bu +dashes are replaced by underscores, and the initial letters of the +resulting word components are capitalized; +.IP \(bu +the prefix ``P_'' is prepended; +.IP \(bu +``\(mi>'' is replaced by ``_To_'' (as in \f2vector\(mi>list\fP); +.IP \(bu +a trailing exclamation mark is deleted, except for \f2append!\fP and +\f2reverse!\fP, where ``_Set'' is appended; +.IP \(bu +a trailing question mark is replaced by the letter `p' (except for +\f2eq?, eqv?, equal?\&\fP and the string and character comparison +primitives, where it is deleted); +.Re +.LP +The names of a few functions are derived differently as shown +by this table: +.RS +.TS +box, tab(~); +c c +c l. +Scheme Primitive~C Function +_ +<~P_Generic_Less() +>~P_Generic_Greater() +\&=~P_Generic_Equal() +<=~P_Generic_Eq_Less() +>=~P_Generic_Eq_Greater() +1+~P_Inc() +1\(mi and \(mi1+~P_Dec() ++~P_Generic_Plus() +\(mi~P_Generic_Minus() +*~P_Generic_Multiply() +/~P_Generic_Divide() +let*~P_Letseq() +.TE +.RE +.PP +According to these rules, the primitive \f2exact\(mi>inexact\fP can +be used from within C as \f2P_Exact_To_Inexact()\fP, +the predicate \f2integer?\&\fP is available as \f2P_Integerp()\fP, etc. +Authors of reusable Scheme extensions are encouraged to follow +these (or similar) naming conventions in their code. +.PP +All the functions implementing Scheme primitives (as well as +special forms, which are treated as primitives in Elk) receive +Scheme objects or arrays thereof as their arguments and return +Scheme objects as their values. +The underlying C type will be described in the next chapter. +For the semantics of the non-standard Scheme primitives defined +by Elk refer to the Reference Manual for the interpreter. +.\" --------------------------------------------------------------------------- +.K2 "Portable alloca()" +.Rf ch-alloca \*(SN +.PP +Elk provides a portable variant of @[.\f2alloca()\fP] as a set of macros +that can be used by extensions and applications. +\f2alloca()\fP, which is supported by most modern UNIX systems +and C compilers, allocates memory in the caller's stack frame; +the memory is automatically released when the function returns. +Elk simulates this functionality on the (rare) platforms where +\f2alloca()\fP is not available. +.PP +To allocate memory, the macro @[.\f2Alloca()\fP] is called with +a variable to which the newly allocated memory is assigned, +the type of that variable, and the number of bytes that are +requested. +The macro @[.\f2Alloca_End\fP] must be called (without an +argument list) before returning from a function or block that uses +@[.\f2Alloca()\fP]; this macro is empty on those platforms +that support the ordinary \f2alloca()\fP. +Finally, a call to the macro @[.\f2Alloca_Begin\fP] must be placed +in the function's declarations. +\f2Alloca()\fP usually is more efficient than \f2malloc()\fP and +\f2free()\fP, and the memory need not be freed when the function +is left prematurely because of an interrupt or by calling +a @[.continuation]. +.LP +As an example, here is the skeleton of a function that is called +with a filename prefix and a suffix, concatenates them (separated +by a period), and opens the resulting file: +.Es +int some_function(char *prefix, char *suffix) { + char *name; + int len, fd; + Alloca_Begin; +.El + len = strlen(prefix) + 1 + strlen(suffix) + 1; + Alloca(name, char*, len); + sprintf(name, "%s.%s", prefix, suffix); + fd = open(name, ...); + ... + Alloca_End; +} +.Ee +.\" --------------------------------------------------------------------------- +.K2 "Other Useful Macros and Functions" +.PP +The preprocessor symbols @[.ELK_MAJOR] and @[.ELK_MINOR] expand to +the major and minor version number of the current release of Elk. +They did not exist in versions older than Elk \*(Vs. +.PP +@[.\f2index()\fP], @[.\f2bcopy()\fP], @[.\f2bcmp()\fP], and +@[.\f2bzero()\fP] are defined as suitable macros on systems that do not +have them in their C library; they may be used by source files that +include ``scheme.h'', regardless of the actual platform. +.LP +Code linked with Elk may use the two functions +.Es +@[.=Safe_Malloc()]@[.=Safe_Realloc()] +char *Safe_Malloc(unsigned size); +char *Safe_Realloc(char *old_pointer, unsigned size); +.Ee +as alternatives to \f2malloc()\fP and \f2realloc()\fP. +If the request for memory cannot be satisfied, the standard Elk error +handler is called with a suitable error message. +.\" --------------------------------------------------------------------------- +.K1 "The Anatomy of Scheme Objects" +.Rf ch-anatomy \*(SN +.PP +All Scheme objects, regarless of their Scheme type, are represented +as instances of the type @[.\f2Object\fP] in C. +\f2Object\fP is implemented as a small C \f2struct\fP in newer Elk +releases and was an integral type earlier. +However, code using Elk should not assume a specific representation, +as it may change again in future revisions. +An \f2Object\fP consists of three components: +.Rs +.IP \(bu +the type of the corresponding Scheme object as a small integer +(the @[.``type field''] or @[.``tag field'']), +.IP \(bu +the contents of the object, either directly (for small objects) or +as a pointer into the Scheme @[.heap] (the @[.``pointer field'']), +.IP \(bu +a @[.``const bit''] which, if set, indicates that the object is read-only +and cannot be modified by destructive Scheme primitives. +.Re +.PP +Elk defines a few macros to retrieve and modify the fields +of an \f2Object\fP independent of its representation: +.Es +@[.=TYPE()]@[.=POINTER()]@[.=ISCONST()]@[.=SETCONST()]@[.=SET()] +TYPE(obj) ISCONST(obj) SET(obj,t,ptr) +POINTER(obj) SETCONST(obj) +.Ee +.PP +\f2TYPE()\fP returns the contents of the type field of an \f2Object\fP; +\f2POINTER()\fP returns the contents of the pointer field as an +\f2unsigned long\fP (different macros are provided for types which +have their values stored directly in the \f2Object\fP rather than +in the heap); +\f2ISCONST()\fP returns the value of the const bit; +and \f2SETCONST()\fP sets the const bit to 1 (it cannot be cleared +once it has been set). +\f2ISCONST()\fP and \f2SETCONST()\fP may only be applied to \f2Objects\fP +that have their value stored on the heap (such as vectors, strings, etc.); +all other types of Scheme objects are \f2ipso facto\fP read-only. +Another macro, \f2SET()\fP, can be used to set both the type and pointer +field of a new object. +.PP +Two objects can be compared by means of the macro +@[.=EQ()] +\f2EQ()\fP, which is also used as the basis for the Scheme +predicate @[.\f2eq?\fP]: +.Es +EQ(obj1,obj2) +.Ee +\f2EQ()\fP expands to a non-zero value if the type fields and the +pointer fields of the two objects are identical, else zero +(regardless of whether the pointer field really holds a pointer +or the object's actual value). +As \f2EQ()\fP may evaluate its arguments twice, it should not be +invoked with function calls or complex expressions. +.\" --------------------------------------------------------------------------- +.K2 "Type-specific Macros" +.PP +For each predefined Scheme type, there exists a preprocessor symbol +that expands to the integer value of that type (the contents of the +type field of members of the type). +The name of each such symbol is the name of the type with the +prefix ``T_'': +.Es +T_Boolean T_Pair T_Vector \f1etc...\fP +.Ee +These symbols are typically used as case labels in switch-statements to +discriminate the possible types of a given object, or in if-statements +to check whether a Scheme object is of a given type: +.Es +if (TYPE(obj) == T_Vector) + ... +.Ee +In addition, each type defines a macro to extract the contents of +an object of that type and to convert it to the correct C type. +For example, the macro +.Es +@[.=CHAR()] +CHAR(obj) +.Ee +is used to fetch the character value (a C \f2int\fP) from members of +the Scheme type \f2character\fP, that is, from objects whose type field +contains the value \f2T_Character\fP. +Similarly, the macro +.Es +@[.=VECTOR()] +VECTOR(obj) +.Ee +gets the heap pointer conveyed in objects of the Scheme +type @[.\f2vector\fP]. +For objects such as vectors, pairs, and procedures, the heap address is +coerced to a pointer to a C \f2struct\fP defining the layout of the +object. +There exists one structure type declaration for each such Scheme type; +their names are that of the type with ``S_'' prepended. +For example, \f2VECTOR()\fP returns a pointer to a structure with +the components \f2size\fP (the number of elements in the vector) +and \f2data\fP (the elements as an array of \f2Objects\fP). +These can be used from within C code like this: +.Es +int i, num = VECTOR(obj)->size; +.El +for (i = 0; i < num; i++) + VECTOR(obj)->data[i] = ...; +.Ee +Similarly, the structure underlying the Scheme type @[.\f2pair\fP] is +defined as: +.Es +struct S_Pair { Object car, cdr; }; +.Ee +and the macro \f2PAIR()\fP returns a (heap) pointer to a member of +the structure \f2S_Pair\fP. +Macros such as \f2VECTOR()\fP and \f2PAIR()\fP just convert the contents +of the pointer field to a pointer of the correct type: +.Es +#define VECTOR(obj) ((struct S_Vector *)POINTER(obj)) +#define PAIR(obj) ((struct S_Pair *)POINTER(obj)) +.Ee +.PP +Authors of Scheme extensions and Elk-based applications are +encouraged to follow these conventions in their code and, +for each new type \f2xyz\fP, store the new type value +(which is allocated by the interpreter when the type is registered) +in a variable \f2T_Xyz\fP, and define a structure or class +\f2S_Xyz\fP, and a macro \f2XYZ()\fP that makes a pointer +to this structure from a member of the type. +Capitalization may vary according to personal preference. +.\" --------------------------------------------------------------------------- +.K1 "Defining New Scheme Primitives" +@[.=Scheme primitives] +.Rf ch-defprim \*(SN +.PP +In Elk, there exists a one-to-one relationship between Scheme +primitives and C functions: +each Scheme primitive\*-whether predefined or user-defined\*-is +implemented by a corresponding C function. +This includes @[.special forms], which are treated as a special kind +of primitives in Elk. +Extensions and applications use the function @[.\f2Define_Primitive()\fP] +to register a new Scheme primitive with the interpreter, supplying +its name and the C function that implements it. +In case of dynamically loadable extensions or application modules, +the calls to \f2Define_Primitive()\fP are placed in the +@[.extension initialization function]s that are called automatically +as the object file is loaded. +\f2Define_Primitive()\fP is declared as +.Es +void Define_Primitive((Object (*func)()), const char *name, + int minargs, int maxargs, + enum discipline disc); +.Ee +The arguments are: +.Rs +.IP \f2func\fP +a pointer to the C function implementing the new primitive; +.IP \f2name\fP +the name of the primitive as a null-terminated C string; +.IP \f2minargs\fP +the minimum number of arguments accepted by the primitive; +.IP \f2maxargs\fP +the maximum number of arguments (identical to \f2minargs\fP in most cases); +.IP \f2disc\fP +the @[.\f2calling discipline\fP] (usually \f2EVAL\fP). +.Re +.PP +\f2Define_Primitive()\fP creates a Scheme variable of the specified +name in the current (i.\|e.\& the caller's) lexical environment +and binds it to the newly created procedure. +Each C function that implements a primitive has a return type +of \f2Object\fP and, for a calling discipline of \f2EVAL\fP, zero +or more arguments of type \f2Object\fP which are bound to +the evaluated arguments passed to the Scheme primitive when +it is called. +The calling discipline must be one of the following: +.Rs +.IP \f2EVAL\fP\0\0 +@[.=EVAL] +The primitive expects a fixed number of arguments; \f2minargs\fP +and \f2maxargs\fP must be identical\**. +.FS +Because of a limitation in the C language, primitives of type \f2EVAL\fP +can only have a fixed maximum number of arguments (currently 10). +If more arguments are required, \f2VARARGS\fP must be used instead. +.FE +.IP \f2VARARGS\fP +@[.=VARARGS] +The primitive has a variable number of arguments, and the +underlying C function is called with an argument count and +an array of arguments. +Defining primitives with a variable number of arguments will +explained in more detail in section @(ch-varargs). +.IP \f2NOEVAL\fP +@[.=NOEVAL] +The arguments are passed as a Scheme list of unevaluated objects\*-a +single argument of the type \f2Object\fP. +Primitives using this discipline will then use \f2Eval()\fP +as described in section @(ch-funcall) to evaluate some or all +of the arguments. +\f2NOEVAL\fP is only rarely used (with the exception of the built-in +@[.special forms] of Elk); extensions and applications mostly use macros as a +more convenient way to defined new syntactical forms. +.Re +.LP +Figure @(defprim) shows a simple example for defining a new +Scheme primitive. +.Fs +#include "scheme.h" +.El +Object p_vector_reverse(Object vec) { + Object tmp, *s, *t; +.El + Check_Type(vec, T_Vector); + for (s = VECTOR(vec)->data, t = s+VECTOR(vec)->size; --t > s; s++) + tmp = *s, *s = *t, *t = tmp; + return vec; +} +.El +void elk_init_vector(void) { + Define_Primitive(p_vector_reverse, "vector-reverse!", 1, 1, EVAL); +} +.Fc "Defining a new Scheme Primitive" +.Fe defprim +.PP +The primitive @[.\f2vector-reverse!\fP] defined by the example extension +reverses the elements of a Scheme @[.vector] in place and returns +its argument (note the final exclamation mark indicating the +destructive operation). +@[.\f2Check_Type()\fP] is a simple macro that compares the type field +of the first argument (an \f2Object\fP) with the second argument +and signals and error if they do not match. +This macro is used primarily for type-checking the arguments to +Scheme primitives. +A call to the macro @[.\f2Check_Mutable()\fP] with the vector +as an argument +could have been inserted before the loop to check whether the vector +is read-only and to automatically raise an error if this is the case. +The example code forms a complete extension including an +@[.extension initialization function] and could be linked with +the interpreter, or loaded dynamically into the interpreter as +follows: +.Es +\f6%\fP cc \-c \-I/usr/elk/include vec.c; makedl vec.o vec.o +\f6%\fP scheme +\f6>\fP (load 'vec.o) +\f6>\fP (define v '#(hello word)) +\f6v +>\fP (vector-reverse! v) +\f6#(world hello) +>\fP v +\f6#(world hello) +>\fP +.Ee +.\" --------------------------------------------------------------------------- +.K2 "Making Objects Known to the Garbage Collector" +.Rf ch-gc \*(SN +@[.=garbage collector] +.PP +Consider the non-destructive version of the primitive +@[.\f2vector-reverse\fP] shown in Figure @(vecrev1), which returns a new +vector instead of altering the contents of the original vector. +.Fs +Object p_vector_reverse(Object vec) { + Object ret; + int i, j; +.El + Check_Type(vec, T_Vector); + ret = Make_Vector(VECTOR(vec)->size, False); + for (i = 0, j = VECTOR(vec)->size; --j >= 0; i++) + VECTOR(ret)->data[i] = VECTOR(vec)->data[j]; + return ret; +} +.Fc "Non-destructive Scheme primitive \f2vector-reverse\fP" +.Fe vecrev1 +.PP +The code in Figure @(vecrev1) is identical to that shown in Figure +@(defprim), except that a new vector is allocated, filled with +the contents of the original vector in reverse order, and returned +as the result of the primitive. +@[.\f2Make_Vector()\fP] is declared by Elk: +.Es +Object Make_Vector(int size, Object fill); +.Ee +\f2size\fP is the length of the vector, and all elements are initialized +to the Scheme object \f2fill\fP. +In the example, the predefined global variable @[.\f2False\fP] is +used as the \f2fill\fP object; it holds the boolean Scheme constant #f +(any \f2Object\fP could have been used here). +.PP +Although the C function may look right, there is a problem when +it comes to garbage collection. +To understand the problem and its solution, it may be helpful to have a +brief look at how the garbage collector\** +.FS +Elk actually employs two garbage collectors, one based on the +traditional stop-and-copy strategy, and a generational, incremental +garbage collector which is less disruptive but not supported +on all platforms. +.FE +works (the following description presents a simplified view; the real +algorithm is more complex). +In Elk, a @[.garbage collection] is triggered automatically whenever +a request for heap space cannot be satisfied because +the @[.heap] is full, or explicitly by calling the primitive +@[.\f2collect\fP] from within Scheme code. +The garbage collector traces all ``live'' objects starting with +a known @[.\f2root set\fP] of pointers to reachable objects +(basically the interpreter's global lexical environment and its +symbol table). +Following these pointers, all accessible Scheme objects are located +and copied to a new heap space in memory (``forwarded''), thereby +compacting the heap. +Whenever an object is relocated in memory during garbage collection, +the contents of the @[.pointer field] of the corresponding C \f2Object\fP +is updated to point to the new location. +After that, any constituent objects (e.\|g.\& the elements of a +vector) are forwarded in the same way. +.PP +As live objects are relocated in memory, \f2all\fP pointers to an +object need to be updated properly when that object is forwarded +during garbage collection. +If a pointer to a live object were not in the root set (that is, +not reachable by the garbage collector), the object would either +become garbage erroneously during the next garbage collection, or, +if it had been reached through some other pointer, the original +pointer would now point to an invalid location.\** +.FS +The problem of managing an ``exact root set'' can be avoided by +a technique called \f2conservative\fP garbage collection. +A conservative garbage collector treats the data segment, stack, +and registers of the running program as \f2ambiguous roots\fP. +If the set of ambiguous roots is a superset of the \f2actual\fP roots, +then a pointer that looks like a heap pointer can safely be considered +as pointing to an accessible object that cannot be reclaimed. +At the time Elk was designed, conservative GC was still in its +infancy and sufficient experience did not exist. +For this reason, and because of the implied risks on certain +machine architectures, the inherent portability problems, and +the inability to precisely determine the actual memory utilization, +a traditional GC strategy was chosen for Elk. +.FE +This is exactly what happens in the example shown in Figure @(vecrev1). +.PP +The call to \f2Make_Vector()\fP in the example triggers a garbage +collection if the heap is too full to satisfy the request for heap +space. +As the \f2Object\fP pointer stored in the argument \f2vec\fP +is invisible to the garbage collector, its pointer field cannot +be updated when the vector to which it points is forwarded during +the garbage collection started inside \f2Make_Vector()\fP. +As a result, all further references to \f2VECTOR(vec)\fP will +return an invalid address and may cause the program to crash +(immediately or, worse, at a later point). +The solution is simple: the primitive just needs to add \f2vec\fP +to the set of initial pointers used by the garbage collector. +This is done by inserting the line +.Es +GC_Link(vec); +.Ee +at the beginning of the function before the call to \f2Make_Vector()\fP. +@[.\f2GC_Link()\fP] is a macro. +Another macro, @[.\f2GC_Unlink\fP], must be called later (e.\|g.\& at +the end of the function) without an argument list to remove the object +from the root set again. +In addition, a call to @[.\f2GC_Node\fP] (again without an argument +list) must be placed in the declarations at the beginning of +the enclosing function or block. +Figure @(vecrev2) shows the revised, correct code. +.Fs +Object p_vector_reverse(Object vec) { + Object ret; + int i, j; + GC_Node; +.El + GC_Link(vec); + Check_Type(vec, T_Vector); + ret = Make_Vector(VECTOR(vec)->size, False); + for (i = 0, j = VECTOR(vec)->size; --j >= 0; i++) + VECTOR(ret)->data[i] = VECTOR(vec)->data[j]; + GC_Unlink; + return ret; +} +.Fc "Non-destructive Scheme primitive \f2vector-reverse\fP, corrected version" +.Fe vecrev2 +.PP +Appendix A lists the C functions which can trigger a garbage collection. +Any @[.local variable] or argument of type \f2Object\fP must be protected +in the manner shown above if one of these functions is called during +its lifetime. +This may sound more burdensome than it really is, because most of +the ``dangerous'' functions are rarely or never used from within +C/C++ extensions or applications in practice. +Most primitives that require calls to \f2GC_Link()\fP use some function +that creates a new Scheme object, such as \f2Make_Vector()\fP in +the example above. +.PP +To simplify GC protection of more than a single argument or variable, +additional macros @[.\f2GC_Link2()\fP], @[.\f2GC_Link3()\fP], and +so on up to \f2GC_Link7()\fP are provided. +Each of these can be called with as many arguments of type \f2Object\fP +as is indicated by the digit (separate macros are required, because +macros with a variable number of arguments cannot be defined in C). +A corresponding macro @[.\f2GC_Node2\fP], @[.\f2GC_Node3\fP], and so on, +must be placed in the declarations. +Different \f2GC_Link*()\fP calls cannot be mixed. +All @[.local variable]s passed to one of the macros must have been +initialized. +GC protection is not required for ``pointer-less'' objects such as +booleans and small integers, and for the arguments of primitives +with a variable number of arguments (as described in section @(ch-varargs)). +Section @(ch-gcglobal) will describe how global (external) +\f2Object\fP variables can be added to the root set. +.PP +Here is how the implementation of the primitive @[.\f2cons\fP] uses +\f2GC_Link2()\fP to protect its arguments (the @[.car] and the @[.cdr] of +the new pair): +.Es +Object P_Cons(Object car, Object cdr) { + Object new_pair; + GC_Node2; +.El + GC_Link2(car, cdr); + new_pair = \f2allocate heap space and initialize object\fP; + GC_Unlink; + return new_pair; +} +.Ee +.PP +There are a few pitfalls to be aware of when using ``dangerous'' +functions from within your C/C++ code. +For example, consider this code fragment which fills a Scheme +vector with the program's environment strings that are available +through the null-terminated string array \f2environ[]\fP: +.Es +Object vec = \f2new vector of the right size\fP; +int i; +GC_Node; +.El +GC_Link(vec); +for (i = 0; environ[i] != 0; i++) + VECTOR(vec)->data[i] = Make_String(environ[i], strlen(environ[i])); +.Ee +(\f2Make_String()\fP creates and initializes a new Scheme string.) +The body of the for-loop contains a subtle bug: depending on the +compiler used, the left hand side of the assignment (the expression +involving \f2vec\fP) may be evaluated before @[.\f2Make_String()\fP] +is invoked. +As a result, a copy of the contents of \f2vec\fP might be, for instance, +stored in a register before a garbage collection is triggered while +evaluating the right hand side of the assignment. +The garbage collector would then move the vector object in memory, +updating the\*-properly GC-protected\*-variable \f2vec\fP, but not the +temporary copy in the register, which is now a dangling reference. +To avoid this, the loop must be modified along these lines: +.Es +for (i = 0; environ[i]; i++) { + Object temp = Make_String(environ[i], strlen(environ[i])); + VECTOR(vec)->data[i] = temp; +} +.Ee +A related pitfall to watch out for is exemplified by this code +fragment: +.Es +Object obj; +\&... +GC_Link(obj); +\&... +some_function(obj, P_Cons(car, cdr)); +.Ee +Here, the call to @[.\f2P_Cons()\fP]\*-just like \f2Make_String()\fP +above\*-can trigger a garbage collection. +Depending on the C compiler, the properly GC-protected object +pointer \f2obj\fP may be pushed on the argument stack before \f2P_Cons()\fP +is invoked, as the order in which function arguments\*-just like the +operands of the assignment operator\*-are evaluated is undefined in the +C language. +In this case, if a garbage collection takes place and the heap object +to which \f2obj\fP points is moved, \f2obj\fP will be updated +properly, but the copy on the stack will not. +Again, the problem can be avoided easily by assigning the result of the +nested function call to a temporary \f2Object\fP variable and +use this variable in the enclosing function call: +.Es +temp = P_Cons(car, cdr); +some_function(obj, temp); +.Ee +.\" --------------------------------------------------------------------------- +.K2 "Primitives with Variable-Length Argument Lists" +.Rf ch-varargs \*(SN +.PP +Primitives with a variable number of arguments are registered with +the interpreter by calling @[.\f2Define_Primitive()\fP] with +the @[.calling discipline] @[.\f2VARARGS\fP] and with different +values for \f2minargs\fP and \f2maxargs\fP. +The special symbol @[.\f2MANY\fP] can be given as the maximum number +of arguments to indicate that there is no upper limit on the +primitive's number of actual arguments. +The C/C++ function implementing a primitive with a variable number +of arguments is called with two arguments: an integer count +that specifies the number of actual arguments, and the +Scheme arguments as an array of \f2Objects\fP (that is, a pointer +to \f2Object\fP). +The objects passed as the argument vector of \f2VARARGS\fP primitives +are already registered with the garbage collector; calls to +\f2GC_Link()\fP are not required. +As an example for a primitive with an arbitrary number of arguments, +here is the definition of a simplified variant of @[.\f2append!\fP] +(which does not handle empty lists): +.Es +Object p_append_set (int argc, Object *argv); { + int i; +.El + for (i = 0; i < argc-1; i++) + (void)P_Set_Cdr (P_Last_Pair (argv[i]), argv[i+1]); + return *argv; +} +.Ee +The corresponding call to \f2Define_Primitive()\fP would read: +.Es +Define_Primitive(p_append_set, "append!", 0, MANY, VARARGS); +.Ee +.PP +Besides implementing primitives with an indefinite maximum number +of arguments, the \f2VARARGS\fP discipline is frequently used for +primitives with an optional argument. +For example, a primitive encapsulating the UNIX \f2open()\fP system +call, which has two fixed arguments (filename, flags) and an optional +third argument (the mode for newly created files, i.\|e.\& calls with +the flag \f2O_CREAT\fP), could be defined as follows: +.Es +Object p_unix_open(int argc, Object *argv) { + char *name = get_file_name(argv[0]); + int flags = get_flags(argv[1]); + mode_t mode; +.El + if (flags & O_CREAT) { + if (argc < 3) + \f2error--too few arguments\fP + mode = get_mode(argv[2]); + ... +.Ee +The call to \f2Define_Primitive()\fP could then be written as: +.Es +Define_Primitive(p_unix_open, "unix-open", 2, 3, VARARGS); +.Ee +.\" --------------------------------------------------------------------------- +.K1 "Predefined Scheme Types" +.Rf ch-types \*(SN +.PP +This chapter introduces the Scheme types predefined by Elk. +It begins with the ``pointer-less'' types such as boolean, whose +values are stored directly in the pointer field of an \f2Object\fP; +followed by the types whose members are C \f2structs\fP that +reside on the Scheme heap. +.\" --------------------------------------------------------------------------- +.K2 "Booleans (T_Boolean)" +@[.=T_Boolean] +.PP +\f2Objects\fP of type \f2T_Boolean\fP can hold the values #t and #f. +Two \f2Objects\fP initialized to #t and #f, respectively, are +available as the external C variables \f2True\fP and \f2False\fP. +The macro +.Es +@[.=Truep()] +Truep(obj) +.Ee +can be used to check whether an arbitrary Scheme object is regarded +as true. +Use of \f2Truep()\fP is not necessarily equivalent to +.Es +!EQ(obj,False) +.Ee +because the empty list may count as false in addition to #f if +backwards compatibility to older Scheme language versions has +been enabled. +\f2Truep()\fP may evaluate its argument twice and should therefore +not be invoked with a function call or a complex expression. +.LP +The two functions +.Es +@[.=Eqv()]@[.=Equal()] +int Eqv(Object, Object); +int Equal(Object, Object); +.Ee +are identical to the primitives \f2P_Eqv()\fP and \f2P_Equal()\fP, +except that they return a C integer rather than a Scheme boolean and +therefore can be used more conveniently in C/C++. +.\" --------------------------------------------------------------------------- +.K2 "Characters (T_Character)" +@[.=T_Character] +.PP +The character value stored in an \f2Object\fP of type \f2T_Character\fP +can be obtained by the macro +.Es +@[.=CHAR()] +CHAR(char_obj) +.Ee +as a non-negative \f2int\fP. +A new character object is created by calling the function +.Es +@[.=Make_Char()] +Object Make_Char(int c); +.Ee +The predefined external C variable @[.\f2Newline\fP] holds the +newline character as a Scheme \f2Object\fP. +.\" --------------------------------------------------------------------------- +.K2 "Empty List (T_Null)" +@[.=T_Null] +.PP +The type \f2T_Null\fP has exactly one member\*-the empty list; +hence all \f2Objects\fP of this type are identical. +The empty list is available as the external C variable @[.\f2Null\fP]. +This variable is often used to initialize \f2Objects\fP that will +be assigned their real values later, for example, as the fill +element for newly created vectors or to initialize \f2Objects\fP +in order to \f2GC_Link()\fP them. +A macro \f2Nullp()\fP is provided as a shorthand for checking if an +\f2Object\fP is the empty list: +.Es +@[.=Nullp()] +#define Nullp(obj) (TYPE(obj) == T_Null) +.Ee +This macro is used frequently in the termination condition of +for-loops that scan a Scheme list: +.Es +Object tail; +\&... +for (tail = some_list; !Nullp(tail); tail = Cdr(tail)) + process_element(Car(tail)); +.Ee +(\f2Car()\fP and \f2Cdr()\fP essentially are shorthands for +\f2P_Car()\fP and \f2P_Cdr()\fP and will be revisited in +the section on pairs). +.\" --------------------------------------------------------------------------- +.K2 "End of File (T_End_Of_File)" +@[.=T_End_Of_File] +.PP +The type \f2T_End_Of_File\fP has one member\*-the +@[.end-of-file object]\*-and is only rarely used from within +user-supplied C/C++ code. +The external C variable @[.\f2Eof\fP] is initialized to the +end-of-file object. +.\" --------------------------------------------------------------------------- +.K2 "Integers (T_Fixnum and T_Bignum)" +@[.=T_Fixnum]@[.=T_Bignum] +.PP +Integers come in two flavors: @[.\f2fixnums\fP] and @[.\f2bignums\fP]. +The former have their value stored directly in the pointer field and +are wide enough to hold most C \f2ints\fP. +Bignums can hold integers of arbitrary size and are stored in the heap. +Two macros are provided to test whether a given signed (or unsigned, +respectively) integer fits into a fixnum: +.Es +@[.=FIXNUM_FITS()]@[.=UFIXNUM_FITS()] +FIXNUM_FITS(integer) +UFIXNUM_FITS(unsigned_integer) +.Ee +The former always returns 1 in Elk \*(Vs, but the range of integer +values that can be represented as a fixnum may be restricted in +future revisions. +It is guaranteed, however, that at least two bits less than the +machine's word size will be available for fixnums in future +versions of Elk. +.LP +The value stored in a fixnum can be obtained as a C \f2int\fP by +calling the macro +.Es +@[.=FIXNUM()] +FIXNUM(fixnum_obj) +.Ee +A macro +.Es +@[.=Check_Integer()] +Check_Integer(obj) +.Ee +can be used as a shorthand for checking whether an \f2Object\fP is +a fixnum or a bignum and raising an error otherwise. +.LP +The following functions are provided to convert C integers to +Scheme integers: +.Es +@[.=Make_Integer()]@[.=Make_Unsigned()] +@[.=Make_Long()]@[.=Make_Unsigned_Long()] +Object Make_Integer(int); +Object Make_Unsigned(unsigned); +Object Make_Long(long); +Object Make_Unsigned_Long(unsigned long); +.Ee +\f2Make_Integer()\fP returns a fixnum object if \f2FIXNUM_FITS()\fP +returns true for the argument, otherwise a bignum. +Likewise, \f2Make_Long()\fP usually returns a fixnum but may have to resort +to bignums on architectures where a C \f2long\fP is wider than an \f2int\fP. +\f2Make_Unsigned()\fP returns a bignum if the specified integer +is larger than the largest positive \f2int\fP that fits into a fixnum +(\f2UFIXNUM_FITS()\fP returns zero in this case). +Another set of functions convert a Scheme number to a C integer: +.Es +@[.=Get_Integer()]@[.=Get_Exact_Integer()] +int Get_Integer(Object); +int Get_Exact_Integer(Object); +.El +@[.=Get_Unsigned()]@[.=Get_Exact_Unsigned()] +unsigned Get_Unsigned(Object); +unsigned Get_Exact_Unsigned(Object); +.El +@[.=Get_Long()]@[.=Get_Exact_Long()] +long Get_Long(Object); +long Get_Exact_Long(Object); +.El +@[.=Get_Unsigned_Long()]@[.=Get_Exact_Unsigned_Long()] +unsigned long Get_Unsigned_Long(Object); +unsigned long Get_Exact_Unsigned_Long(Object); +.Ee +These functions signal an error if one of the following +conditions is true: +.Rs +.IP \(bu +the argument is neither a fixnum, nor a bignum, nor a flonum (real +number) with a fractional part of zero (more about @[.flonums] in the +next section); +.IP \(bu +the function is one of the ``unsigned'' variants and the argument is +a negative number; +.IP \(bu +the argument is a bignum too large for the respective return type; +.IP \(bu +the function is one of the ``exact'' variants and the argument +is neither a fixnum nor a bignum; +.IP \(bu +the argument is a flonum that cannot be coerced to the respective +return type. +.Re +.LP +As all of the above functions include suitable type-checks, primitives +receiving integer arguments can be written in a simple and +straightforward way. +For example, a primitive encapsulating the UNIX \f2dup\fP system +call (which returns an integer file descriptor pointing to the +same file as the original one) can be written as: +.Es +Object p_unix_dup(Object fd) { + return Make_Integer(dup(Get_Exact_Unsigned(fd))); +.Ee +Note that if \f2Get_Unsigned()\fP (or \f2Get_Integer()\fP) had been +used here in place of the ``exact'' conversion function, it would be +possible to write expressions such as: +.Es +(define fd (unix-dup (truncate 1.2))) +.Ee +.\" --------------------------------------------------------------------------- +.K2 "Floating Point Numbers (T_Flonum)" +@[.=T_Flonum] +.PP +@[.=real numbers] +Real and @[.inexact number]s are represented as \f2Objects\fP of type +\f2T_Flonum\fP. +Each such object holds a pointer to a structure on the heap with +a component \f2val\fP of type \f2double\fP, so that the expression +.Es +@[.=FLONUM()] +FLONUM(flonum_obj)->val +.Ee +can be used to obtain the \f2double\fP value. +To convert a Scheme number to a \f2double\fP regardless of its +type, the more general function +.Es +@[.=Get_Double()] +double Get_Double(Object); +.Ee +can be used. +It raises an error if the argument is not a fixnum, bignum, or flonum, +or if it is a bignum too large to fit into a \f2double\fP. +.LP +The functions +.Es +@[.=Make_Flonum()]@[.=Make_Reduced_Flonum()] +Object Make_Flonum(double); +Object Make_Reduced_Flonum(double); +.Ee +convert a C \f2double\fP to a flonum; the latter returns a fixnum +if the \f2double\fP is small enough to fit into a fixnum and +has a fractional part of zero. +The macro +.Es +@[.=Check_Number()] +Check_Number(obj) +.Ee +checks whether the given \f2Object\fP is a number (that is, a fixnum, +bignum, or flonum in the current revision of Elk) and raises an +error otherwise. +.\" --------------------------------------------------------------------------- +.K2 "Pairs (T_Pair)" +@[.=T_Pair] +.PP +Pairs have two components of type \f2Object\fP, the @[.car] and the @[.cdr], +that can be accessed as: +.Es +@[.=PAIR()] +PAIR(pair_obj)->car +PAIR(pair_obj)->cdr +.Ee +Two macros @[.\f2Car()\fP] and @[.\f2Cdr()\fP] are provided as shorthands +for these expressions, and another macro @[.\f2Cons()\fP] can be +used in place of @[.\f2P_Cons()\fP] to create a new pair. +The macro +.Es +@[.=Check_List()] +Check_List(obj) +.Ee +checks whether the specified \f2Object\fP is either a pair or +the empty list and signals an error otherwise. +The predefined function +.Es +@[.=Fast_Length()] +int Fast_Length(Object list); +.Ee +can be used to compute the length of the given Scheme list. +This function is more efficient than the primitive \f2P_Length()\fP, +because it neither checks the type of the argument nor whether +the given list is proper, and the result need not be converted +to a Scheme number. +The function +.Es +@[.=Copy_List()] +Object Copy_List(Object list); +.Ee +returns a copy of the specified list (including all its sublists). +.PP +As explained in section @(ch-gc), care must be taken when mixing +calls to these macros, because \f2Cons()\fP may trigger a garbage +collection: +an expression such as +.Es +Car(x) = Cons(y, z); +.Ee +is wrong, even if \f2x\fP is properly ``GC_Linked'', and should be +replaced by +.Es +tmp = Cons(x, y); +Car(x) = tmp; +.Ee +or a similar sequence. +.\" --------------------------------------------------------------------------- +.K2 "Symbols (T_Symbol)" +@[.=T_Symbol] +.PP +\f2Objects\fP of type \f2T_Symbol\fP have one public component\*-the +symbol's name as a Scheme string (that is, an \f2Object\fP of type +\f2T_String\fP): +.Es +@[.=SYMBOL] +SYMBOL(symbol_obj)->name +.Ee +A new symbol can be created by calling one of the functions +.Es +@[.=Intern()]@[.=CI_Intern()] +Object Intern(const char *); +Object CI_Intern(const char *); +.Ee +with the new symbol's name as the argument. +\f2CI_Intern()\fP is the case-insensitive variant of \f2Intern()\fP; +it maps all upper case characters to lower case. +\f2EQ()\fP yields true for all \f2Objects\fP returned by calls +to \f2Intern()\fP with strings with the same contents (or calls +to \f2CI_Intern()\fP with strings that are identical after +case conversion). +This is the main property that distinguishes symbols from strings +in Scheme. +.PP +A symbol that is used by more than one function can be stored in +a global variable to save calls to \f2Intern()\fP. +This can be done using the convenience function +.Es +@[.=Define_Symbol()] +void Define_Symbol(Object *var, const char *name); +.Ee +\f2Define_Symbol()\fP is called with the address of a variable +where the newly-interned symbol is stored and the name of +the symbol to be handed to \f2Intern()\fP. +The function adds the new symbol to the garbage collector's +@[.root set] to make it reachable (as described in section @(ch-gcglobal). +Example: +.Es +static Object sym_else; +\&... +void elk_init_example(void) { + Define_Symbol(&sym_else, "else"); + ... +} +.Ee +.\" --------------------------------------------------------------------------- +.K3 "The Non-Printing Symbol" +.PP +By convention, Scheme primitives that do not have a useful return value +(for example the output primitives) return the @[.``non-printing symbol''] +in Elk. +The name of this symbol consists of the empty string; +it does not produce any output when it is printed, for example, +by the toplevel read-eval-print loop. +In Scheme code, the non-printing symbol can be generated by using +the reader syntax ``#v'' or by calling \f2string\(mi>symbol\fP with +the empty string. +On the C language level, the non-printing symbol is available as +the external variable @[.\f2Void\fP], so that primitives lacking +a useful return value can use +.Es +return Void; +.Ee +.\" --------------------------------------------------------------------------- +.K2 "Strings (T_String)" +@[.=T_String] +.PP +\f2Objects\fP of type string have two components\*-the length and the +contents of the string as a pointer to \f2char\fP: +.Es +STRING(string_obj)->size +STRING(string_obj)->data +.Ee +The \f2data\fP component is not null-terminated, as a string +itself may contain a null-byte as a valid character in Elk. +A Scheme string is created by calling the function +.Es +@[.=Make_String()] +Object Make_String(const char *init, int size); +.Ee +\f2size\fP is the length of the newly-created string. +\f2init\fP is either the null-pointer or a pointer to \f2size\fP +characters that are copied into the new Scheme string. +For example, the sequence +.Es +Object str; +\&... +str = Make_String(0, 100); +bzero(STRING(str)->data, 100); +.Ee +generates a string holding 100 null-bytes. +.PP +Most primitives that receive a Scheme string as one of their arguments +pass the string's contents to a C function (for example a C library function) +that expects an ordinary, null-terminated C string. +For this purpose Elk provides a function +.Es +@[.=Get_String()] +char *Get_String(Object); +.Ee +that returns the contents of the Scheme string argument as a +null-terminated C string. +An error is raised if the argument is not a string. +\f2Get_String()\fP has to create a copy of the contents of the Scheme +string in order to append the null-character. +To avoid requiring the caller to provide and release space for the +copy, \f2Get_String()\fP operates on and returns @[.NUMSTRBUFS] +internal, cyclically reused buffers (the value of NUMSTRBUFS is 3 +in Elk \*(Vs). +Consequently, no more than NUMSTRBUFS results of \f2Get_String()\fP +can be used simultaneously (which is rarely a problem in practice). +As an example, a Scheme primitive that calls the C library +function \f2getenv()\fP and returns #f on error can be written as +.Es +Object p_getenv(Object name) { + char *ret = getenv(Get_String(name)); + return ret ? Make_String(ret, strlen(ret)) : False; +} +.Ee +.PP +If more strings are to be used simultaneously, the macro +@[.\f2Get_String_Stack()\fP] can be used instead. +It is called with the Scheme object and the name of a +variable of type ``char*'' to which the C string will be assigned. +\f2Get_String_Stack()\fP allocates space by means of @[.\f2Alloca()\fP] +(as explained in section @(ch-alloca)); hence a call to +@[.\f2Alloca_Begin\fP] must be placed in the declarations of the +enclosing function or block, and @[.\f2Alloca_End\fP] must be +called before returning from it. +.PP +An additional function @[.\f2Get_Strsym()\fP] and an additional +macro @[.\f2Get_Strsym_Stack()\fP] are provided by Elk; these +are identical to \f2Get_String()\fP and \f2Get_String_Stack()\fP, +respectively, except that the Scheme object may also be a symbol. +In this case, the symbol's name is taken as the string to +be converted. +.PP +As an example for the use of \f2Get_String_Stack()\fP, here is +a simple Scheme primitive \f2exec\fP that is called with the +name of a program and one more more arguments and passes them +to the \f2execv()\fP system call: +.Es +Object p_exec(int argc, Object *argv) { + char **argp; int i; + Alloca_Begin; +.El + Alloca(argp, char**, argc*sizeof(char *)); + for (i = 1; i < argc; i++) + Get_String_Stack(argv[i], argp[i-1]); + argp[i-1] = 0; + execv(Get_String(*argv), argp); /* must not return */ + \f2error...\fP +} +.El +elk_init_example() { + Define_Primitive(p_exec, "exec", 2, MANY, VARARGS); +} +.Ee +The primitive can be used as follows: +.Es +(exec "/bin/ls" "ls" "-l") +.Ee +\f2Get_String()\fP could not be used in this primitive, because +the number of string arguments may exceed the number of static +buffers maintained by \f2Get_String()\fP. +.\" --------------------------------------------------------------------------- +.K2 "Vectors (T_Vector)" +@[.=T_Vector] +.PP +The layout of \f2Objects\fP of type vector is identical to that +of strings, except that the \f2data\fP component is an array +of \f2Objects\fP. +A function @[.\f2Make_Vector()\fP] creates a new vector as has been +explained in section @(ch-gc) above. +.\" --------------------------------------------------------------------------- +.K2 "Ports (T_Port)" +@[.=T_Port] +.PP +The components of \f2Objects\fP of type \f2T_Port\fP are not +normally accessed directly from within C/C++ code, except for +.Es +PORT(port_obj)->closefun +.Ee +which is a pointer to a function receiving an argument of +type ``FILE*'' (for example, a pointer to \f2fclose()\fP), +provided that the port is a file port. +It is called automatically whenever the port is closed, +either because \f2close-input-port\fP or \f2close-output-port\fP +is applied to it or because the garbage collector has determined +that the port is no longer reachable. +.LP +A new file port is created by calling +.Es +@[.=Make_Port()] +Object Make_Port(int flags, FILE *f, Object name); +.Ee +with a first argument of either zero (output port), +\f2P_INPUT\fP (input port) or \f2P_BIDIR\fP (bidirectional port), +the file pointer, and the name of the file as a Scheme string. +The macros +.Es +@[.=Check_Input_Port()]@[.=Check_Output_Port()] +Check_Input_Port(obj) +Check_Output_Port(obj) +.Ee +check whether the specified port is open and is capable of +input (or output, respectively); an error is raised otherwise. +.PP +To arrange for a newly-created port to be closed automatically when it +becomes garbage, it must be passed to the function +\f2Register_Object()\fP as follows: +.Es +@[.=Register_Object()]@[.=Terminate_File()] +Register_Object(the_port, 0, Terminate_File, 0); +.Ee +\f2Register_Object()\fP will be described in section @(ch-term). +The current input and output port as well as ports pointing to the +program's initial standard input and output are available as four +external variables of type \f2Object\fP: +.Es +@[.=Curr_Input_Port]@[.=Curr_Output_Port] +@[.=Standard_Input_Port]@[.=Standard_Output_Port] +Curr_Input_Port Standard_Input_Port +Curr_Output_Port Standard_Output_Port +.Ee +The function +.Es +@[.=Reset_IO()] +void Reset_IO(int destructive_flag); +.Ee +clears any input queued at the current input port, then flushes +the current output port (if \f2destructive_flag\fP is zero) +or discards characters queued at the output port (if +\f2destructive_flag\fP is non-zero), and finally resets the +current input and current output port to their initial values +(the program's standard input and standard output). +This function is typically used in error situations to reset +the current ports to a defined state. +.PP +In addition to the standard Scheme primitives for output, extensions +and applications can use a function +.Es +@[.=Printf()] +void Printf(Object port, char *fmt, ...); +.Ee +to send output to a Scheme port using C \f2printf\fP. +The first argument to \f2Printf()\fP is the Scheme port to which +the output will be sent (it must be an output port); the remaining +arguments are that of the C library function \f2printf()\fP. +.LP +To output a Scheme object, the following function can be used +in addition to the usual primitives: +.Es +@[.=Print_Object()] +void Print_Object(Object obj, Object port, int raw_flag, + int print_depth, int print_length); +.Ee +The arguments to \f2Print_Object()\fP are identical to the arguments +of the ``print function'' that must be supplied for each user-defined +Scheme type (as described in section @(ch-deftype): +the \f2Object\fP to be printed, the output port, a flag indicating +that the object should be printed in human-readable form (\f2display\fP +sets the flag, \f2write\fP does not), and the ``print depth'' and +``print length'' for that operation. +For debugging purposes, the macro +.Es +@[.=Print()] +Print(obj); +.Ee +may be used to output an \f2Object\fP to the current output port. +.LP +A function +.Es +@[.=Load_Source_Port()] +void Load_Source_Port(Object port); +.Ee +can be used to load Scheme expressions from a file that has already +been opened as a Scheme port. +.\" --------------------------------------------------------------------------- +.K2 "Miscellaneous Types" +.PP +Other built-in Scheme types are lexical environments, primitive procedures, +compound procedures, macros, continuations (also called ``control points'' +at a few places in Elk), and promises. +These types are not normally created or manipulated from within C or +C++ code. +If you are writing a specialized extension that depends on the +C representation of these types, refer to the declarations in the +public include file ``object.h'' (which is included automatically via +``scheme.h''). +.PP +Lexical environments are identical to pairs except that the type +is @[.\f2T_Environment\fP] rather than \f2T_Pair\fP. +The current environment and the initial (gobal) environment +are available as the external C variables +@[.\f2The_Environment\fP] and @[.\f2Global_Environment\fP]. +The predefined type constants for primitives, compound procedures (the +results of evaluating lambda expressions), and macros are +@[.\f2T_Primitive\fP], @[.\f2T_Compound\fP], and @[.\f2T_Macro\fP], +respectively. +The function +.Es +@[.=Check_Procedure()] +void Check_Procedure(Object); +.Ee +checks whether the specified object is either a compound procedure +or a primitive procedure with a calling discipline different from +\f2NOEVAL\fP and raises an error otherwise. +The type constant for continuations is @[.\f2T_Control\fP]. +``Promise'' is the type of object returned by the special form +\f2delay\fP; the corresponding type constant is named @[.\f2T_Promise\fP]. +.\" --------------------------------------------------------------------------- +.K1 "Defining New Scheme Types" +.Rf ch-deftype \*(SN +.PP +A new, disjoint Scheme type is registered with Elk by calling the +function @[.\f2Define_Type()\fP], similar to \f2Define_Primitive()\fP +for new primitives. +Making a new type known to Elk involves passing it information about +the underlying C/C++ representation of the type and a number of C or +C++ functions that are ``called back'' by the interpreter in +various situations to pass control to the code that implements +the type. +The prototype of \f2Define_Type()\fP is: +.Es +int Define_Type(int zero, const char *name, + int (*size)(Object), int const_size, + int (*eqv)(Object, Object), + int (*equal)(Object, Object), + int (*print)(Object, Object, int, int, int), + int (*visit)(Object*, int (*)(Object*))); +.Ee +The arguments to \f2Define_Primitive()\fP are in detail: +.Rs +.IP \f2zero\fP 1 +The first argument must be zero (in early versions of Elk it could be +used to request a fixed, predefined type number for the new type); +.IP \f2name\fP 1 +The name of the new type. +.IP "\f2size, const_size\fP" 1 +The size of the corresponding C type (usually a \f2struct\fP) in bytes, +given as one of two, mutually-exclusive arguments: +\f2size\fP, a pointer to a function called by the interpreter to determine +the size of an object (for types whose individual members are of different +sizes, such as the \f2vector\fP type); +and \f2const_size\fP, the size as a constant (for all other types). +A null-pointer is given for \f2const_size\fP if \f2size\fP is to +be used instead. +.IP "\f2eqv, equal\fP" 1 +Pointers to (callback) functions that are invoked by the +interpreter whenever the Scheme predicate \f2equal?\&\fP, or \f2eqv?\&\fP +respectively, is applied to members of the newly defined type. +As an application-defined type is opaque from the interpreter's +point of view, the equality predicates have to be supplied by +the application or extension. +Each of these (boolean) functions is passed two objects of the new type +as arguments when called back. +.IP \f2print\fP 1 +A pointer to a function that is used by the interpreter to print +a member of this type. +When calling the print function, the interpreter passes as arguments +the Scheme object to be printed, a Scheme \f2port\fP to which the output is +to be sent, a flag indicating whether output is to be rendered in +human-readable form (\f2display\fP Scheme primitive) or machine-readable, +read-write-invariance preserving form (\f2write\fP), and finally the +current remainders of the maximum \f2print depth\fP and \f2print length\fP. +The return value of this function is not used (the type is \f2int\fP +for historical reasons). +.IP \f2visit\fP 1 +A pointer to a @[.``visit'' function] called by the @[.garbage collector] +when tracing the set of all currently accessible objects. +This function is only required if other Scheme objects +are reachable from objects of the newly defined type (a null +pointer can be given otherwise). +It is invoked with two arguments: +a pointer to the object being visited by the garbage collector, and a +pointer to another function to be called once with the address of +each object accessible through the original object. +For example, the implementation of pairs would supply a visit function +that invokes its second argument twice\*-once with the address of +the car of the original object, and once with the address of the cdr. +.Re +.PP +The return value of \f2Define_Type()\fP is a small, unique integer +identifying the type; it is usually stored in a ``T_*'' (or ``t_*'') +variable following the convention used for the built-in types. +.PP +In the current version of Elk, \f2Define_Type()\fP cannot be used +to define new ``pointer-less'' types resembling built-in types +such as \f2fixnum\fP or \f2boolean\fP. +.PP +The first component of the C structure implementing a user-defined +Scheme type must be an \f2Object\fP; its space is used by +the @[.garbage collector] to store a special tag indicating +that the object has been forwarded. +If you are defining a type that has several components one of +which is an \f2Object\fP, just move the \f2Object\fP to the +front of the \f2struct\fP declaration. +Otherwise insert an additional \f2Object\fP component. +.PP +The Scheme primitive that instantiates a new type can request +heap space for the new object by calling the function +@[.\f2Alloc_Object()\fP]: +.Es +Object Alloc_Object(int size, int type, int const_flag); +.Ee +The arguments to \f2Alloc_Object()\fP are the size of +the object in bytes (usually obtained by applying \f2sizeof\fP +to the underlying \f2struct\fP), the type of which the new +object is a member (i.\|e.\& the return value of \f2Define_Type()\fP), +and a flag indicating whether the newly created object is to +be made read-only. +The return value is a fully initialized \f2Object\fP. +.\" --------------------------------------------------------------------------- +.K2 "Example for a User-Defined Scheme Type" +.PP +Figure @(ndbm1) shows the skeleton of an extension that provides a +simple Scheme interface to the UNIX \f2ndbm\fP library; it can be +loaded dynamically into the Scheme interpreter, or into an Elk-based +application that needs access to a simple database from within the +extension language. +Please refer to your system's documentation if you are not familiar with +\f2ndbm\fP. +The extension defines a new, first-class Scheme type \f2dbm-file\fP +corresponding to the \f2DBM\fP type defined by the C library. +Again, note the naming convention to use lower-case for +new identifiers (in contrast to the predefined ones). +.Fs +#include +#include +.El +int t_dbm; +.El +struct s_dbm { + Object unused; + DBM *dbm; + char alive; /* 0: has been closed, else 1 */ +}; +.El +#define DBMF(obj) ((struct s_dbm *)POINTER(obj)) +.El +int dbm_equal(Object a, Object b) { + return DBMF(a)->alive && DBMF(b)->alive && DBMF(a)->dbm == DBMF(b)->dbm; +} +.El +int dbm_print(Object d, Object port, int raw, int length, int depth) { + Printf(port, "#[dbm-file %lu]", DBMF(d)->dbm); + return 0; +} +.El +Object p_is_dbm(Object d) { + return TYPE(d) == t_dbm ? True : False; +} +.El +void elk_init_dbm(void) { + t_dbm = Define_Type(0, "dbm-file", 0, sizeof(struct s_dbm), + dbm_equal, dbm_equal, dbm_print, 0); +.El + Define_Primitive(p_is_dbm, "dbm-file?", 1, 1, EVAL); + Define_Primitive(p_dbm_open, "dbm-open", 2, 3, VARARGS); + Define_Primitive(p_dbm_close, "dbm-close", 1, 1, EVAL); +} +.Fc "Skeleton of a UNIX ndbm extension" +.Fe ndbm1 +.PP +The code shown in Figure @(ndbm1) declares a variable \f2t_dbm\fP +to hold the return value of \f2Define_Primitive()\fP, and the +C structure \f2s_dbm\fP that represents the new type. +The structure is composed of the required initial \f2Object\fP, +the \f2DBM\fP pointer returned by the C library function \f2dbm_open()\fP, +and a flag indicating whether the database pointed to by this +object has already been closed (in this case the flag is cleared). +As a \f2dbm-file\fP Scheme object can still be passed to primitives +after the \f2DBM\fP handle has been closed by a call to \f2dbm_close()\fP, +the \f2alive\fP flag had to be added to avoid further use of a ``stale'' +object: +the ``dbm'' primitives include an initial check for the flag and raise +an error if it is zero. +.PP +The macro \f2DBMF\fP is used to cast the pointer field of an +\f2Object\fP of type \f2t_dbm\fP to a pointer to the correct structure +type. +\f2dbm_equal()\fP implements both the \f2eqv?\&\fP and the +\f2equal?\&\fP predicates; it returns true if the \f2Objects\fP +compared point to an open database and contain identical \f2DBM\fP +pointers. +The print function just prints the numeric value of the \f2DBM\fP +pointer; this could be improved by printing the name of the database +file instead, which must then be included in each Scheme object. +The primitive \f2p_is_dbm()\fP provides the usual @[.type predicate]. +Finally, an @[.extension initialization function] is supplied to +enable @[.dynamic loading] of the compiled code; it registers the new +type and three primitives operating on it. +Note that a @[.visit function] (the final argument to \f2Define_Type()\fP) +is not required here, as the new type does not include any components +of type \f2Object\fP that the garbage collector must know of\*-the +required initial \f2Object\fP is not used here and therefore can +be neglected. +The type constructor primitive \f2dbm-open\fP and the primitive +\f2dbm-close\fP are shown in Figure @(ndbm2). +.PP +.Fs +Object p_dbm_open(int argc, Object *argv) { + DBM *dp; + int flags = O_RDWR|O_CREAT; + Object d, sym = argv[1]; +.El + Check_Type(sym, T_Symbol); + if (EQ(sym, Intern("reader"))) + flags = O_RDONLY; + else if (EQ(sym, Intern("writer"))) + flags = O_RDWR; + else if (!EQ(sym, Intern("create"))) + Primitive_Error("invalid argument: ~s", sym); + if ((dp = dbm_open(Get_String(argv[0]), flags, + argc == 3 ? Get_Integer(argv[2]) : 0666)) == 0) + return False; + d = Alloc_Object(sizeof(struct s_dbm), t_dbm, 0); + DBMF(d)->dbm = dp; + DBMF(d)->alive = 1; + return d; +} +.El +Object p_dbm_close(Object d) { + Check_Type(d, t_dbm); + if (!DBMF(d)->alive) + Primitive_Error("invalid dbm-file: ~s", d); + DBMF(d)->alive = 0; + dbm_close(DBMF(d)->dbm); + return Void; +} +.Fc "Implementation of \f2dbm-open\fP and \f2dbm-close\fP" +.Fe ndbm2 +.PP +The primitive \f2dbm-open\fP shown in Figure @(ndbm2) is called with +the name of the database file, a symbol indicating the type of access +(\f2reader\fP for read-only access, \f2writer\fP for read/write access, +and \f2create\fP for creating a new file with read/write access), and +an optional third argument specifying the file permissions for a +newly-created database file. +A default of 0666 is used for the file permissions if the primitive +is invoked with just two arguments. +Section @(ch-symbits) will introduce a set of functions that avoid clumsy +if-cascades such as the one at the beginning of \f2p_dbm_open()\fP. +@[.\f2Primitive_Error()\fP] is called with a @[.``format string''] and +zero or more arguments and signals a Scheme error (see section @(ch-error)). +\f2dbm-open\fP returns #f if the database file could not be opened, +so that the caller can deal with the error. +.PP +Note that \f2dbm-close\fP first checks the \f2alive\fP bit to +raise an error if the database pointer is no longer valid +because of an earlier call to \f2dbm-close\fP. +This check needs to be performed by all primitives working on +\f2dbm-file\fP objects; it may be useful to wrap it in a separate +function\*-together with the initial type-check. +Ideally, database objects should be closed automatically during +@[.garbage collection] when they become inaccessible; section @(ch-term) +will introduce functions to accomplish this. +.PP +At least two primitives \f2dbm-store\fP and \f2dbm-fetch\fP need +to be added to the database extension to make it really useful; +these are not shown here (their implementation is fairly simple and +straightforward). +Using these primitives, the extension discussed in this section can +be used to write Scheme code such as this procedure (which looks up an +electronic mailbox name in the mail alias database maintained on +most UNIX systems): +.Es +(define expand-mail-alias + (lambda (alias) + (let ((d (dbm-open "/etc/aliases" 'reader))) + (if (not d) + (error 'expand-mail-alias "cannot open database")) + (unwind-protect + (dbm-fetch d alias) + (dbm-close d))))) +.El +(define address-of-staff (expand-mail-alias "staff")) +.Ee +.\" --------------------------------------------------------------------------- +.K1 "Advanced Topics" +.Rf ch-advanced \*(SN +.\" --------------------------------------------------------------------------- +.K2 "Converting between Symbols, Integers, and Bitmasks" +.Rf ch-symbits \*(SN +.PP +Symbols are frequently used as the arguments to Scheme primitives which +call an underlying C or C++ function with some kind of @[.bitmask] or with a +predefined enumeration constant or preprocessor symbol. +For example, the primitive \f2dbm-open\fP shown in Figure @(ndbm2) +above uses symbols to represent the symbolic constants passed to +\f2dbm_open()\fP. +Similarly, a Scheme primitive corresponding to the UNIX system call +\f2open()\fP could receive a list of symbols represending the +logical OR of the usual \f2open()\fP flags, so that one can +write Scheme code such as: +.Es +(let ((tty-fd (unix-open "/dev/ttya" '(read write exclusive))) + (tmp-fd (unix-open "/tmp/somefile '(write create)))) + ... +.Ee +.PP +To facilitate conversion of symbols to C integers or enumeration +constants and vice versa, these two functions are provided: +.Es +@[.=Symbols_To_Bits()]@[.=Bits_To_Symbols()] +unsigned long Symbols_To_Bits(Object syms, int mask_flag, + SYMDESCR *table); +Object Bits_To_Symbols(unsigned long bits, int mask_flag, + SYMDESCR *table); +.Ee +The type @[.\f2SYMDESCR\fP] is defined as: +.Es +typedef struct { + char *name; + unsigned long val; +} SYMDESCR; +.Ee +.PP +\f2Symbols_To_Bits()\fP converts a symbol or a list of symbols to +an integer; \f2Bits_To_Symbols()\fP is the reverse operation and is +usually applied to the return value of a C/C++ function to +convert it to a Scheme representation. +Both functions receive as the third argument a table specifying the +correspondence between symbols and C constants; each table entry is a +pair consisting of the \f2name\fP of a symbol as a C string and an +integer \f2val\fP (typically an enumeration constant or a \f2#define\fP +constant). +Each \f2SYMDESCR\fP array is terminated by an entry with a zero +\f2name\fP component: +.Es +SYMDESCR lseek_syms[] = { + { "set", SEEK_SET }, + { "current", SEEK_CUR }, + { "end", SEEK_END }, + { 0, 0 } +}; +.Ee +.PP +The second argument to the conversion functions controls whether a +single symbol is converted to an integer or vice versa (\f2mask_flag\fP +is zero), or whether a list of symbols is converted to the logical OR +of a set of matching values or vice versa (\f2mask_flag\fP is +non-zero). +\f2Symbols_To_Bits()\fP signals an error if the symbol does not +match any of the names in the given table or, if \f2mask_flag\fP +is non-zero, if any of the list elements does not match. +The empty list is converted to zero. +If \f2Bits_To_Symbols()\fP is called with a non-zero \f2mask_flag\fP, +it matches the \f2val\fP components against the \f2bits\fP argument +using logical AND. +Regardless of \f2mask_flag\fP, \f2Bits_To_Symbols\fP returns the empty +list if no match occurs. +Figure @(ndbm3) shows an improved version of \f2p_dbm_open()\fP +using \f2Symbols_To_Bits()\fP in place of nested if-statements. +.Fs +static SYMDESCR flag_syms[] = { + { "reader", O_RDONLY }, + { "writer", O_RDWR }, + { "create", O_RDWR|O_CREAT }, + { 0, 0 } +}; +.El +Object p_dbm_open(int argc, Object *argv) { + DBM *dp; + Object d; +.El + dp = dbm_open(Get_String(argv[0]), + Symbols_To_Bits(argv[1], 0, flag_syms), + argc == 3 ? Get_Integer(argv[2]) : 0666); + if (dp == 0) + return False; + d = Alloc_Object(sizeof(struct s_dbm), t_dbm, 0); + DBMF(d)->dbm = dp; + DBMF(d)->alive = 1; + return d; +} +.Fc "Improved version of \f2dbm-open\fP using \f2Symbols_To_Bits()\fP" +.Fe ndbm3 +.PP +A Scheme primitive calling the UNIX system call \f2access()\fP +could use \f2Symbols_To_Bits()\fP with a non-zero \f2mask_flag\fP +to construct a bitmask: +.Es +Object p_access(Object fn, Object mode) { + access(Get_String(fn), (int)Symbols_To_Bits(mode, 1, access_syms)); + ... +.Ee +where \f2access_syms\fP is defined as: +.Es +static SYMDESCR access_syms[] = { + { "read", R_OK }, + { "write", W_OK }, + { "execute", X_OK }, + { 0, 0 } +}; +.Ee +Note that in this example the empty list can be passed as the \f2mode\fP +argument to test for existence of the file, because in this case +\f2Symbols_To_Bits()\fP returns zero (the value of \f2F_OK\fP). +.\" --------------------------------------------------------------------------- +.K2 "Calling Scheme Procedures, Evaluating Scheme Code" +.Rf ch-funcall \*(SN +.PP +A Scheme procedure can be called from within C or C++ code using +the function +.Es +@[.=Funcall()] +Object Funcall(Object fun, Object argl, int eval_flag); +.Ee +The first argument is the Scheme procedure\*-either a primitive +procedure (\f2T_Primitive\fP) or a compound procedure (\f2T_Compound\fP). +The second argument is the list of arguments to be passed to +the procedure, as a Scheme list. +The third argument, if non-zero, specifies that the arguments need to be +evaluated before calling the Scheme procedure. +This is usually not the case (except in some special forms). +The return value of \f2Funcall()\fP is the result of the Scheme +procedure. +.PP +\f2Funcall()\fP is frequently used from within C callback functions +that can be registered for certain events, such as the user-supplied +X11 error handlers, X11 event handlers, timeout handlers, the C++ +\f2new\fP handler, etc. +Here, use of \f2Funcall()\fP allows to register a user-defined Scheme +procedure for this event from within a Scheme program. +As an example, Figure @(funcall) shows the generic signal handler +that is associated with various UNIX signals by the UNIX extension. +.Fs +void scheme_signal_handler(int sig) { + Object fun, args; +.El + Set_Error_Tag("signal-handler"); + Reset_IO(1); + args = Bits_To_Symbols((unsigned long)sig, 0, signal_syms); + args = Cons(args, Null); + fun = VECTOR(handlers)->data[sig]; + if (TYPE(fun) != T_Compound) + Fatal_Error("no handler for signal %d", sig); + (void)Funcall(fun, args, 0); + Printf(Curr_Output_Port, "\en\e7Signal!\en"); + (void)P_Reset(); + /*NOTREACHED*/ +} +.Fc "Using \f2Funcall()\fP to call a Scheme procedure" +.Fe funcall +.PP +The signal handler shown in Figure @(funcall) uses the signal +number supplied by the system to index a vector of user-defined +Scheme procedures (that is, \f2Objects\fP of type \f2T_Compound\fP). +@[.\f2Reset_IO()\fP] is used here to ensure that the current input +and output port are in defined state when the Scheme signal +handler starts executing. +The argument list is constructed by calling @[.\f2Cons()\fP]; +it consists of a single element\*-the signal number as a Scheme +symbol. +\f2signal_syms\fP is an array of @[.\f2SYMDESCR\fP] records that +maps the UNIX signal names (\f2sighup\fP, \f2sigint\fP, etc.) +to corresponding Scheme symbols of the same names. +The Scheme procedure called from the signal handler is not supposed +to return (it usually invokes a continuation); therefore the result +of \f2Funcall()\fP is ignored. +In case the Scheme handler (and thus the call to \f2Funcall()\fP) +does return, a message is printed and the primitive \f2reset\fP +is called to return to the application's toplevel or standard +Scheme toplevel. +.PP +An S-expression can be evaluated by calling the function +.Es +@[.=Eval()] +Object Eval(Object expr); +.Ee +which is identical to the primitive \f2eval\fP (\f2P_Eval()\fP in C), +except that no optional environment can be supplied. +\f2Eval()\fP is very rarely used by extensions or applications, +mainly by implementations of new special forms. +Both \f2Eval()\fP and \f2Funcall()\fP can trigger a +@[.garbage collection]; all @[.local variable]s holding Scheme \f2Objects\fP +with heap pointers must be properly registered with the +garbage collector to survive calls to these functions. +.PP +Occasionally an S-expression needs to be evaluated that exists as a C +string, for example, when a Scheme expression has been entered through +a ``text widget'' in a graphical user interface. +Here, evaluation requires calling the Scheme reader to parse the +expression; therefore a straightforward solution is to create a +@[.string port] holding the string and then just ``load'' the +contents of the port: +.Es +void eval_string(char *expr) { + Object port; GC_Node; +.El + port = P_Open_Input_String(Make_String(expr, strlen(expr))); + GC_Link(port); + Load_Source_Port(port); + GC_Unlink; + (void)P_Close_Input_Port(port); +} +.Ee +If a more sophisticated function is required, the \f2eval-string\fP +extension included in the Elk distribution can be used +(``lib/misc/elk-eval.c''). +This extension provides a function +.Es +@[.=Elk_Eval()] +char *Elk_Eval(char *expr); +.Ee +that converts the result of evaluating the stringized expression +back to a C string and returns it as a result. +A null pointer is returned if an error occurs during evaluation. +.PP +Applications should not use this function as the primary interface +to the extension language. +In contrast to languages such as @[.Tcl], the semantic concepts and +data structures of Scheme are not centered around strings, and strings +are not a practicable representation for S-expressions. +Instead, applications should pass control to the extension +language by calling Scheme procedures (using @[.\f2Funcall()\fP]) +or by loading files containing Scheme code. +The extension language then calls back into the application's C/C++ +layer by invoking application-supplied Scheme primitives and other +forms of callbacks as explained in section @(ch-control). +.\" --------------------------------------------------------------------------- +.K2 "GC-Protecting Global Objects" +.Rf ch-gcglobal \*(SN +.PP +Section @(ch-gc) explained when\*-and how\*-to register with +the @[.garbage collector] function-local \f2Object\fP variables +holding heap pointers. +Similarly, @[.global variable]s must usually be added to the set of +reachable objects as well if they are to survive garbage collections +(a useful exception to this rule will be introduced in section @(ch-term)). +In contrast to local variables, global variables are only made +known to the garbage collector once\*-after initialization\*-as +their lifetime is that of the entire program. +To add a global variable to the garbage collector's root set, the +macro +.Es +@[.=Global_GC_Link()] +Global_GC_Link(obj) +.Ee +must be called with the properly initialized variable of type +\f2Object\fP. +The macro takes the address of the specified object. +If that is a problem, an equivalent functional interface can be used: +.Es +@[.=Func_Global_GC_Link()] +void Func_Global_GC_Link(Object *obj_ptr); +.Ee +This function must be supplied the address of the global variable to +be registered with the garbage collector. +.PP +When writing extensions that maintain global \f2Object\fP variables, +\f2Global_GC_Link()\fP (or \f2Func_Global_GC_Link()\fP) is usually +called from within the @[.extension initialization function] right +after each variable is assigned a value. +For instance, the global Scheme vector \f2handlers\fP that was +used in Figure @(funcall) to associate procedures with UNIX signals +is initialized and GC-protected as follows: +.Es +void elk_init_unix_signal(void) { + handlers = Make_Vector(NSIG, False); + Global_GC_Link(handlers); + ... +} +.Ee +\f2NSIG\fP is the number of UNIX signal types as defined by the system +include file. +The signal handling Scheme procedures that are inserted into the +vector later need not be registered with the garbage collector, because +they are now reachable through another object which itself is reachable. +.\" --------------------------------------------------------------------------- +.K3 "Dynamic C Data Structures" +.PP +Dynamic data structures, such as the nodes of a linked list containing +Scheme \f2Objects\fP, cannot be easily registered with the garbage +collector. +The simplest solution is to build these data structures in Scheme +rather than in C or C++ in the first place. +For example, a linked list of Scheme objects can be built from +Scheme pairs much more naturally and more straightforward than +from C structures or the like, in particular if the list will +be traversed and manipulated using Scheme primitives anyway. +Besides, data structures programmed in Scheme benefit from automatic +memory management, whereas use of \f2malloc()\fP and \f2free()\fP +in C frequently is a source of memory leaks and related errors. +.PP +If for some reason a dynamic data structure must be built in C or +C++ rather than in Scheme, reachability problems can be avoided +by inserting all \f2Objects\fP into a global, GC-protected vector +(such as \f2handlers\fP in Figure @(funcall)) and then use the +corresponding vector indexes rather than the actual \f2Objects\fP. +This sounds more difficult than it really is; Appendix B shows +the complete source code of a small module to register \f2Objects\fP +in a Scheme vector. +The module exports three functions: +\f2register_object()\fP inserts an \f2Object\fP into the vector +and returns the index as an \f2int\fP; +\f2deregister_object()\fP removes an \f2Object\fP with a given +index from the vector; +and \f2get_object()\fP returns the \f2Object\fP stored under a +given index. +\f2register_object()\fP dynamically grows the vector to avoid +artificial limits. +.PP +A dynamic data structure (e.\|g.\& linked list) implementation using +this module would call \f2register_object()\fP when inserting a new +\f2Object\fP into the list and then use the integer return value in +place of the \f2Object\fP itself. +Similarly, it would call \f2deregister_object()\fP whenever a node +is removed from the list. +\f2get_object()\fP would be used to retrieve the \f2Object\fP associated +with a given list element. +Note that with these functions the same \f2Object\fP can be +registered multiple times (each time under a new index) without +having to maintain reference counts: +the garbage collector does not care how often a particular +\f2Object\fP is traversed during garbage collection, as long +as it will be reached at least once. +.\" --------------------------------------------------------------------------- +.K2 "Weak Pointers and Object Termination" +.Rf ch-term \*(SN +.PP +A data structure implementation may deliberately use \f2Objects\fP +that are not added to the global set of reachable pointers +(as described in the previous section) and are thus invisible to +the @[.garbage collector]. +In this case, it becomes possible to determine whether or not +garbage collection has found any \f2other\fP pointers to the same +Scheme objects. +This property can be exploited in several ways by extensions or +applications using Elk. +.PP +Pointers that are not included in the garbage collector's +reachability search are called @[.``weak pointers'']. +The memory occupied by a Scheme object that is only referenced by +weak pointers will be reclaimed. +The term \f2weak\fP expresses the notion that the pointer is +not strong enough to prevent the object it points to from +being garbage collected. +Code using weak pointers can scan the pointers immediately after +each garbage collection and check whether the target object +has been visited by the just-finished garbage collection. +If this is the case, normal (strong) pointers to the object must exist +(which can therefore be considered ``live''), and the weak pointer is +updated manually to point to the object's new location. +On the other hand, if the object has not been visited, +no more (normal) references to it exist and the memory occupied by it +has been reclaimed. +.PP +Weak pointers are useful in implementing certain types of data +structures where the sole existence of a (weak) pointer to an object +from within this data structure should not keep the object alive +(\f2weak sets\fP, \f2populations\fP, certain kinds of hash tables, etc.). +Objects that are not reachable through @[.strong pointers] are then +removed from the @[.weak data structure] after garbage collection. +In this case, it is frequently useful to invoke a +@[.``termination function''] for each such object, e.\|g.\& for objects +that contain resources of which only a finite amount is available, such +as UNIX file descriptors (or FILE structures), X displays +and windows, etc. +The termination function for Scheme ports closes the file pointer +encapsulated in a port object if it is still open; +likewise, the termination function for X windows closes the window and +thereby removes it from the display, and so on. +Thus, should an object holding some kind of resource go +inaccessible before it was terminated ``properly'' by calling +the respective Scheme primitive (\f2close-input-port\fP, +\f2close-output-port\fP, \f2destroy-window\fP, etc.), then +resource will be reclaimed after the next garbage collection run. +.\" --------------------------------------------------------------------------- +.K3 "Using Weak Pointers" +.PP +Code using @[.weak pointers] must scan the pointers immediately after +each @[.garbage collection], but \f2before\fP the interpreter resumes +normal operation, because the memory referenced by the weak pointers +can be reused the next time heap space is requested. +This can be accomplished by registering a so-called +@[.``after-GC function]. +Elk's garbage collector invokes all after-GC functions (without +arguments) upon completion. +To register an after-GC functions, the function +.Es +@[.=Register_After_GC()] +void Register_After_GC((void (*func)(void))); +.Ee +is used, typically in an @[.extension initializer]. +Similarly, extensions and applications can register +@[.=before-GC function]``before-GC functions'' using +.Es +@[.=Register_Before_GC()] +void Register_Before_GC((void (*func)(void))); +.Ee +These functions are called immediately before each garbage collection +and may be used, for instance, to change the application's cursor +to an hourglass symbol. +After-GC and before-GC functions must not trigger another garbage +collection. +.PP +An after-GC function scanning a set of weak pointers makes use +of the three macros @[.\f2IS_ALIVE()\fP], @[.\f2WAS_FORWARDED()\fP], +and @[.\f2UPDATE_OBJ()\fP]. +For example, an after-GC function scanning a table of +elements holding \f2Objects\fP with weak pointers could be +written as shown in Figure @(aftergc). +.Fs +void scan_weak_table(void) { + int i; +.El + for (i = 0; i < table_size; i++) { + Object obj = table[i].obj; + if (IS_ALIVE(obj)) { /* object is still reachable */ + if (WAS_FORWARDED(obj)) + UPDATE_OBJ(obj); + } else { + terminate_object(obj); /* object is dead; finalize... */ + table[i] = 0; /* and remove it from the table */ + } + } +} +.Fc "After-GC function that scans a table containing weak pointers" +.Fe aftergc +.PP +The function \f2scan_weak_table()\fP shown in Figure @(aftergc) can then +be registered as an after-GC function by invoking +.Es +Register_After_GC(scan_weak_table); +.Ee +.PP +The then-part of the if-statement in \f2scan_weak_table()\fP is entered +if the just-completed garbage collection has encountered any pointers +to the Scheme object pointed to by \f2obj\fP; in this case the +pointer conveyed in \f2obj\fP is updated manually using \f2UPDATE_OBJ()\fP +(when using the generational garbage collector included in Elk, +reachability of an object does not necessarily imply that it was +forwarded, hence the additional call to \f2WAS_FORWARDED()\fP). +If \f2IS_ALIVE()\fP returns false, no more strong pointers to the +object exist and it can be terminated and removed from the weak +data structure. +\f2terminate_object()\fP typically would release any external +resources contained in the Scheme object, but it must neither +create any new objects nor attempt to ``revive'' the +dead object in any way (e.\|g.\& create a new strong pointer +to it by inserting it into another, live object). +.\" --------------------------------------------------------------------------- +.K3 "Functions for Automatic Object Termination" +.PP +As automatic termination of Scheme objects using user-supplied +@[.termination function]s is the most frequent use of @[.weak pointers], +Elk offers a set of convenience functions for this purpose. +Extensions and applications can insert \f2Objects\fP into a +@[.weak list] maintained by Elk and remove them from the list +using the two functions +.Es +@[.=Register_Object()]@[.=Deregister_Object()] +void Register_Object(Object obj, char *group, + (Object (*term)(Object)), int leader_flag); +void Deregister_Object(Object obj); +.Ee +.PP +\f2term\fP is the termination function that is called automatically +with \f2obj\fP when the object becomes unreachable (its result +is not used); +\f2group\fP is an opaque ``cookie'' associated with \f2obj\fP +and can be used to explicitly terminate all objects with the +same value for \f2group\fP; +a non-zero \f2leader_flag\fP indicates that \f2obj\fP is the +``leader'' of the specified \f2group\fP. +Elk automatically registers an @[.after-GC function] to scan +the weak list maintained by these two functions and to call +the \f2term\fP function for all objects that could be proven +unreachable by the garbage collector, similar to the function +shown in Figure @(aftergc). +.PP +Object termination takes place in two phases: +first all objects registered with a zero \f2leader_flag\fP +are terminated, after that the termination functions of +the leaders are invoked. +This group and leader notion is used, for example, by the +@[.Xlib extension] to associate windows (and other resources) with +an X display: +the ID of the display to which a window belongs is used as +the window's group, and the display is marked as the group leader. +Thus, if a display becomes unreachable or is closed by the program, all +its windows are closed before the display is finally destroyed\**. +.FS +This interface has evolved in a slightly \f2ad hoc\fP way; +the two-stage relationship expressed by groups and group leaders +may not be sufficient for more complex hierarchies than those +used in X. +.FE +.LP +Two additional functions are provided for explicitly calling +the termination functions: +.Es +@[.=Terminate_Type()]@[.=Terminate_Group()] +void Terminate_Type(int type); +void Terminate_Group(char *group); +.Ee +\f2Terminate_Type()\fP invokes the termination function (if any) for +all objects of a given type and deletes them from the weak list. +For example, to close all ports currently held open by Elk (and +thus apply \f2fclose()\fP to the FILE pointers embedded in them), +one would call +.Es +@[.=T_Port] +Terminate_Type(T_Port) +.Ee +\f2Terminate_Group()\fP calls the termination functions of +all non-leader objects belonging to the specified \f2group\fP. +.LP +Finally, another function, @[.\f2Find_Object()\fP], +locates an object in the weak list: +.Es +Object Find_Object(int type, char *group, + (int (*match_func)(Object, ...)), ...); +.Ee +Arguments are a Scheme type, a group, and a match function called +once for each object in the weak list that has the specified type +and group. +The match function is passed the \f2Object\fP and the remaining arguments +to \f2Find_Object()\fP, if any. +If the match function returns true for an object, this object becomes +the return value of \f2Find_Object()\fP; otherwise it returns \f2Null\fP. +.PP +Complicated as it may seem, \f2Find_Object()\fP is quite useful\*-extensions +can check whether a Scheme object with certain properties +has already been registered with the weak list earlier and, if this is the +case, return \f2this\fP object instead of creating a new one. +This is critical for Scheme objects encapsulating some kind of +external resource, such as file descriptors or X windows. +Consider, for example, a Scheme primitive that obtains the topmost +window on a given X display and returns it as a Scheme \f2window\fP +object. +If the primitive just were to instantiate a Scheme object +encapsulating the corresponding X window ID for each call, it would +become possible for two or more distinct Scheme \f2window\fP objects to +reference the same real X window. +This is not acceptable, because two Scheme objects pointing to the same X +object should certainly be equal in the sense of \f2eq?\&\fP, +not to mention the problems that would ensue if one of the Scheme +\f2window\fP objects were closed (thereby destroying the underlying +X window) and the second one were still be operated on afterwards. +Example uses of \f2Find_Object()\fP can be found in the @[.Xlib extension] +and in the @[.Xt extension] that are included in the Elk distribution. +.\" --------------------------------------------------------------------------- +.K2 "Errors" +.Rf ch-error \*(SN +.PP +User-supplied code can signal an error by calling +@[.\f2Primitive_Error()\fP] with a @[.format string] and as many additional +arguments (\f2Objects\fP) as there are @[.format specifier]s in the format +string: +.Es +void Primitive_Error(char *fmt, ...); +.Ee +\f2Primitive_Error()\fP calls the default or user-defined +@[.error handler] as described in the Elk Reference Manual, passing it an +@[.``error tag''] identifying the source of the error, the format +string, and the remaining arguments. +A special format specifier ``~E'' can be used to interpolate the standard +error message text corresponding to the UNIX error number @[.\f2errno\fP]; +this is useful for primitives that invoke UNIX system calls or certain +C library functions (if ``~e'' is used, the first character of +the text is converted to lower case). +If this format specifier is used, the current \f2errno\fP must be +assigned to a variable @[.\f2Saved_Errno\fP] prior to calling +\f2Primitive_Error()\fP to prevent it from being overwritten +by the next system call or C library function. +\f2Primitive_Error()\fP does not return. +.PP +Applications that need to supply their own error handler by +redefining \f2error-handler\fP usually do so in Scheme, +typically at the beginning of the initial Scheme file loaded +in \f2main()\fP. +.PP +If \f2Primitive_Error()\fP is called from within a C function +that implements a Scheme primitive, an error tag is supplied +by Elk (the name of the primitive). +Applications may set the error tag explicitly at the +beginning of sections of C/C++ code that reside outside of +primitives, for example, before loading an initial Scheme +file in the application's \f2main()\fP. +Two functions are provided to set and query the current error tag: +.Es +@[.=Set_Error_Tag()]@[.=Get_Error_Tag()] +void Set_Error_Tag(const char *tag); +char *Get_Error_Tag(void); +.Ee +The following three functions can be used by primitives to signal +errors with standardized messages in certain situations: +.Es +@[.=Range_Error()]@[.=Wrong_Type()]@[.=Wrong_Type_Combination()] +void Range_Error(Object offending_obj); +void Wrong_Type(Object offending_obj, int expected_type); +void Wrong_Type_Combination(Object offending_obj, char *expected_type); +.Ee +\f2Range_Error()\fP can be used when an argument to a primitive +is out of range (typically some kind of index). +\f2Wrong_Type()\fP signals a failed type-check for the given +\f2Object\fP; the second argument is the expected type of the +\f2Object\fP. +This function is used, for example, by @[.\f2Check_Type()\fP]. +\f2Wrong_Type_Combination()\fP is similar to \f2Wrong_Type()\fP; +the expected type is specified as a string. +This is useful if an \f2Object\fP can be a member of one out +of two or more types, e.\|g.\& a string or a symbol. +.LP +Fatal errors can be signaled using the functions +.Es +@[.=Fatal_Error()]@[.=Panic()] +void Fatal_Error(char *fmt, ...); +void Panic(char *msg); +.Ee +\f2Fatal_Error()\fP passes its arguments to \f2printf()\fP and +then terminates the program. +\f2Panic()\fP is used in situations that ``cannot happen'' +(failed consistency checks or failed assertions); +it prints the specified message and terminates the program +with a core dump. +.\" --------------------------------------------------------------------------- +.K2 "Exceptions" +.PP +As explained in the Elk Reference Manual, a user-supplied Scheme +procedure is called each time an @[.\f2exception\fP] is raised. +Currently, the set of UNIX @[.signals] that are caught by the interpreter +or an extension (at least \f2interrupt\fP and \f2alarm\fP) are used +as exceptions. +As signals occur asynchronously, extensions and applications must be +able to protect non-reentrant or otherwise critical code sections +from the delivery of signals. +In particular, calls to external library functions are frequently +not reentrant\** and need to be protected from being disrupted. +.FS +Fortunately, with the advent of multithreading, vendors are now +beginning to provide reentrant versions of their system libraries. +.FE +.PP +Extensions may call the macros @[.\f2Disable_Interrupts\fP] and +@[.\f2Enable_Interrupts\fP] (without arguments) to enclose code fragments +that must be protected from exceptions. +Calls to these macros can be nested, and they are also available +as Scheme primitives on the Scheme-language level. +As all modern UNIX versions provide a facility to temporarily block +the delivery of signals, a signal that occurs after a call to +\f2Disable_Interrupts\fP will be delayed until the outermost matching +\f2Enable_Interrupts\fP is executed. +Two additional macros, @[.\f2Force_Disable_Interrupts\fP] and +@[.\f2Force_Enable_Interrupts\fP] can be used to enable +and disable signal delivery regarless of the current nesting level. +Extensions that use additional signals (such as the \f2alarm\fP signal) +must register these with the interpreter core to make sure they are +included in the \f2mask\fP of signals that is maintained by +\f2Disable_Interrupts\fP and \f2Enable_Interrupts\fP (the interface +for registering signals is still being revised; refer to the source +code of the UNIX extension for an example). +.PP +The ability to protect code from exceptions is particularly useful +for primitives that temporarily open a file or allocate some other +kind of resource that must subsequently be released again. +If the relevant code fragment were not enclosed by calls to +\f2Disable_Interrupts\fP and \f2Enable_Interrupts\fP, an exception +handler could abandon execution of the code section by calling +a continuation, thus causing the file to remain open forever. +While situations like this can be handled by \f2dynamic-wind\fP +on the Scheme level, some form of +\f2try/catch\fP facility is not available on the C-language level, +and using the C function implementing the \f2dynamic-wind\fP primitive +would be cumbersome. +.LP +The function +.Es +@[.=Signal_Exit()] +void Signal_Exit(int signal_number); +.Ee +may be used as the handler for signals that must terminate the +application; it ensures that the temporary files maintained by Elk are +removed and calls the @[.extension finalization functions] in +the normal way. +.\" --------------------------------------------------------------------------- +.K2 "Defining Scheme Variables" +.PP +User-supplied C/C++ code can define global Scheme variables that are +maintained as corresponding \f2Object\fP C variables. +The Scheme interpreter itself defines several such variables, +for example, the variable @[.\f2load-path\fP] (see section @(ch-dynl)) +which can be modified and read both from Scheme and from C. +The function @[.\f2Define_Variable()\fP] is used +to define a Scheme variable and bind an initial value to it: +.Es +void Define_Variable(Object *var, const char *name, Object init); +.Ee +\f2var\fP is the address of the C variable corresponding to +the newly-created Scheme variable, \f2name\fP is the +name of the Scheme variable, and \f2init\fP is its initial value. +\f2Define_Variable()\fP calls @[.\f2Intern()\fP] to create the +variable name included in the new binding and +@[.\f2Func_Global_GC_Link()\fP] to properly register the C variable +with the garbage collector. +.LP +The C side of a Scheme variable cannot be accessed directly; +the functions +.Es +@[.=Var_Set()]@[.=Var_Get()] +Var_Set(Object variable, Object value); +Var_Get(Object variable) +Var_Is_True(Object variable) +.Ee +must be used instead to assign a value to the variable and +to read its current value; the first argument to each function +is the \f2Object\fP whose address was passed to \f2Define_Variable()\fP. +\f2Var_Is_True()\fP is convenient for boolean variables and tests +whether the contents of the variable is true in the sense of \f2Truep()\fP. +As an example, Figure @(defvar) shows how the @[.Xt extension] +defines a Scheme variable that is associated with the user-defined +``warning handler'' called by the Xt library to output warning messages. +.Fs +Object V_Xt_Warning_Handler; +.El +void Xt_Warning(char *msg) { + Object args, fun; +.El + args = Cons(Make_String(msg, strlen(msg)), Null); + fun = Var_Get(V_Xt_Warning_Handler); + if (TYPE(fun) == T_Compound) + (void)Funcall(fun, args, 0); + else + Printf(Curr_Output_Port, "%s\en", msg); +} +.El +void elk_init_xt_error(void) { + Define_Variable(&V_Xt_Warning_Handler, "xt-warning-handler", Null); + XtSetWarningHandler(Xt_Warning); +} +.Fc "The Xt extension defines a Scheme variable holding a ``warning handler''" +.Fe defvar +.PP +In the example in Figure @(defvar), the function \f2Xt_Warning()\fP +is registered as the Xt ``warning handler'' by passing it to +\f2XtSetWarningHandler()\fP. +It is invoked by Xt with a warning message. +The message is converted to a Scheme string, and, if the Scheme +variable \f2xt-warning-handler\fP has been assigned a procedure, +this procedure is called with the string using @[.\f2Funcall()\fP]. +Otherwise the string is just sent to the current output port. +The call to \f2Define_Variable()\fP in the extension initialization +function associates the Scheme variable \f2xt-warning-handler\fP +with the C variable \f2V_Xt_Warning_Handler\fP (as a convention, +Elk uses the prefix ``V_'' for variables of this kind). +.\" --------------------------------------------------------------------------- +.K2 "Defining Readers" +.PP +In addition or as an alternative to the constructor primitive +for a new Scheme type, applications and extensions may define a +@[.\f2reader\fP function] for each new type. +The @[.bitstring extension], for example, defines a reader to allow +input of bitstring literals using the \f2#*10110001\fP syntax. +Each user-defined read syntax is introduced by the `#' symbol +followed by one more character, identifying the type of the object. +To define a reader, the following function is called (typically +from within an @[.extension initialization function]): +.Es +@[.=Define_Reader()] +void Define_Reader(int c, + (Object (*func)(Object port, int c, int const_flag))); +.Ee +.PP +The arguments to \f2Define_Reader()\fP are the as yet unused +character identifying the type (e.\|g.\& `*' for bitstrings) +and a pointer to a \f2reader function\fP that is invoked by the +Scheme parser whenever the newly defined syntax is encountered. +This reader function is passed a Scheme input port from which it reads +the next token, the character following the `#' symbol (to facilitate +using the same reader for different types), and a flag indicating +whether the newly-created object is expected to be made read-only +(this is true when expressions are loaded from a file). +The reader function must return a new object of the given type. +.PP +You may want to refer to the bitstring extension included in the Elk +distribution for an example definition of a reader function +(``lib/misc/bitstring.c''), and for the macros that can be used by +reader functions to efficiently read characters from a port. +.\" --------------------------------------------------------------------------- +.K2 "Fork Handlers" +.PP +Extensions may need to be notified when a copy of the running +interpreter (or application) is created by means of the \f2fork()\fP +UNIX system call. +For example, consider an extension that stores information in a +temporary file and removes this file on termination of the program. +If another extension created a copy of the running interpreter by +calling \f2fork()\fP, the child process would remove the temporary +file on exit\*-the file would not be available to the original +instance of the interpreter (i.\|e.\& the parent process) any longer. +To prevent premature removal of the file, the extension that owns +it can define a @[.\f2fork handler\fP] by calling @[.\f2Register_Onfork()\fP] +with a pointer to a C function: +.Es +void Register_Onfork((void (*func)(void))); +.Ee +The function could create an additional link to the file, so that +a child process would just remove this link on exit, leaving the +original link intact. +.PP +Extensions that use \f2fork()\fP without executing a new program +in the child process (e.\|g.\& the @[.UNIX extension] which +defines a \f2unix-fork\fP primitive) are required to call the function +@[.\f2Call_Onfork()\fP] in the newly created child process to invoke all +currently defined fork handlers: +.Es +void Call_Onfork(void); +.Ee +.\" --------------------------------------------------------------------------- +.AP "Appendix A: Functions that can Trigger a Garbage Collection" +.PP +This appendix lists the functions exported by Elk that may trigger a +@[.garbage collection]. +Within C/C++ code, local Scheme objects must be protected as shown in +section @(ch-gc) when one of these functions is called during the +objects' lifetime. +.PP +The C functions corresponding to the following Scheme primitives can +cause a garbage collection: +.Es +append load read-string +apply macro-body require +autoload macro-expand reverse +backtrace-list make-list string +call-with-input-file make-string string->list +call-with-output-file make-vector string->number +call/cc map string->symbol +command-line-args oblist string-append +cons open-input-file string-copy +dump open-input-output-file substring +dynamic-wind open-input-string symbol-plist +eval open-output-file tilde-expand +for-each open-output-string type +force port-line-number vector +get-output-string procedure-lambda vector->list +list provide vector-copy +list->string put with-input-from-file +list->vector read with-output-to-file +.El +.ft 2 +all special forms +all mathematical primitives except predicates +all output primitives if output is sent to a string port +.ft +.Ee +.PP +In practice, most of these functions, in particular the special forms, +are rarely or never used in extensions or Elk-based applications. +In addition to these primitives, the following C functions can +trigger a garbage collection: +.Es +Alloc_Object() Make_Reduced_Flonum() Make_String() +Make_Port() Make_Flonum() Make_Const_String() +Load_Source_Port() Define_Primitive() Intern() +Load_File() Printf() CI_Intern() +Copy_List() Print_Object() Define_Variable() +Const_Cons() General_Print_Object() Define_Symbol() +Make_Integer() Format() Bits_To_Symbols() +Make_Unsigned() Eval() Make_Vector() +Make_Long() Funcall() Make_Const_Vector() +Make_Unsigned_Long() +.Ee +.LP +Note: \f2Make_Integer()\fP, \f2Make_Unsigned()\fP, +\f2Make_Long()\fP, and \f2Make_Unsigned_Long()\fP can only trigger a +garbage collection if \f2FIXNUM_FITS()\fP (or \f2UFIXNUM_FITS()\fP, +respectively) returns zero for the given argument. +.\" --------------------------------------------------------------------------- +.AP "Appendix B: Convenience Functions for GC-Safe Data Structures" +.PP +Figure @(gcroot) shows the source code for a set of functions to +insert Scheme objects into a vector that has been registered with the +garbage collector, to delete objects from the vector, +and to retrieve the object stored under a given vector index. +These functions help building dynamic data structures (such as +linked lists or hash tables) containing Scheme objects. +There is nothing application-specific in the code; if you find it +useful, you can directly include it in your Elk extension or +Elk-based application without any changes. +See section @(ch-gcglobal) for a detailed description. +.Fs nofloat +static int max_objects = 32; /* initial size */ +static int num_objects; +static Object objects; +static int inx; +.El +int register_object(Object x) { + Object v; + int n; + GC_Node; +.El + if (num_objects == max_objects) { + max_objects *= 2; + GC_Link(x); + v = Make_Vector(max_objects, Null); + GC_Unlink; + memcpy(VECTOR(v)->data, VECTOR(objects)->data, + num_objects * sizeof(Object)); + objects = v; + inx = num_objects; + } + for (n = 0; !Nullp(VECTOR(objects)->data[inx]); + inx++, inx %= max_objects) { + n++; + assert(n < max_objects); + } + VECTOR(objects)->data[inx] = x; + num_objects++; + return inx; +} +.El +void deregister_object(int i) { + VECTOR(objects)->data[i] = Null; + --num_objects; + assert(num_objects >= 0); +} +.El +Object get_object(int i) { + return VECTOR(objects)->data[i]; +} +.El +void elk_init_gcroot(void) { + objects = Make_Vector(max_objects, Null); + Global_GC_Link(objects); +} +.Fc "Functions to map Scheme objects to indexes into a GC-safe vector" +.Fe gcroot +.\" --------------------------------------------------------------------------- +.AP "Appendix C: Summary of Functions, Macros, Types, and Variables" +.PP +This appendix provides a quick overview of the functions and other +definitions exported by the Elk kernel. +The list is divided in groups of definitions with related +functionality; the entries are presented in roughly the same order +in which they are introduced in the above chapters. +Full function prototypes are given for functions; in some +prototypes, arguments are given names for clarification. +The initial keywords \f3function\fP, \f3macro\fP, \f3typedef\fP, +and \f3variable\fP indicate the type of each entry (function, +preprocessor symbol with or without arguments, type definition, +and external variable defined by Elk, respectively). +The functions corresponding to Scheme primitives (as described +in section @(ch-prims)) have been omitted from the list. +.SH +Accessing the Scheme Object Representation +.LP +.Cs +\f3typedef\fP Object +.Cl +\f3macro\fP TYPE(obj) +\f3macro\fP POINTER(obj) +\f3macro\fP ISCONST(obj) +\f3macro\fP SETCONST(obj) +\f3macro\fP SET(obj, type, ptr) +\f3macro\fP EQ(obj1, obj2) +.Ce +.SH +Defining Scheme Primitives +.LP +.Cs +\f3function\fP void Define_Primitive((Object (*func)()), const char *name, + int minargs, int maxargs, enum discipline disc); +.Ce +.SH +Making Objects Known to the Garbage Collector +.LP +.Cs +\f3macro\fP GC_Node, GC_Node2, ... +\f3macro\fP GC_Link(obj), GC_Link2(obj1, obj2), ... +\f3macro\fP GC_Unlink +\f3macro\fP Global_GC_Link(obj) +\f3function\fP void Func_Global_GC_Link(obj_ptr); +.Ce +.SH +Booleans +.LP +.Cs +\f3macro\fP T_Boolean +\f3macro\fP Truep(obj) +.Cl +\f3variable\fP Object True +\f3variable\fP Object False +.Cl +\f3function\fP int Eqv(Object, Object); +\f3function\fP int Equal(Object, Object); +.Ce +.SH +Characters +.LP +.Cs +\f3macro\fP T_Character +\f3macro\fP CHAR(char_obj) +\f3function\fP Object Make_Char(int); +\f3variable\fP Object Newline +.Ce +.SH +Pairs and Lists +.LP +.Cs +\f3macro\fP T_Null +\f3macro\fP Nullp(obj) +\f3variable\fP Null +.Cl +\f3macro\fP T_Pair +\f3macro\fP PAIR(pair_obj) +\f3macro\fP Car(obj) +\f3macro\fP Cdr(obj) +\f3macro\fP Cons(obj1, obj2) +.Cl +\f3macro\fP Check_List(obj) +\f3function\fP int Fast_Length(Object); +\f3function\fP Object Copy_List(Object); +.Ce +.SH +Integers (Fixnums and Bignums) +.LP +.Cs +\f3macro\fP T_Fixnum +\f3macro\fP T_Bignum +\f3macro\fP FIXNUM_FITS(integer) +\f3macro\fP UFIXNUM_FITS(unsigned_integer) +\f3macro\fP FIXNUM(fixnum_obj) +\f3macro\fP BIGNUM(bignum_obj) +.Cl +\f3macro\fP Check_Integer(obj) +\f3macro\fP Check_Number(obj) +.Cl +\f3function\fP Object Make_Integer(int); +\f3function\fP Object Make_Unsigned(unsigned); +\f3function\fP Object Make_Long(long); +\f3function\fP Object Make_Unsigned_Long(unsigned long); +.Cl +\f3function\fP int Get_Integer(Object); +\f3function\fP unsigned Get_Unsigned(Object); +\f3function\fP long Get_Long(Object); +\f3function\fP unsigned long Get_Unsigned_Long(Object); +.Cl +\f3function\fP int Get_Exact_Integer(Object); +\f3function\fP unsigned Get_Exact_Unsigned(Object); +\f3function\fP long Get_Exact_Long(Object); +\f3function\fP unsigned long Get_Exact_Unsigned_Long(Object); +.Ce +.SH +Floating Point Numbers (Reals) +.LP +.Cs +\f3macro\fP T_Flonum +\f3macro\fP FLONUM(flonum_obj) +\f3function\fP Object Make_Flonum(double); +\f3function\fP Object Make_Reduced_Flonum(double); +\f3function\fP double Get_Double(Object); +.Ce +.SH +Symbols +.LP +.Cs +\f3macro\fP T_Symbol +\f3macro\fP SYMBOL(symbol_obj) +\f3function\fP Object Intern(const char *); +\f3function\fP Object CI_Intern(const char *); +\f3function\fP void Define_Symbol(Object *var, const char *name); +\f3variable\fP Object Void +.Cl +\f3typedef\fP SYMDESCR +\f3function\fP unsigned long Symbols_To_Bits(Object syms, int mask_flag, + SYMDESCR *table); +\f3function\fP Object Bits_To_Symbols(unsigned long bits, int mask_flag, + SYMDESCR *table); +.Ce +.SH +Strings +.LP +.Cs +\f3macro\fP T_String +\f3macro\fP STRING(string_obj) +\f3function\fP Object Make_String(const char *init, int size); +\f3function\fP char *Get_String(Object); +\f3function\fP char *Get_Strsym(Object); +\f3macro\fP Get_String_Stack(obj, char_ptr) +\f3macro\fP Get_Strsym_Stack(obj, char_ptr) +.Ce +.SH +Vectors +.LP +.Cs +\f3macro\fP T_Vector +\f3macro\fP VECTOR(vector_obj) +\f3function\fP Object Make_Vector(int size, Object fill); +.Ce +.SH +Ports +.LP +.Cs +\f3macro\fP T_Port +\f3macro\fP PORT(port_obj) +\f3function\fP Object Make_Port(int flags, FILE *f, Object name); +\f3function\fP Object Terminate_File(Object port); +\f3macro\fP Check_Input_Port(obj) +\f3macro\fP Check_Output_Port(obj) +\f3variable\fP Object Curr_Input_Port, Curr_Output_Port +\f3variable\fP Object Standard_Input_Port, Standard_Output_Port +\f3function\fP void Reset_IO(int destructive_flag); +\f3function\fP void Printf(Object port, char *fmt, ...); +\f3function\fP void Print_Object(Object obj, Object port, int raw_flag, + int print_depth, int print_length); +\f3macro\fP Print(obj) +\f3function\fP void Load_Source_Port(Object port); +\f3function\fP void Load_File(char *filename); +.Ce +.SH +Miscellaneous Types +.LP +.Cs +\f3macro\fP T_End_Of_File +\f3variable\fP Object Eof +.Cl +\f3macro\fP T_Environment +\f3variable\fP Object The_Environment, Global_Environment +.Cl +\f3macro\fP T_Primitive +\f3macro\fP T_Compound +\f3function\fP void Check_Procedure(Object); +.Cl +\f3macro\fP T_Control_Point +\f3macro\fP T_Promise +\f3macro\fP T_Macro +.Ce +.SH +Defining Scheme Types and Allocating Objects +.LP +.Cs +\f3function\fP int Define_Type(int zero, const char *name, + int (*size)(Object), int const_size, + int (*eqv)(Object, Object), + int (*equal)(Object, Object), + int (*print)(Object, Object, int, int, int), + int (*visit)(Object*, int (*)(Object*))); +\f3function\fP Object Alloc_Object(int size, int type, int const_flag); +.Ce +.SH +Calling Scheme Procedures and Evaluating Scheme Code +.LP +.Cs +\f3function\fP Object Funcall(Object fun, Object argl, int eval_flag); +\f3function\fP Object Eval(Object expr); +\f3function\fP char *String_Eval(char *expr); +.Ce +.SH +Weak Pointers and Object Termination +.LP +.Cs +\f3function\fP void Register_Before_GC((void (*func)(void))); +\f3function\fP void Register_After_GC((void (*func)(void))); +.Cl +\f3macro\fP IS_ALIVE(obj) +\f3macro\fP WAS_FORWARDED(obj) +\f3macro\fP UPDATE_OBJ(obj) +.Cl +\f3function\fP void Register_Object(Object obj, char *group, + (Object (*term)(Object)), int leader_flag); +\f3function\fP void Deregister_Object(Object obj); +\f3function\fP void Terminate_Type(int type); +\f3function\fP void Terminate_Group(char *group); +\f3function\fP Object Find_Object(int type, char *group, + (int (*match_func)(Object, ...)), ...); +.Ce +.SH +Signaling Errors +.LP +.Cs +\f3function\fP void Primitive_Error(char *fmt, ...); +\f3function\fP void Set_Error_Tag(const char *tag); +\f3function\fP char *Get_Error_Tag(void); +\f3function\fP void Set_App_Name(char *name); +\f3function\fP void Range_Error(Object offending_obj); +\f3function\fP void Wrong_Type(Object offending_obj, int expected_type); +\f3function\fP void Wrong_Type_Combination(Object offending_obj, + char *expected_type); +\f3function\fP void Fatal_Error(char *fmt, ...); +\f3function\fP void Panic(char *msg); +\f3variable\fP int Saved_Errno +.Ce +.SH +Exceptions (Signals) +.LP +.Cs +\f3macro\fP Disable_Interrupts, Enable_Interrupts +\f3macro\fP Force_Disable_Interrupts, Force_Enable_Interrupts +\f3function\fP void Signal_Exit(int signal_number); +.Ce +.SH +Defining and Using Scheme Variables +.LP +.Cs +\f3function\fP void Define_Variable(Object *var, const char *name, Object init); +\f3function\fP void Var_Set(Object var, Object val); +\f3function\fP Object Var_Get(Object var); +\f3function\fP int Var_Is_True(Object var); +.Ce +.SH +Defining Reader Functions +.LP +.Cs +\f3function\fP void Define_Reader(int c, + (Object (*func)(Object port, int c, int const_flag))); +.Ce +.SH +Fork Handlers +.LP +.Cs +\f3function\fP void Register_Onfork((void (*func)(void))); +\f3function\fP void Call_Onfork(void); +.Ce +.SH +Allocating Memory +.LP +.Cs +\f3function\fP char *Safe_Malloc(unsigned size); +\f3function\fP char *Safe_Realloc(char *old_pointer, unsigned size); +.Cl +\f3macro\fP Alloca_Begin, Alloca_End +\f3macro\fP Alloca(char_ptr, type, size) +.Ce +.SH +Initializing Elk from an Application's main() +.LP +.Cs +\f3function\fP void Elk_Init(int argc, char **argv, int init_flag, + char *filename); +.Ce +.SH +Miscellaneous Macros +.LP +.Cs +\f3macro\fP ELK_MAJOR, ELK_MINOR +\f3macro\fP NO_PROTOTYPES, WANT_PROTOTYPES +.Ce +.\" --------------------------------------------------------------------------- +.\" XXX: dynamic loading + dump +.\" --------------------------------------------------------------------------- +.if !\n(.U .so ../util/tmac.index +.if !\n(.U .so side.inx +.Tc diff --git a/doc/cprog/cprog.ps b/doc/cprog/cprog.ps new file mode 100644 index 0000000..addfbe0 --- /dev/null +++ b/doc/cprog/cprog.ps @@ -0,0 +1,4541 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier-Bold +%%+ font Courier +%%+ font Symbol +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 65 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier-Bold +%%IncludeResource: font Courier +%%IncludeResource: font Symbol +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier@0 ENC0/Courier RE/Courier-Bold@0 +ENC0/Courier-Bold RE/Times-Roman@0 ENC0/Times-Roman RE/Times-Italic@0 ENC0 +/Times-Italic RE/Times-Bold@0 ENC0/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(Building Extensible A)173.286 123 Q +(pplications with Elk \212)-.3 E(C/C++ Pr)210.504 153 Q(ogrammer')-.216 E 3(sM) +-.444 G(anual)336.816 153 Q/F1 10/Times-Italic@0 SF(Oliver Laumann)255.085 177 +Q(ABSTRA)264.535 219 Q(CT)-.3 E/F2 11/Times-Roman@0 SF .953(Elk \()133 246 R/F3 +11/Times-Italic@0 SF .952(Extension Langua)B 1.172 -.11(ge K)-.11 H(it).11 E F2 +3.702(\)i)C 3.702(saS)274.089 246 S .952(cheme implementation designed as an) +296.772 246 R .723(embeddable, reusable e)108 261 R .724 +(xtension language subsystem for inte)-.165 F .724(gration into e)-.165 F +(xisting)-.165 E .767(and future applications written in C or C++.)108 276 R +.766(The programmer')6.266 F 3.516(si)-.605 G(nterf)401.821 276 Q .766 +(ace to Elk)-.11 F(pro)108 291 Q .653(vides for a close interw)-.165 F .653 +(orking of the C/C++ parts of Elk-based,)-.11 F F3(hybrid)3.403 E F2(appli-) +3.403 E .619(cations with e)108 306 R .619(xtensible Scheme code.)-.165 F .618 +(This manual describes the f)6.118 F .618(acilities of the)-.11 F .436 +(C/C++ programmer')108 321 R 3.186(si)-.605 G(nterf)209.28 321 Q .436 +(ace that can be used by authors of e)-.11 F .437(xtensible applica-)-.165 F +1.523(tions and Scheme e)108 336 R 4.273(xtensions. T)-.165 F 1.523 +(opics range from the architecture of Elk-based)-.88 F 1.538(applications and \ +the de\214nition of application-speci\214c Scheme types and primi-)108 351 R +(ti)108 366 Q -.165(ve)-.275 G 2.973(st).165 G 2.973(om)134.37 366 S .223 +(ore adv)151.401 366 R .223 +(anced subjects such as weak data structures and interacting with)-.275 F .626 +(the g)108 381 R .626(arbage collector)-.055 F 6.126(.M)-.605 G(an)219.493 381 +Q 3.376(ye)-.165 G .626(xamples throughout the te)243.307 381 R .627 +(xt illustrate the f)-.165 F(acilities)-.11 E +(and techniques discussed in this manual.)108 396 Q/F4 11/Times-Bold@0 SF 2.75 +(1. Additional)72 438 R(Documentation)2.75 E F2 1.614(The of)97 456.6 R 1.614 +(\214cial speci\214cation of the Scheme programming language is the `)-.275 F +(`R)-.814 E/F5 9/Times-Roman@0 SF(4)435.891 451.1 Q F2(RS')440.391 456.6 Q +4.363('\()-.814 G -.44(Wi)468.382 456.6 S(lliam).44 E 2.446 +(Clinger and Jonathan Rees \(editors\),)72 471.6 R F3(Re)5.197 E(vised)-.165 E +/F6 9/Times-Italic@0 SF(4)281.417 466.1 Q F3 2.447 +(Report on the Algorithmic Langua)291.114 471.6 R 2.667 -.11(ge S)-.11 H -.165 +(ch).11 G(eme).165 E F2(,)A 2.873(1991\). A)72 486.6 R .123 +(slightly modi\214ed v)2.873 F .123(ersion of an earlier re)-.165 F .123 +(vision of this report w)-.275 F .122(as adopted as an IEEE an)-.11 F .62 +(ANSI standard in 1990 \(IEEE)72 501.6 R -.917(Std 1178-1990,)1.833 F F3 .62 +(IEEE Standar)3.37 F 3.371(df)-.407 G .621(or the Sc)352.136 501.6 R .621 +(heme Pr)-.165 F -.11(og)-.495 G -.165(ra).11 G .621(mming Lan-).165 F(gua)72 +516.6 Q -.11(ge)-.11 G F2 2.75(,1).11 G(991\).)109.664 516.6 Q .244 +(The dialect of Scheme implemented by Elk \(a superset of the of)97 535.2 R +.243(\214cial language\) is described)-.275 F 1.066(in the)72 550.2 R F3(Refer) +3.816 E 1.066(ence Manual for the Elk Extension Langua)-.407 F 1.286 -.11(ge I) +-.11 H(nterpr).11 E(eter)-.407 E F2 1.066(that is included in the Elk)3.816 F +(distrib)72 565.2 Q .83(ution as trof)-.22 F 3.58(fs)-.275 G .829 +(ource and preformatted PostScript \214les.)165.966 565.2 R .829 +(Reference manuals for the v)6.329 F(arious)-.275 E 1.077(prede\214ned Elk e)72 +580.2 R 1.077(xtensions \(such as the UNIX and X11 e)-.165 F 1.077 +(xtensions\) are also part of the distrib)-.165 F(u-)-.22 E +(tion; see the \214le `)72 595.2 Q(`doc/README')-.814 E 2.75('f)-.814 G +(or an o)229.542 595.2 Q -.165(ve)-.165 G(rvie).165 E 2.75(wo)-.275 G 2.75(ft) +303.165 595.2 S(he a)312.636 595.2 Q -.275(va)-.22 G(ilable documentation.).275 +E 1.743(This manual supersedes the document)97 613.8 R F3 1.743(Interfacing Sc) +4.493 F 1.742(heme to the `)-.165 F 1.742(`Real W)-1.221 F(orld')-1.012 E(') +-1.221 E F2 1.742(that w)4.492 F(as)-.11 E(included in earlier v)72 628.8 Q +(ersions of Elk.)-.165 E 1.424 +(An article about Elk has appeared in USENIX Computing Systems in 1994 \(Oli)97 +647.4 R -.165(ve)-.275 G 4.175(rL).165 G(au-)489.953 647.4 Q .068 +(mann and Carsten Bormann, Elk: The Extension Language Kit,)72 662.4 R F3 .067 +(USENIX Computing Systems)2.817 F F2 2.817(,v)C(ol.)492.692 662.4 Q +(7, no. 4, pp. 419\255449\).)72 677.4 Q 3.508(Ar)97 696 S .758(ecent e)112.113 +696 R .758(xample of an application that uses Elk as its e)-.165 F .759 +(xtension language implementation)-.165 F .912(is freely a)72 711 R -.275(va) +-.22 G .911(ilable in source and binary form as).275 F F3(http://www)3.661 E +(.informatik.uni-br)-.814 E(emen.de/~net/unr)-.407 E(of)-.495 E(f)-.198 E F2(.) +A F3(unr)72 726 Q(of)-.495 E(f)-.198 E F2 3.382(is a programmable, e)6.132 F +3.383(xtensible trof)-.165 F 6.133(ft)-.275 G 3.383 +(ranslator with Scheme-based back-ends for the)280.89 726 R EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2-)278.837 51 S(Hyperte)72 87 Q 1.667 +(xt Markup Language.)-.165 F 1.667(The source code sho)7.167 F 1.666 +(wn in Appendix B has been directly tak)-.275 F(en)-.11 E 1.23(from the)72 102 +R/F1 11/Times-Italic@0 SF(unr)3.98 E(of)-.495 E(f)-.198 E F0 1.23(source; auth\ +ors of Elk-based applications are encourage to reuse this and other)3.98 F +(parts of the)72 117 Q F1(unr)2.75 E(of)-.495 E(f)-.198 E F0 +(source for their o)2.75 E(wn projects.)-.275 E/F2 11/Times-Bold@0 SF 2.75 +(2. Intr)72 147 R(oduction)-.198 E F0 .163(This manual can be roughly di)97 +165.6 R .163(vided into tw)-.275 F 2.913(op)-.11 G 2.913(arts. The)303.85 165.6 +R .162(\214rst part \(chapters)2.912 F 2.912(3t)2.75 G 2.75(o6)442.744 165.6 S +2.912(\)d)456.494 165.6 S(escribes)468.569 165.6 Q 1.606 +(the architectural aspects of Elk-based applications and Elk e)72 180.6 R 4.357 +(xtensions. F)-.165 F 1.607(acilities and tools for)-.165 F -.22(bu)72 195.6 S +.859(ilding e).22 F .859(xtensible applications with Elk are introduced here.) +-.165 F .858(Readers who are already f)6.359 F(amiliar)-.11 E .363 +(with the concepts e)72 210.6 R .363 +(xplained in this part of the document may w)-.165 F .364 +(ant to skip it and be)-.11 F .364(gin reading at)-.165 F(chapter 7)72 225.6 Q +.223(or later)2.973 F 5.722(.T)-.605 G .222(he second part \(co)161.867 225.6 R +-.165(ve)-.165 G .222(ring chapters).165 F 2.972(7t)2.75 G 2.75(o1)324.545 +225.6 S .222(2\) speci\214es the C functions and types)338.295 225.6 R -.22(av) +72 240.6 S 1.428 +(ailable to application programmers and describes techniques for b)-.055 F +1.428(uilding data structures that)-.22 F .001(can be interf)72 255.6 R .001 +(aced to Scheme in an ef)-.11 F .001(\214cient w)-.275 F(ay)-.11 E 5.5(.A)-.715 +G(ppendix C brie\215y summarizes all the functions,)295.319 255.6 Q +(macros, types, and v)72 270.6 Q(ariables e)-.275 E(xported by the Elk k)-.165 +E(ernel to the C/C++ programmer)-.11 E(.)-.605 E .594(Here is a short o)97 +289.2 R -.165(ve)-.165 G(rvie).165 E 3.344(wo)-.275 G 3.344(ft)215.14 289.2 S +.594(he remaining chapters of this manual.)225.205 289.2 R(Chapter 3)6.094 E +.594(discusses the)3.344 F 3.873(architecture of e)72 304.2 R 3.873 +(xtensible applications based on Elk and their relation to Elk e)-.165 F +(xtensions.)-.165 E(Chapter 4)72 319.2 Q(pro)2.991 E .241(vides an o)-.165 F +-.165(ve)-.165 G(rvie).165 E 2.991(wo)-.275 G 2.991(ft)220.969 319.2 S .241 +(he tw)230.681 319.2 R 2.991(ob)-.11 G .241(asic methods for inte)268.937 319.2 +R .241(grating an application \(or e)-.165 F(xten-)-.165 E .515 +(sions\) with Elk: dynamic loading and static linking.)72 334.2 R(Chapter 5) +6.015 E .515(describes use of dynamic loading)3.265 F 2.8 +(in more detail; topics include automatic e)72 349.2 R 2.801 +(xtension initialization and C++ static constructors)-.165 F 1.728 +(embedded in dynamically loaded modules.)72 364.2 R(Chapter 6)7.228 E 1.728 +(describes se)4.478 F -.165(ve)-.275 G 1.727(ral forms of linking user).165 F +(-)-.22 E 1.568(supplied code with Elk statically and ho)72 379.2 R 4.318(wt) +-.275 G 1.568(hese af)272.44 379.2 R 1.568 +(fect the structure of an application')-.275 F(s)-.605 E F1(main\(\))4.319 E F0 +(function.)72 394.2 Q .035(The remaining chapters are a complete speci\214cati\ +on of the functions and types of the C/C++)97 412.8 R(programmer')72 427.8 Q +4.166(si)-.605 G(nterf)140.934 427.8 Q 1.416(ace to Elk.)-.11 F(Chapter 7)6.917 +E(pro)4.167 E 1.417(vides introductory notes and advice for program-)-.165 F +1.57(mers of C/C++ code interf)72 442.8 R 1.569 +(acing to Elk \(use of include \214les, prede\214ned preprocessor symbols,)-.11 +F 2.947(etc.\). Chapter)72 457.8 R 2.947(8d)2.75 G .198 +(escribes the anatomy of Scheme objects from the C/C++ programmer')151.209 +457.8 R 2.948(sp)-.605 G .198(oint of)474.773 457.8 R(vie)72 472.8 Q 6.029 +-.715(w. C)-.275 H(hapter 9).715 E -.165(ex)4.599 G 1.849(plains ho).165 F +4.599(wa)-.275 G 1.849(pplications and e)219.415 472.8 R 1.849 +(xtensions can de\214ne ne)-.165 F 4.598(wS)-.275 G 1.848(cheme primiti)423.766 +472.8 R -.165(ve)-.275 G(s.).165 E(Chapter 10)72 487.8 Q 1.935 +(presents the standard, b)4.685 F 1.936 +(uilt-in Scheme types implemented by Elk \(numbers, pairs,)-.22 F -.165(ve)72 +502.8 S .451(ctors, etc.\) and functions for creating and accessing Scheme obj\ +ects of these types from within).165 F 2.562(C/C++ code.)72 517.8 R 2.562 +(The f)8.062 F 2.563(acilities for de\214ning ne)-.11 F 3.993 -.715(w, \214) +-.275 H 2.563(rst-class Scheme data types are described in).715 F(chapter 11.) +72 532.8 Q(Finally)6.448 E 3.698(,c)-.715 G(hapter 12)169.112 532.8 Q .948 +(deals with a number of more adv)3.698 F .947(anced topics, such as functions) +-.275 F .184(for interacting with the g)72 547.8 R .185(arbage collector)-.055 +F 2.935(,a)-.44 G .185 +(utomatic \214nalization of inaccessible objects, de\214nition)262.923 547.8 R +(of user)72 562.8 Q(-supplied reader functions, error handling, etc.)-.22 E +3.295(An)97 581.4 S .545(ote on the naming con)113.737 581.4 R -.165(ve)-.44 G +.545(ntions follo).165 F .544 +(wed by the C identi\214ers used throughout this docu-)-.275 F .382 +(ment: the names of all functions, macros, types, and v)72 596.4 R .382 +(ariables e)-.275 F .382(xported by Elk ha)-.165 F .712 -.165(ve t)-.22 H .382 +(heir compo-).165 F 1.405 +(nents separated by underscores and capitalized \(as in)72 611.4 R F1(Re)4.155 +E(gister_Object\(\))-.44 E F0 4.155(,f)C 1.405(or e)407.396 611.4 R 4.155 +(xample\). In)-.165 F(con-)4.155 E 1.304(trast, the names de\214ned by e)72 +626.4 R 1.305(xamples sho)-.165 F 1.305(wn in this manual only use lo)-.275 F +1.305(wer case letters, so that)-.275 F(the)72 641.4 Q 2.75(yc)-.165 G +(an be distinguished easily from prede\214ned functions e)98.411 641.4 Q +(xported by Elk.)-.165 E F2 2.75(3. The)72 671.4 R(Ar)2.75 E(chitectur)-.198 E +2.75(eo)-.198 G 2.75(fE)174.553 671.4 S(xtensible A)188.303 671.4 Q +(pplications)-.275 E F0 1.352(Extensible applications b)97 690 R 1.352 +(uilt with Elk are)-.22 F F1(hybrid)4.102 E F0 1.352(in that the)4.102 F 4.101 +(yc)-.165 G 1.351(onsist of code written in a)383.285 690 R .154 +(mixture of languages\212code written in the application')72 705 R(s)-.605 E F1 +.155(implementation langua)2.905 F -.11(ge)-.11 G F0 .155(\(C or C++\) and) +3.015 F 3.582(code written in the)72 720 R F1 -.22(ex)6.332 G 3.582 +(tension langua).22 F -.11(ge)-.11 G F0 6.332(\(Scheme\). An)6.442 F 3.581 +(application of this kind is usually)6.331 F EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3-)278.837 51 S 1.597(composed of tw)72 87 R +4.347(ol)-.11 G 1.597(ayers, a lo)158.257 87 R(w-le)-.275 E -.165(ve)-.275 G +4.347(lC).165 G 1.598(/C++ layer that pro)250.311 87 R 1.598 +(vides the basic, performance-critical)-.165 F .175 +(functionality of the application, and on top of that a higher)72 102 R(-le) +-.22 E -.165(ve)-.275 G 2.925(ll).165 G .175(ayer which is written in Scheme) +361.676 102 R(and interpreted at runtime.)72 117 Q .287(The Scheme-language po\ +rtion of an Elk-based application may range from just a fe)97 135.6 R 3.037(wd) +-.275 G(ozen)483.232 135.6 Q .214 +(lines of Scheme code \(if a simple form of customization is suf)72 150.6 R +.214(\214cient\) to \214fty percent of the appli-)-.275 F 1.13 +(cation or more \(if a high de)72 165.6 R 1.13(gree of e)-.165 F 1.13 +(xtensibility is required\).)-.165 F 1.13(As Scheme code is interpreted at)6.63 +F .285(runtime by an interpreter embedded in the application, users can custom\ +ize and modify the appli-)72 180.6 R(cation')72 195.6 Q 3.273(sS)-.605 G .524 +(cheme layer or add and test their o)115.61 195.6 R .524 +(wn Scheme procedures; recompilation, access to the)-.275 F 1.895 +(C/C++ source, or kno)72 210.6 R 1.894 +(wledge of the implementation language are not required.)-.275 F 1.894 +(Therefore, an)7.394 F .148(application can achie)72 225.6 R .478 -.165(ve h) +-.275 H .148(ighest e).165 F .149(xtensibility by restricting its lo)-.165 F +(w-le)-.275 E -.165(ve)-.275 G 2.899(lp).165 G .149 +(art to just a small core of)393.733 225.6 R(time-critical C/C++ code.)72 240.6 +Q 3.014 -.88(To e)97 259.2 T 1.254(nable e).88 F 1.254(xtensions to `)-.165 F +(`w)-.814 E 1.254(ork on')-.11 F 4.004('a)-.814 G 4.004(na)267.313 259.2 S +(pplication')281.701 259.2 Q 4.004(si)-.605 G 1.254 +(nternal data structures and state, the)340.1 259.2 R .329(application core e) +72 274.2 R .33(xports a set of ne)-.165 F 1.76 -.715(w, a)-.275 H .33 +(pplication-speci\214c Scheme data types and primiti).715 F -.165(ve)-.275 G +3.08(so).165 G(per)486.51 274.2 Q(-)-.22 E .321 +(ating on them to the Scheme layer)72 289.2 R 5.821(.T)-.605 G .321 +(hese types and primiti)238.928 289.2 R -.165(ve)-.275 G 3.071(sc).165 G .32 +(an be thought of as a `)358.924 289.2 R(`wrapper')-.814 E(')-.814 E .701 +(around some of the C/C++ types and functions used by the application')72 304.2 +R 3.452(sc)-.605 G 3.452(ore. F)405.688 304.2 R .702(or e)-.165 F .702 +(xample, the)-.165 F 2.027(core of an Elk-based ne)72 319.2 R 2.027 +(wsreader program w)-.275 F 2.027(ould e)-.11 F 2.026 +(xport \214rst-class Scheme types representing)-.165 F/F1 11/Times-Italic@0 SF +(ne)72 334.2 Q(wsgr)-.165 E(oups)-.495 E F0(,)A F1(subscriptions)4.124 E F0 +4.124(,a)C(nd)201.204 334.2 Q F1(ne)4.124 E 1.375(ws articles)-.165 F F0 4.125 +(;t)C 1.375(hese types w)285.529 334.2 R 1.375 +(ould encapsulate the corresponding)-.11 F(lo)72 349.2 Q(w-le)-.275 E -.165(ve) +-.275 G 3.85(lC).165 G -.814(``)-.001 G(structs').814 E 3.849('o)-.814 G 3.849 +(rC)178.962 349.2 S 1.099(++ classes.)193.811 349.2 R 1.099(In addition, it w) +6.599 F 1.099(ould e)-.11 F 1.099(xport a number of Scheme primi-)-.165 F(ti)72 +364.2 Q -.165(ve)-.275 G 3.446(st).165 G 3.446(oo)98.843 364.2 S .696 +(perate on these types\212to create members of them \(e.)113.289 364.2 R .697 +(g. by reading a ne)1.833 F .697(ws article from)-.275 F .004 +(disk\), to present them to the user through the application')72 379.2 R 2.753 +(su)-.605 G(ser)336.323 379.2 Q(-interf)-.22 E .003(ace, etc.)-.11 F .003 +(Each of these prim-)5.503 F(iti)72 394.2 Q -.165(ve)-.275 G 3.211(sw).165 G +.462(ould recur on one or more corresponding C or C++ functions implementing t\ +he function-)106.44 394.2 R(ality in an ef)72 409.2 Q(\214cient w)-.275 E(ay) +-.11 E(.)-.715 E 1.089(Another job of the lo)97 427.8 R(w-le)-.275 E -.165(ve) +-.275 G 3.839(lC).165 G 1.089 +(/C++ layer of an application is to hide platform-speci\214c or)237.074 427.8 R +1.572(system-speci\214c details by pro)72 442.8 R 1.572 +(viding suitable abstractions, so that the Scheme part can be k)-.165 F(ept) +-.11 E .978(portable and simple.)72 457.8 R -.165(Fo)6.478 G 3.728(re).165 G +.978(xample, in case of the ne)193.513 457.8 R .978(wsreader program, e)-.275 F +.978(xtension writers should)-.165 F .267(not ha)72 472.8 R .597 -.165(ve t) +-.22 H 3.017(oc).165 G .267(are about whether the ne)128.934 472.8 R .268 +(ws articles are stored in a local \214le system or retrie)-.275 F -.165(ve) +-.275 G 3.018(df).165 G(rom)486.279 472.8 Q 3.189(an)72 487.8 S(etw)85.573 +487.8 Q .439(ork serv)-.11 F(er)-.165 E 3.189(,o)-.44 G 3.188(ra)156.906 487.8 +S .438(bout the idiosyncrasies of the system')168.641 487.8 R 3.188(sn)-.605 G +(etw)349.095 487.8 Q .438(orking f)-.11 F 3.188(acilities. Most)-.11 F .438 +(of these)3.188 F .666 +(system-speci\214c details can be better dealt with in a language oriented to) +72 502.8 R -.11(wa)-.275 G .666(rds systems program-).11 F +(ming, such as C, than in Scheme.)72 517.8 Q 2.028 -.88(To d)97 536.4 T .268 +(ecide whether to mak).88 F 3.017(eaf)-.11 G .267(unction part of the lo) +231.409 536.4 R(w-le)-.275 E -.165(ve)-.275 G 3.017(lp).165 G .267 +(art of an application or to write)365.536 536.4 R(it in the e)72 551.4 Q +(xtension language, you may ask yourself the follo)-.165 E(wing questions:) +-.275 E<83>72 570 Q F1(Is the function performance-critical?)97 570 Q F0 .567 +(If the answer to this question is)97 588.6 R F1(yes)3.317 E F0 3.317(,p)C .568 +(ut the function into the C/C++ core.)266.822 588.6 R -.165(Fo)6.068 G 3.318 +(re).165 G .568(xample, in)456.99 588.6 R .021(case of the ne)97 603.6 R .021 +(wsreader application, a primiti)-.275 F .351 -.165(ve t)-.275 H 2.771(os).165 +G .02(earch all articles in a gi)319.764 603.6 R -.165(ve)-.275 G 2.77(nn).165 +G -.275(ew)445.911 603.6 S .02(sgroup for).275 F 2.818(ap)97 618.6 S .069 +(attern is certainly performance-critical and w)110.202 618.6 R .069 +(ould therefore be written in the implementa-)-.11 F .273(tion language, while\ + a function to ask the user to select an item from a list of ne)97 633.6 R .272 +(wsgroups is)-.275 F(not time-critical and could be written Scheme.)97 648.6 Q +<83>72 667.2 Q F1 +(Does the function have to deal with platform-speci\214c details?)97 667.2 Q F0 +-.165(Fo)97 685.8 S 3.061(re).165 G .311(xample, a function that needs to allo\ +cate and open a UNIX pseudo-tty or to establish a)119.894 685.8 R(netw)97 700.8 +Q 2.552 +(ork connection needs to care about numerous system-speci\214c details and dif) +-.11 F(ferent)-.275 E 1.394(kinds of operating system f)97 715.8 R 1.395 +(acilities and will therefore be written in C/C++ rather than in)-.11 F +(Scheme.)97 730.8 Q EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4-)278.837 51 S<83>72 87 Q/F1 11/Times-Italic@0 +SF(In whic)97 87 Q 2.75(hl)-.165 G(angua)140.835 87 Q .22 -.11(ge c)-.11 H +(an the function be e).11 E(xpr)-.22 E(essed mor)-.407 E 2.75(e`)-.407 G +(`natur)340.903 87 Q(ally')-.165 E('?)-1.221 E F0 3.556(Af)97 105.6 S .805 +(unction that parses and tok)112.161 105.6 R .805(enizes a string can be e)-.11 +F .805(xpressed more naturally \(that is, in a)-.165 F .742 +(signi\214cantly more concise and ef)97 120.6 R .743(\214cient w)-.275 F .743 +(ay\) in a language such as C than in Scheme.)-.11 F(On)6.243 E .295 +(the other hand, functions to construct trees of ne)97 135.6 R .294 +(ws articles, to tra)-.275 F -.165(ve)-.22 G .294(rse them, and to apply a).165 +F 2.353(function to each node are ob)97 150.6 R 2.353 +(vious candidates for writing them in a Lisp-lik)-.165 F 5.104(el)-.11 G +(anguage)467.348 150.6 Q(\(Scheme\).)97 165.6 Q<83>72 184.2 Q F1(Ar)97 184.2 Q +2.75(ec)-.407 G(ustomizability and e)120.111 184.2 Q(xtensibility important?) +-.22 E F0 1.2(If it is lik)97 202.8 R 1.2(ely that the application')-.11 F 3.95 +(su)-.605 G 1.2(sers will w)262.04 202.8 R 1.199 +(ant to customize or augment a function or)-.11 F -2.365 -.275(ev e)97 217.8 T +3.126(nr).275 G .376(eplace it with their o)124.117 217.8 R .376(wn v)-.275 F +.376(ersions, write it in the e)-.165 F .376(xtension language.)-.165 F .376 +(If, for some rea-)5.876 F .175 +(son, this is impossible or not practicable, at least pro)97 232.8 R .175 +(vide suitable `)-.165 F(`hooks')-.814 E 2.925('t)-.814 G .175 +(hat enable users)433.393 232.8 R(to in\215uence the function')97 247.8 Q 2.75 +(so)-.605 G(peration from within Scheme code.)219.826 247.8 Q/F2 11 +/Times-Bold@0 SF 2.75(3.1. Scheme)72 277.8 R(Extensions)2.75 E F0 .142 +(In addition to the Scheme interpreter component, Elk consists of a number of) +97 296.4 R F1(Sc)2.893 E .143(heme e)-.165 F(xten-)-.22 E(sions)72 311.4 Q F0 +5.888(.T)C .388(hese e)109.975 311.4 R .387(xtensions are not speci\214c to an) +-.165 F 3.137(yk)-.165 G .387(ind application and are therefore reusable.) +288.63 311.4 R(The)5.887 E(y)-.165 E(pro)72 326.4 Q 1.605(vide the `)-.165 F +(`glue')-.814 E 4.355('b)-.814 G 1.606(etween Scheme and a number of e)169.413 +326.4 R 1.606(xternal libraries, in particular the X11)-.165 F .605 +(libraries and the UNIX C library \(e)72 341.4 R .605 +(xceptions are the record e)-.165 F .604(xtension and the bitstring e)-.165 F +(xtension)-.165 E .198(which pro)72 356.4 R .198 +(vide a functionality of their o)-.165 F 2.948(wn\). The)-.275 F .199 +(purpose of these e)2.948 F .199(xtensions is to mak)-.165 F 2.949(et)-.11 G +.199(he func-)467.457 356.4 R 1.392(tionality of the e)72 371.4 R 1.392 +(xternal libraries \(for e)-.165 F 1.392(xample, the UNIX system calls\) a) +-.165 F -.275(va)-.22 G 1.392(ilable to Scheme as).275 F +(Scheme data types and primiti)72 386.4 Q -.165(ve)-.275 G 2.75(so).165 G +(perating on them.)227.683 386.4 Q .225(While the Scheme e)97 405 R .225 +(xtensions are useful for writing freestanding Scheme programs \(e.)-.165 F +.225(g. for)1.833 F .156 +(rapid prototyping of X11-based Scheme programs\), their main job is to help b) +72 420 R .156(uilding applications)-.22 F .84(that need to interf)72 435 R .84 +(ace to e)-.11 F .84(xternal libraries on the e)-.165 F .841 +(xtension language le)-.165 F -.165(ve)-.275 G 3.591(l. The).165 F .841(X11 e) +3.591 F(xtensions,)-.165 E .64(for instance, are intended to be used by applic\ +ations with a graphical user interf)72 450 R .639(ace based on the)-.11 F 3.042 +(Xw)72 465 S(indo)90.926 465 Q 3.042(ws)-.275 G 3.042(ystem. By)125.472 465 R +.292(linking the X11 e)3.042 F .293 +(xtensions \(in addition to the Scheme interpreter\) with an)-.165 F .575 +(Elk-based application, the application')72 480 R 3.325(su)-.605 G .574 +(ser interf)256.086 480 R .574(ace can be written entirely in Scheme and will) +-.11 F .642(therefore be inherently customizable and e)72 495 R 3.392 +(xtensible. As)-.165 F .642(the Scheme e)3.392 F .643 +(xtensions are reusable and)-.165 F .19(can be shared between applications, e) +72 510 R .19(xtension language code can be written in a portable manner)-.165 F +(.)-.605 E F2 2.75(3.2. A)72 540 R(pplications v)-.275 E(ersus Extensions)-.11 +E F0 1.17(As f)97 558.6 R 1.17(ar as the C/C++ programmer')-.11 F 3.92(si)-.605 +G(nterf)262.354 558.6 Q 1.17 +(ace to Elk \(that is, the subject of this manual\) is)-.11 F .673 +(concerned, there is not really a technical dif)72 573.6 R .673 +(ference between Scheme)-.275 F F1 -.22(ex)3.423 G(tensions).22 E F0 .673 +(on the one hand)3.423 F .373(\(such as the X11 e)72 588.6 R .373 +(xtensions\), and Elk-based, e)-.165 F(xtensible)-.165 E F1(applications)3.123 +E F0 .373(on the other hand.)3.123 F .373(Both are)5.873 F 1.287 +(composed of an ef)72 603.6 R 1.287(\214cient, lo)-.275 F(w-le)-.275 E -.165 +(ve)-.275 G 4.037(lC).165 G 1.287(/C++ core and, abo)243.028 603.6 R 1.617 +-.165(ve t)-.165 H 1.287(hat, a higher).165 F(-le)-.22 E -.165(ve)-.275 G 4.036 +(ll).165 G 1.286(ayer written in)437.276 603.6 R 4.551(Scheme. In)72 618.6 R +1.802(both cases, the C/C++ layer e)4.551 F 1.802 +(xports a set of Scheme types and primiti)-.165 F -.165(ve)-.275 G 4.552(st) +.165 G 4.552(ot)480.506 618.6 S(he)493.616 618.6 Q 1.315 +(Scheme layer \(that is, to the Scheme)72 633.6 R F1(pr)4.065 E -.11(og)-.495 G +-.165(ra).11 G(mmer).165 E F0 4.065(\)a)C 1.314 +(nd thus needs to interact with the Scheme)311.793 633.6 R(interpreter)72 648.6 +Q 7.841(.B)-.605 G 2.341(ecause of this analogy)135.138 648.6 R 5.091(,t)-.715 +G 2.341(he rest of the manual will mostly drop the distinction)249.794 648.6 R +(between applications and e)72 663.6 Q(xtensions and concentrate on the interf) +-.165 E(ace between C/C++ and Elk.)-.11 E .437(The only note)97 682.2 R -.11 +(wo)-.275 G(rth).11 E 3.187(yd)-.055 G(if)198.389 682.2 Q .436 +(ference between applications and e)-.275 F .436 +(xtensions is that the former tend)-.165 F .791(to ha)72 697.2 R 1.121 -.165 +(ve t)-.22 H .791(heir o).165 F(wn)-.275 E F1(main\(\))3.541 E F0 .791 +(function that g)3.541 F .791(ains control on startup, while Scheme e)-.055 F +.791(xtensions do not)-.165 F(ha)72 712.2 Q .372 -.165(ve a)-.22 H F1(main\(\)) +2.957 E F0 .042(entry point\212the)2.792 F 2.792(ya)-.165 G .041 +(re usually loaded into the interpreter \(or application\) during run-)220.435 +712.2 R 4.631(time. This)72 727.2 R 1.881 +(distinction will become important in the ne)4.631 F 1.882(xt chapter)-.165 F +4.632(,w)-.44 G 1.882(hen the dif)386.89 727.2 R 1.882(ferent w)-.275 F 1.882 +(ays of)-.11 F EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5-)278.837 51 S +(joining Elk and C/C++ code will be discussed.)72 87 Q/F1 11/Times-Bold@0 SF +2.75(4. Linking)72 117 R -.275(Ap)2.75 G(plications and Extensions with Elk) +.275 E F0 .407(There are tw)97 135.6 R 3.157(od)-.11 G(if)167.444 135.6 Q .407 +(ferent mechanisms for inte)-.275 F .407(grating compiled C/C++ code \(e)-.165 +F .407(xtensions or an)-.165 F .718(application\) with Elk:)72 150.6 R/F2 11 +/Times-Italic@0 SF .718(static linking)3.468 F F0(and)3.468 E F2 .718 +(dynamic loading)3.468 F F0 6.218(.T)C .719(he object \214les that mak)343.57 +150.6 R 3.469(eu)-.11 G 3.469(pa)462.236 150.6 S 3.469(nE)476.089 150.6 S(lk-) +491.779 150.6 Q .977(based application are usually link)72 165.6 R .976 +(ed statically with the Scheme interpreter in the normal w)-.11 F .976(ay to) +-.11 F .042(produce an e)72 180.6 R -.165(xe)-.165 G .043(cutable program.).165 +F .043(Compiled e)5.543 F .043 +(xtensions, on the other hand, are usually dynamically)-.165 F .205 +(loaded into the running Scheme interpreter as the)72 195.6 R 2.955(ya)-.165 G +.205(re needed.)303.21 195.6 R .205(These con)5.705 F -.165(ve)-.44 G .204 +(ntions re\215ect the nor).165 F(-)-.22 E(mal case; Scheme e)72 210.6 Q +(xtensions may as well be link)-.165 E(ed statically with the interpreter)-.11 +E 21.15<8374>72 229.2 S 5.741(op)100.058 229.2 S 2.991(roduce a `)116.799 229.2 +R(`specialized')-.814 E 5.741('i)-.814 G 2.991 +(nstance of the interpreter \(for e)233.792 229.2 R 2.991(xample, when de)-.165 +F -.165(ve)-.275 G(loping).165 E .174(X11-based Scheme code, an e)97 244.2 R +.174(xtended v)-.165 F .173 +(ersion of the interpreter may be produced by linking)-.165 F +(it statically with the X11 e)97 259.2 Q(xtensions\);)-.165 E 21.15<8369>72 +277.8 S 4.261(fap)100.058 277.8 S 1.511(articular e)122.627 277.8 R 1.511 +(xtension is required by an application from the be)-.165 F 1.512 +(ginning \(an application)-.165 F .586(with an X-based user)97 292.8 R(-interf) +-.22 E .586(ace w)-.11 F .586(ould be link)-.11 F .585(ed with the X11 e)-.11 F +.585(xtensions statically)-.165 F 3.335(,a)-.715 G 3.335(sl)473.781 292.8 S +(oad-)484.453 292.8 Q(ing on-demand w)97 307.8 Q +(ould not be useful in this case\);)-.11 E 21.15<836f>72 326.4 S 3.646(nt)102.5 +326.4 S .896(he \(fe)114.704 326.4 R .896 +(w\) platforms where dynamic loading is not supported or where dynamic loading) +-.275 F(has a lar)97 341.4 Q(ge performance o)-.198 E -.165(ve)-.165 G(rhead.) +.165 E(Lik)97 360 Q -.275(ew)-.11 G 1.386(ise, dynamic loading is not only use\ +ful for on-demand loading of reusable Scheme).275 F -.165(ex)72 375 S +(tensions;).165 E F2(applications)4.517 E F0 1.767(can bene\214t from this f) +4.517 F 1.767(acility as well.)-.11 F 3.527 -.88(To r)7.267 H 1.767 +(educe the size of the \214nal).88 F -.165(exe)72 390 S .068 +(cutable, parts of an application may loaded dynamically rather than link).165 +F .067(ed statically if the)-.11 F 2.817(ya)-.165 G(re)495.453 390 Q .084 +(used infrequently or if only a fe)72 405 R 2.835(wo)-.275 G 2.835(ft)227.812 +405 S .085(hem are used at a time.)237.368 405 R .085 +(Dynamic loading enables the author)5.585 F 1.354(of an e)72 420 R 1.354 +(xtensible application to decompose it into an arbitrary number of indi)-.165 F +1.353(vidual parts as an)-.275 F(alternati)72 435 Q .778 -.165(ve t)-.275 H +3.198(oc).165 G .448(ombining them statically into a lar)137.829 435 R .448 +(ge, monolithic e)-.198 F -.165(xe)-.165 G 3.198(cutable. An).165 F -.165(ex) +3.198 G .448(tensible ne).165 F(ws-)-.275 E .933(reader program, for e)72 450 R +.932(xample, may include a separate spelling check module that is dynamically) +-.165 F(loaded the \214rst time it is needed \(i.)72 465 Q(e. when a ne)1.833 E +(wly written ne)-.275 E(ws article is to be spell-check)-.275 E(ed\).)-.11 E +.14(The capability to dynamically load compiled C/C++ code into a running appl\ +ication enables)97 483.6 R 1.404(users to write)72 498.6 R F2 1.404(hybrid e) +4.154 F(xtensions)-.22 E F0 1.403(which consist of a lo)4.154 F(w-le)-.275 E +-.165(ve)-.275 G 4.153(lC).165 G 1.403(/C++ part and a high-le)361.289 498.6 R +-.165(ve)-.275 G 4.153(lp).165 G(art)492.395 498.6 Q .297(written in Scheme.)72 +513.6 R .297(As a result, e)5.797 F .297(xtensions can e)-.165 F -.165(xe)-.165 +G .298(cute much f).165 F .298(aster \(e)-.11 F .298 +(xtensions to the Emacs edi-)-.165 F(tor)72 528.6 Q 3.461(,f)-.44 G .711(or e) +93.655 528.6 R .71 +(xample, must be entirely written in Emacs-Lisp and can therefore become slo) +-.165 F 3.46(wi)-.275 G 3.46(fs)473.931 528.6 S(uf)485.333 528.6 Q<8c2d>-.275 E +(ciently comple)72 543.6 Q(x\); and e)-.165 E +(xtensions can deal more easily with lo)-.165 E(w-le)-.275 E -.165(ve)-.275 G +(l, platform-speci\214c details.).165 E F1 2.75(5. Dynamic)72 573.6 R(Loading) +2.75 E F0 .808 +(Object \214les \(compiled C/C++ code\) are loaded by means of the standard)97 +592.2 R F2(load)3.558 E F0(primiti)3.558 E 1.138 -.165(ve o)-.275 H(f).165 E +.521(Scheme, just lik)72 607.2 R 3.271(eo)-.11 G .521(rdinary Scheme \214les.) +157.174 607.2 R .52(All you need to do is to compile your C or C++ source)6.021 +F .858(\214le, apply the)72 622.2 R F2(mak)3.608 E(edl)-.11 E F0 .858 +(script that comes with the Elk distrib)3.608 F .859 +(ution to the resulting object \214le, and)-.22 F .01 +(load it into the interpreter or application.)72 637.2 R F2(mak)5.509 E(edl) +-.11 E F0 .009(prepares object \214les for dynamic loading \(which)2.759 F +1.515(is a no-op on most platforms\) and combines se)72 652.2 R -.165(ve)-.275 +G 1.516(ral object \214les into one to speed up loading;).165 F(ar)72 667.2 Q +.584(guments are the output \214le and one or more input \214les or additional\ + libraries \(input and output)-.198 F(\214le may be identical\):)72 681.2 Q EP +%%Page: 6 6 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6-)278.837 51 S/F1 10/Courier-Bold@0 SF(%)100.346 +86 Q/F2 10/Courier@0 SF(cc \255c \255I/usr/elk/include file.c)6 E F1(%)100.346 +100 Q F2(/usr/elk/lib/makedl file.o file.o)6 E F1(%)100.346 114 Q F2(scheme)6 E +F1(>)100.346 128 Q F2(\(load 'file.o\))6 E F1(>)100.346 142 Q F0 1.571 +(\(This e)72 164.5 R 1.571(xamples assumes that Elk has been installed under `) +-.165 F(`/usr/elk')-.814 E 4.321('o)-.814 G 4.321(ny)397.536 164.5 S 1.571 +(our site.)412.857 164.5 R(Additional)7.072 E(ar)72 179.5 Q +(guments may be required for the call to)-.198 E/F3 11/Times-Italic@0 SF(cc) +2.75 E F0(.\))A .676(Elk does not attempt to discriminate object code and Sche\ +me code based on the \214les' con-)97 198.1 R .346 +(tents; the names of object \214les are required to end in `)72 213.1 R(`.o') +-.814 E .347(', the standard suf)-.814 F .347(\214x for object modules)-.275 F +.464(in UNIX.)72 228.1 R .463(Scheme \214les, on the other hand, end in `)5.964 +F(`.scm')-.814 E 3.213('b)-.814 G 3.213(yc)339.424 228.1 S(on)353.021 228.1 Q +-.165(ve)-.44 G 3.213(ntion. This).165 F(con)3.213 E -.165(ve)-.44 G .463 +(ntion is not).165 F .397(enforced by Elk\212e)72 243.1 R -.165(ve)-.275 G .398 +(rything that is not an object \214le is considered to be a Scheme \214le.).165 +F 3.148(Al)5.898 G .398(ist of)481.294 243.1 R .182 +(object \214les may be passed to the)72 258.1 R F3(load)2.931 E F0(primiti) +2.931 E .511 -.165(ve w)-.275 H .181(hich may sa).165 F .511 -.165(ve t)-.22 H +.181(ime on platforms where a call to).165 F(the system link)72 273.1 Q +(er is in)-.11 E -.22(vo)-.44 G(lv).22 E(ed.)-.165 E .942 +(Loading object \214les directly as sho)97 291.7 R .942(wn abo)-.275 F 1.272 +-.165(ve i)-.165 H 3.692(su).165 G 3.692(ncommon. Instead,)318.409 291.7 R .942 +(the Scheme part of a)3.692 F -.055(hy)72 306.7 S 2.765(brid e).055 F 2.765(xt\ +ension usually loads its corresponding object \214le \(and all the other \214l\ +es that are)-.165 F(required\) automatically)72 320.7 Q 2.75(,s)-.715 G 2.75 +(ot)184.013 320.7 S(hat one can write, for e)195.321 320.7 Q(xample,)-.165 E F2 +(\(require 'unix\))100.346 343.203 Q F0 1.102(to load the UNIX e)72 365.703 R +3.852(xtension. This)-.165 F -.165(ex)3.852 G 1.102(pression causes the \214le) +.165 F F3(unix.scm)3.852 E F0 1.102(to be loaded, which then)3.852 F 2.593 +(loads the object \214le)72 380.703 R F3(unix.o)5.343 E F0 2.592 +(\212the UNIX e)B(xtension')-.165 E 5.342(sl)-.605 G -.275(ow)318.519 380.703 S +(-le).275 E -.165(ve)-.275 G 5.342(lp).165 G 2.592 +(art\212automatically on startup.)367.135 380.703 R(Additional)72 395.703 Q F3 +(load-libr)3.291 E(aries)-.165 E F0 .541(\(as e)3.291 F .541 +(xplained in the ne)-.165 F .541 +(xt section\) may be set by the Scheme \214le imme-)-.165 F +(diately before loading the e)72 410.703 Q(xtension')-.165 E 2.75(so)-.605 G +(bject \214le.)245.063 410.703 Q 2.662 +(When an object \214le is loaded, unresolv)97 429.303 R 2.662 +(ed references are resolv)-.165 F 2.662(ed ag)-.165 F 2.662(ainst the symbols) +-.055 F -.165(ex)72 444.303 S 1.323(ported by the running interpreter or by th\ +e combination of an application and the interpreter).165 F(\(the)72 459.303 Q +F3 .022(base pr)2.772 F -.11(og)-.495 G -.165(ra).11 G(m).165 E F0 2.772 +(\). This)B .022(is an essential feature, as dynamically loaded e)2.772 F .021 +(xtensions must be able to)-.165 F .254 +(reference the elementary Scheme primiti)72 474.303 R -.165(ve)-.275 G 3.004 +(sd).165 G .255(e\214ned by the interpreter core and all the other func-) +274.746 474.303 R 2.674(tions that are a)72 489.303 R -.275(va)-.22 G 2.674 +(ilable to the e).275 F 2.674(xtension/application programmer)-.165 F 8.174(.I) +-.605 G 5.423(na)384.804 489.303 S 2.673(ddition, references are)400.611 +489.303 R(resolv)72 504.303 Q .152(ed ag)-.165 F .152(ainst the symbols e)-.055 +F .152(xported by all pre)-.165 F .152(viously loaded object \214les.)-.275 F +.152(The term)5.652 F F3(incr)2.903 E(emental)-.407 E(loading)72 519.303 Q F0 +.326(is used for this style of dynamic loading, as it allo)3.077 F .326(ws b) +-.275 F .326(uilding comple)-.22 F 3.076(xa)-.165 G .326(pplications from) +431.261 519.303 R(small components incrementally)72 534.303 Q(.)-.715 E/F4 11 +/Times-Bold@0 SF 2.75(5.1. Load)72 564.303 R(Libraries)2.75 E F0 2.474 +(Dynamically loadable object \214les usually ha)97 582.903 R 2.804 -.165(ve u) +-.22 H(nresolv).165 E 2.474(ed references into one or more)-.165 F .748 +(libraries, most lik)72 597.903 R .748 +(ely at least into the standard C library)-.11 F 6.248(.T)-.715 G .747 +(herefore, when loading an object \214le,)336.22 597.903 R .686 +(references are resolv)72 612.903 R .686(ed not only ag)-.165 F .687 +(ainst the base program and pre)-.055 F .687(viously loaded object \214les, b) +-.275 F(ut)-.22 E 1.004(also ag)72 627.903 R 1.003(ainst a number of user)-.055 +F(-supplied)-.22 E F3 1.003(load libr)3.753 F(aries)-.165 E F0 6.503(.T)C 1.003 +(he X11 e)327.064 627.903 R 1.003(xtensions of Elk, for instance,)-.165 F 1.411 +(need to be link)72 642.903 R 1.411(ed ag)-.11 F 1.411(ainst the respecti)-.055 +F 1.741 -.165(ve l)-.275 H 1.411(ibraries of the X windo).165 F 4.161(ws)-.275 +G 1.412(ystem, such as)383.776 642.903 R F3(libX11)4.162 E F0(and)4.162 E F3 +(libXt)72 657.903 Q F0 6.012(.T)C .511 +(hese load libraries can be assigned to the Scheme v)108.878 657.903 R(ariable) +-.275 E F3(load-libr)3.261 E(aries)-.165 E F0 .511(which is bound)3.261 F 1.564 +(in the top-le)72 672.903 R -.165(ve)-.275 G 4.314(le).165 G -.44(nv)150.491 +672.903 S 1.564(ironment of Elk.).44 F -.88(Ty)7.064 G(pically).88 E(,)-.715 E +F3(load-libr)4.314 E(aries)-.165 E F0 1.565(is dynamically assigned a set of) +4.314 F .014(library names by means of)72 687.903 R F3(\215uid-let)2.764 E F0 +.014(immediately before calling)2.764 F F3(load)2.764 E F0 5.514(.F)C .014 +(or e)383.605 687.903 R .014(xample, the Xlib e)-.165 F(xten-)-.165 E(sion \() +72 701.903 Q F3(xlib)A(.scm)-.44 E F0 2.75(\)c)C(ontains code such as)143.962 +701.903 Q EP +%%Page: 7 7 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-7-)278.837 51 S/F1 10/Courier@0 SF(\(fluid-let) +100.346 86 Q(\(\(load-libraries)112.346 100 Q +(\(string-append "\255L/usr/X11/lib \255lX11 " load-libraries\)\)\))130.346 114 +Q(\(load 'xlib.o\)\))112.346 128 Q F0 .591(to load the accompan)72 150.5 R .591 +(ying object \214le \()-.165 F/F2 11/Times-Italic@0 SF(xlib)A(.o)-.44 E F0 .592 +(\), linking it ag)B .592(ainst the system')-.055 F 3.342(sXl)-.605 G .592 +(ibrary in addition)426.432 150.5 R 1.881(to whate)72 165.5 R -.165(ve)-.275 G +4.63(rl).165 G 1.88(ibraries were already in use at that point.)132.752 165.5 R +1.88(The def)7.38 F 1.88(ault v)-.11 F 1.88(alue of)-.275 F F2(load-libr)4.63 E +(aries)-.165 E F0(is)4.63 E -.814(``)72 180.5 S(\255lc').814 E 3.036('\()-.814 +G -.917(i. e.)105.869 180.5 R .286(the C library\), as e)3.036 F .286 +(xtensions are lik)-.165 F .286 +(ely to use functions from this library in addition to)-.11 F .286 +(those C library functions that ha)72 195.5 R .616 -.165(ve a)-.22 H .286 +(lready been link).165 F .286(ed into the base program or ha)-.11 F .615 -.165 +(ve b)-.22 H .285(een pulled).165 F .642(in by pre)72 210.5 R .642 +(viously loaded object \214les.)-.275 F .642(By using)6.142 F F2(string-append) +3.393 E F0 .643(in the e)3.393 F .643(xample abo)-.165 F -.165(ve)-.165 G 3.393 +(,t).165 G .643(he speci\214ed)451.118 210.5 R .174 +(libraries are added to the def)72 225.5 R .174(ault v)-.11 F .174(alue of) +-.275 F F2(load-libr)2.924 E(aries)-.165 E F0 .173(rather than o)2.924 F -.165 +(ve)-.165 G .173(rwriting it.).165 F .173(The e)5.673 F .173(xact syn-)-.165 F +.177(tax of the load libraries is platform speci\214c.)72 240.5 R -.165(Fo) +5.677 G 2.927(ri).165 G .177(nstance, `)291.877 240.5 R(`\255L/usr/X11/lib') +-.814 E 2.927('a)-.814 G 2.928(su)417.477 240.5 S .178(sed abo)430.184 240.5 R +.508 -.165(ve i)-.165 H 2.928(sr).165 G(ec-)490.569 240.5 Q 1.064 +(ognized by the system link)72 255.5 R 1.064(er of most UNIX v)-.11 F 1.064 +(ariants as an option indicating in which directory)-.275 F .416 +(the libraries reside on the system, b)72 270.5 R .416(ut dif)-.22 F .417 +(ferent options or additional libraries are required on cer)-.275 F(-)-.22 E +(tain platforms \(as speci\214ed by the platform')72 285.5 Q 2.75(s`)-.605 G +(`con\214g/site')274.356 285.5 Q 2.75<278c>-.814 G(le in the Elk distrib) +339.234 285.5 Q(ution\).)-.22 E/F3 11/Times-Bold@0 SF 2.75(5.2. Extension)72 +315.5 R(Initializers and Finalizers)2.75 E F0 .07 +(When loading an object \214le, Elk scans the \214le')97 334.1 R 2.82(ss)-.605 +G .07(ymbol table for the names of e)313.947 334.1 R .07(xtension ini-)-.165 F +2.171(tialization functions or)72 349.1 R F2 -.22(ex)4.921 G 2.172 +(tension initializer).22 F F0 4.922(s. These)B -.165(ex)4.922 G 2.172 +(tension initializers are the initial entry).165 F 1.224(points to the ne)72 +364.1 R 1.223(wly loaded e)-.275 F 1.223(xtension; their names must ha)-.165 F +1.553 -.165(ve t)-.22 H 1.223(he pre\214x `).165 F(`elk_init_')-.814 E 3.973 +('\()-.814 G 1.223(earlier the)458.491 364.1 R .592(pre\214x `)72 379.1 R +(`init_')-.814 E 3.342('w)-.814 G .592(as used; it w)145.377 379.1 R .592 +(as changed in Elk 3.0 to a)-.11 F -.22(vo)-.22 G .593(id name con\215icts\).) +.22 F .593(Each e)6.093 F .593(xtension ini-)-.165 F .672 +(tializer found in the object \214le is in)72 394.1 R -.22(vo)-.44 G -.11(ke) +.22 G 3.422(dt).11 G 3.421(op)263.595 394.1 S .671(ass control to the e)278.016 +394.1 R 3.421(xtension. The)-.165 F .671(job of the e)3.421 F(xten-)-.165 E +.925(sion initializers is to re)72 409.1 R .925 +(gister the Scheme types and primiti)-.165 F -.165(ve)-.275 G 3.675(sd).165 G +.926(e\214ned by the e)359.297 409.1 R .926(xtension with the)-.165 F +(interpreter and to perform an)72 424.1 Q 2.75(yd)-.165 G +(ynamic initializations.)212.657 424.1 Q .731(As each e)97 442.7 R .731 +(xtension may ha)-.165 F 1.06 -.165(ve a)-.22 H 3.48(na).165 G .73 +(rbitrary number of initialization functions rather than one)246.847 442.7 R +.58(single function with a \214x)72 457.7 R .58(ed name, e)-.165 F .581 +(xtension writers can di)-.165 F .581(vide their e)-.275 F .581 +(xtensions into a number of)-.165 F .265 +(independent modules, each of which pro)72 472.7 R .265(vides its o)-.165 F +.265(wn initialization function.)-.275 F .264(The compiled mod-)5.764 F .93(ul\ +es can then be combined into one dynamically loadable object \214le without ha) +72 487.7 R .93(ving to lump all)-.22 F +(initializations into a central initialization function.)72 502.7 Q .164 +(In the same manner)97 521.3 R 2.914(,e)-.44 G .163 +(xtension can de\214ne an arbitrary number of)193.884 521.3 R F2 -.22(ex)2.913 +G .163(tension \214nalization func-).22 F(tions)72 536.3 Q F0 1.617 +(which are called on termination of the Scheme interpreter or application.) +4.366 F 1.617(The names of)7.117 F .299(\214nalization functions be)72 551.3 R +.299(gin with `)-.165 F(`elk_\214nit_')-.814 E 3.049('. Extension)-.814 F .299 +(\214nalization functions are typically used)3.049 F +(for clean-up operations such as remo)72 566.3 Q(ving temporary \214les.)-.165 +E(The e)97 584.9 Q(xtension initializers \(as well as the \214nalizers\) are c\ +alled in an unspeci\214ed order)-.165 E(.)-.605 E F3 2.75(5.3. C++)72 614.9 R +(Static Constructors and Destructors)2.75 E F0 .633(In addition to calling e)97 +633.5 R .633(xtension initialization functions, the)-.165 F F2(load)3.384 E F0 +(primiti)3.384 E -.165(ve)-.275 G 3.384(si).165 G -2.09 -.44(nv o)436.094 633.5 +T -.11(ke).44 G 3.384(sa).11 G .634(ll C++)474.755 633.5 R .836(static constru\ +ctors that are present in the dynamically loaded object \214le in case it cont\ +ains com-)72 648.5 R 1.096(piled C++ code.)72 663.5 R(Lik)6.596 E -.275(ew)-.11 +G 1.096(ise, C++ static destructors are called automatically on termination.) +.275 F(The)6.597 E 1.051 +(constructors and destructors are called in an unspeci\214ed order)72 678.5 R +3.801(,b)-.44 G 1.051(ut all constructors \(destructors\))363.677 678.5 R .642 +(are called before calling an)72 693.5 R 3.392(ye)-.165 G .642 +(xtension initializers \(\214nalizers\).)207.133 693.5 R .643 +(Elk recognizes the function name)6.142 F(pre\214x)72 708.5 Q 1.338(es of stat\ +ic constructor and destructor functions used by all major UNIX C++ compilers;) +-.165 F(ne)72 723.5 Q 2.75(wp)-.275 G(re\214x)98.301 723.5 Q +(es can be added if required.)-.165 E EP +%%Page: 8 8 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-8-)278.837 51 S/F1 11/Times-Bold@0 SF 2.75 +(6. Static)72 87 R(Linking)2.75 E F0 1.864(Linking user)97 105.6 R 1.865 +(-supplied code with Elk statically can be used as an alternati)-.22 F 2.195 +-.165(ve t)-.275 H 4.615(od).165 G(ynamic)471.616 105.6 Q .845 +(loading on platforms that do not support it, for applications with their o)72 +120.6 R(wn)-.275 E/F2 11/Times-Italic@0 SF(main\(\))3.594 E F0 3.594(,a)C .844 +(nd to a)453.252 120.6 R -.22(vo)-.22 G(id).22 E .437(the o)72 135.6 R -.165 +(ve)-.165 G .437(rhead of loading frequently used Elk e).165 F 3.187 +(xtensions. Dynamic)-.165 F .438(loading and static linking may)3.187 F .287(b\ +e used in combination\212 additional object \214les can be loaded in a running\ + e)72 150.6 R -.165(xe)-.165 G .287(cutable formed by).165 F +(linking the Scheme interpreter with e)72 165.6 Q +(xtensions or with an application \(or parts thereof\).)-.165 E .823 +(When making the Scheme interpreter component of Elk, these e)97 184.2 R -.165 +(xe)-.165 G .824(cutables and object \214les).165 F(get installed \(relati)72 +199.2 Q .33 -.165(ve t)-.275 H 2.75(oy).165 G(our)183.991 199.2 Q F2 +(install_dir)2.75 E F0(which usually is `)2.75 E(`/usr/elk')-.814 E 2.75('o) +-.814 G 2.75(r`)378.526 199.2 S(`/usr/local/elk')387.788 199.2 Q('\):)-.814 E +F2(bin/sc)97 217.8 Q(heme)-.165 E F0 +(The freestanding, plain Scheme interpreter)122 232.8 Q(.)-.605 E F2 +(lib/standalone)97 251.4 Q(.o)-.165 E F0 1.847 +(The Scheme interpreter as a relocatable object \214le which can be link)122 +266.4 R 1.846(ed with user)-.11 F(-)-.22 E .009 +(supplied object \214les to form an e)122 281.4 R -.165(xe)-.165 G 2.76 +(cutable. This).165 F .01(object \214le contains a)2.76 F F2(main\(\))2.76 E F0 +(function;)2.76 E 2.84(thus the Scheme interpreter starts up in the normal w) +122 296.4 R 2.84(ay when the e)-.11 F -.165(xe)-.165 G 2.839(cutable is).165 F +(in)122 311.4 Q -.22(vo)-.44 G -.11(ke).22 G(d.).11 E F2(lib/module)97 330 Q +(.o)-.165 E F0(Lik)122 345 Q(e)-.11 E F2(standalone)3.341 E(.o)-.165 E F0 3.341 +(,e)C .592(xcept that the object \214le does not e)212.568 345 R .592 +(xport its o)-.165 F(wn)-.275 E F2(main\(\))3.342 E F0(function.)3.342 E +(Therefore, the object \214les link)122 360 Q(ed with it ha)-.11 E .33 -.165 +(ve t)-.22 H 2.75(os).165 G(upply a)337.809 360 Q F2(main\(\))2.75 E F0(.)A +1.234(The object \214le)97 378.6 R F2(standalone)3.984 E(.o)-.165 E F0 1.234 +(is typically link)3.984 F 1.234(ed with a number of Elk e)-.11 F 1.233 +(xtensions \(e.)-.165 F 1.233(g. the)1.833 F 1.392(X11 e)72 393.6 R 1.392 +(xtensions\), while)-.165 F F2(module)4.142 E(.o)-.165 E F0 1.392 +(is used by Elk-based applications which contrib)4.142 F 1.393(ute their o)-.22 +F(wn)-.275 E F2(main\(\))72 408.6 Q F0(and need to be `)2.75 E(`in control') +-.814 E 2.75('o)-.814 G 2.75(ns)234.415 408.6 S(tartup.)246.944 408.6 Q F1 2.75 +(6.1. Linking)72 438.6 R(the Scheme Inter)2.75 E(pr)-.11 E +(eter with Extensions)-.198 E F0 3.545(As)97 457.2 S .795(hell script)112.766 +457.2 R F2(linksc)3.544 E(heme)-.165 E F0 .794(\(installed as `)3.544 F +(`lib/linkscheme')-.814 E .794('\) simpli\214es combining the Scheme)-.814 F +1.271(interpreter with a number of\212user)72 472.2 R 1.271 +(-supplied or prede\214ned\212e)-.22 F 1.271(xtensions statically)-.165 F 6.772 +(.T)-.715 G 1.272(his script is)451.34 472.2 R .91 +(called with the name of the output \214le \(the resulting e)72 487.2 R -.165 +(xe)-.165 G .91(cutable\) and an).165 F 3.66(yn)-.165 G .91 +(umber of object \214les)410.531 487.2 R .193(and libraries.)72 502.2 R .194 +(It basically links the object \214les and libraries with `)5.693 F +(`standalone.o')-.814 E 2.944('a)-.814 G .194(nd supplies an)435.335 502.2 R(y) +-.165 E 1.128(additional libraries that may be required by the interpreter)72 +517.2 R 6.628(.I)-.605 G 3.878(ng)348.242 517.2 S 1.128 +(eneral, this can be done just as)363.12 517.2 R 1.026 +(well by calling the link)72 532.2 R 1.026(er or compiler directly)-.11 F 3.776 +(,b)-.715 G(ut)290.275 532.2 Q F2(linksc)3.777 E(heme)-.165 E F0 1.027 +(also tak)3.777 F 1.027(es care of additional pro-)-.11 F(cessing that needs t\ +o be performed on at least one platform \(currently AIX\).)72 547.2 Q 2.286 +-.88(To c)97 565.8 T .526 +(reate an instance of Elk including the Xlib, Xt, and Xa).88 F 3.275(we)-.165 G +(xtensions,)377.044 565.8 Q F2(linksc)3.275 E(heme)-.165 E F0 -.11(wo)3.275 G +(uld).11 E(be used as follo)72 579.8 Q(ws \(ag)-.275 E(ain assuming you ha) +-.055 E .33 -.165(ve i)-.22 H(nstalled the softw).165 E(are under `)-.11 E +(`/usr/elk')-.814 E('\):)-.814 E/F3 10/Courier-Bold@0 SF(%)100.346 602.303 Q/F4 +10/Courier@0 SF(cd /usr/elk)6 E F3(%)100.346 616.303 Q F4 +(lib/linkscheme x11scheme runtime/obj/xlib.o runtime/obj/xt.o \\)6 E(runtime/o\ +bj/xaw/*.o \255lXaw \255lXmu \255lXt \255lSM \255lICE \255lX11 \255lXext) +130.346 630.303 Q F0 1.459(The e)97 656.403 R 1.46 +(xact form of the libraries depends on your platform and X11 v)-.165 F 1.46 +(ersion; for e)-.165 F(xample,)-.165 E 1.813(additional options may be require\ +d if X11 is not installed in a standard location at your site.)72 671.403 R F2 +(xlib)72 686.403 Q(.o)-.44 E F0 1.332(is the Xlib e)4.082 F(xtension,)-.165 E +F2(xt.o)4.082 E F0 1.332(is the X toolkit intrinsics \(Xt\) e)4.082 F 1.333 +(xtension, and the subdirectory)-.165 F F2(xaw)72 701.403 Q F0 .165 +(holds the object \214les for all the Athena widgets.)2.915 F .165(The e)5.665 +F -.165(xe)-.165 G(cutable).165 E F2(x11sc)2.915 E(heme)-.165 E F0 .164(can no) +2.915 F 2.914(wb)-.275 G 2.914(eu)476.039 701.403 S(sed)489.337 701.403 Q .223 +(to run arbitrary X11 applications using the Athena widgets without requiring \ +an)72 716.403 R 2.974(yr)-.165 G .224(untime loading)437.468 716.403 R +(of object \214les belonging to the X11 e)72 730.403 Q(xtensions:)-.165 E EP +%%Page: 9 9 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-9-)278.837 50 S/F1 10/Courier-Bold@0 SF(%)100.346 +86 Q/F2 10/Courier@0 SF(x11scheme)6 E F1(>)100.346 100 Q F2 +(\(load '../examples/xaw/dialog.scm\))6 E([Autoloading xwidgets.scm])100.346 +114 Q([Autoloading xt.scm])100.346 128 Q([Autoloading siteinfo.scm])100.346 142 +Q(...)100.346 156 Q F0 .383(In the same w)97 182.1 R(ay)-.11 E(,)-.715 E/F3 11 +/Times-Italic@0 SF(linksc)3.133 E(heme)-.165 E F0 .383 +(can be used to link the Scheme interpreter with an)3.133 F 3.133(yn)-.165 G +-.275(ew)464.513 182.1 S 3.132(,u)-.44 G(ser)487.731 182.1 Q(-)-.22 E +(supplied e)72 197.1 Q +(xtensions, with parts of an Elk-based application, or with an)-.165 E 2.75(yc) +-.165 G(ombination thereof.)393.992 197.1 Q/F4 11/Times-Bold@0 SF 2.75 +(6.1.1. A)72 227.1 R(utomatic Extension Initialization)-.55 E F0 .553 +(When linking Elk with e)97 245.7 R .553(xtensions, it is)-.165 F F3(not)3.303 +E F0 .553(necessary to add calls to the e)3.303 F .553(xtension initializ-) +-.165 F 1.12(ers to the Scheme interpreter')72 260.7 R(s)-.605 E F3(main\(\)) +3.87 E F0 1.12(function and recompile the interpreter; all e)3.87 F 1.12 +(xtensions are)-.165 F .146(initialized automatically on startup.)72 275.7 R +1.906 -.88(To a)5.646 H .147 +(ccomplish this kind of automatic initialization, Elk scans).88 F .546(its o)72 +290.7 R .546(wn symbol table on startup, in)-.275 F -.22(vo)-.44 G .546 +(king an).22 F 3.295(y`)-.165 G(`elk_init_')281.924 290.7 Q 3.295('f)-.814 G +.545(unctions and C++ static constructors,)338.173 290.7 R 1.144(in the same w) +72 305.7 R 1.144(ay the symbol table of object \214les is scanned when the)-.11 +F 3.895(ya)-.165 G 1.145(re dynamically loaded.)401.203 305.7 R .206 +(Extension \214nalizers and C++ static destructors are sa)72 320.7 R -.165(ve) +-.22 G 2.955(df).165 G .205(or calling on e)328.845 320.7 R 2.955 +(xit. Automatic)-.165 F -.165(ex)2.955 G(tension).165 E(initialization only w) +72 335.7 Q(orks if)-.11 E 21.15<8374>97 354.3 S(he e)125.058 354.3 Q -.165(xe) +-.165 G(cutable \214le has a symbol table \(i.).165 E +(e. you must not strip it\))1.833 E 21.15<8374>97 372.9 S(he e)125.058 372.9 Q +-.165(xe)-.165 G(cutable \214le can be opened for reading).165 E 21.15<8374>97 +391.5 S 1.465(he interpreter can locate its e)125.058 391.5 R -.165(xe)-.165 G +1.465(cutable \214le by scanning the shell').165 F 4.215(sd)-.605 G 1.466 +(irectory search)437.48 391.5 R(path.)122 406.5 Q 1.12(The performance o)97 +425.1 R -.165(ve)-.165 G 1.12 +(rhead caused by the initial scanning of the symbol is small; the pro-).165 F +(gram')72 440.1 Q 3.378(ss)-.605 G .628 +(ymbol table can be read or mapped into memory ef)109.599 440.1 R .628 +(\214ciently \(it it has not been automati-)-.275 F(cally mapped into the addr\ +ess space by the operating system in the \214rst place\).)72 455.1 Q F4 2.75 +(6.2. Linking)72 485.1 R(the Scheme Inter)2.75 E(pr)-.11 E(eter with an A)-.198 +E(pplication)-.275 E F0 1.446(Elk-based applications that ha)97 503.7 R 1.776 +-.165(ve t)-.22 H 1.446(heir o).165 F(wn)-.275 E F3(main\(\))4.196 E F0 1.445 +(are link)4.196 F 1.445(ed with the Scheme interpreter)-.11 F .821 +(installed as)72 518.7 R F3(module)3.571 E(.o)-.165 E F0 .821(which, unlik) +3.571 F(e)-.11 E F3(standalone)3.571 E(.o)-.165 E F0 3.571(,d)C .821(oes not e) +301.975 518.7 R .822(xport a)-.165 F F3(main\(\))3.572 E F0 3.572(function. No) +3.572 F(special)3.572 E F3(linksc)72 533.7 Q(heme)-.165 E F0 4.075 +(script is required to link with)6.825 F F3(module)6.824 E(.o)-.165 E F0 6.824 +(;a)C 4.074(pplication writers usually will add)337.378 533.7 R -.814(``)72 +548.7 S(/usr/elk/lib/module.o').814 E 3.547('\()-.814 G .797(or whate)184.216 +548.7 R -.165(ve)-.275 G 3.547(rt).165 G .798 +(he correct path is\) to the list of object \214les in their Mak)243.406 548.7 +R(e-)-.11 E 5.535(\214le. T)72 563.7 R 5.535(os)-.88 G 2.785 +(implify linking with Elk, a tri)118.248 563.7 R 2.785(vial script)-.275 F F3 +(ld\215a)5.535 E(gs)-.11 E F0 2.785(\(which li)5.535 F -.165(ve)-.275 G 5.535 +(si).165 G 5.535(n`)413.255 563.7 S(`lib')427.139 563.7 Q 5.535('a)-.814 G +2.785(long with)459.349 563.7 R F3(linksc)72 578.7 Q(heme)-.165 E F0 4.415(\)i) +C 4.415(ss)131.844 578.7 S 1.665(upplied that just echoes an)144.817 578.7 R +4.415(ya)-.165 G 1.665(dditional libraries required by the Scheme inter)282.821 +578.7 R(-)-.22 E(preter)72 593.7 Q 5.5(.A)-.605 G(pplication de)113.239 593.7 Q +-.165(ve)-.275 G(lopers may use).165 E F3(ld\215a)2.75 E(gs)-.11 E F0 +(in their Mak)2.75 E(e\214les.)-.11 E(As)97 612.3 Q F3(module)3.665 E(.o)-.165 +E F0 .915(does not ha)3.665 F 1.245 -.165(ve a)-.22 H F3(main\(\))3.83 E F0 +.914(entry point, an application using it must initialize the)3.665 F +(interpreter from within its o)72 626.3 Q(wn)-.275 E F3(main\(\))2.75 E F0 5.5 +(.T)C(his is done by calling .)254.424 626.3 Q F3(Elk_Init\(\))5.5 E F0(:)A F2 +(void Elk_Init\(int argc, char **argv, int init_flag, char *filename\);)100.346 +648.803 Q F3(Elk_Init\(\))97 674.903 Q F0 1.178(is only de\214ned by)3.927 F F3 +(module)3.928 E(.o)-.165 E F0 1.178(and is essentially a `)3.928 F(`wrapper') +-.814 E 3.928('a)-.814 G 1.178(round the Scheme)422.213 674.903 R(interpreter') +72 689.903 Q(s)-.605 E F3(main\(\))4.135 E F0(.)A F3(ar)6.885 E(gc)-.407 E F0 +(and)4.135 E F3(ar)4.134 E(gv)-.407 E F0 1.384(are the ar)4.134 F 1.384 +(guments to be passed to the Scheme interpreter')-.198 F(s)-.605 E F3(main\(\)) +72 704.903 Q F0 6.999(.T)C 1.499(hese may or may not be the calling program') +117.796 704.903 R 4.249(so)-.605 G 1.499(riginal ar)340.562 704.903 R 1.5 +(guments; ho)-.198 F(we)-.275 E -.165(ve)-.275 G -.44(r,).165 G F3(ar)4.69 E +(gv[0])-.407 E F0 .044(must be that from the calling program in an)72 719.903 R +2.794(yc)-.165 G .044(ase \(because its address is used by Elk to determine) +276.622 719.903 R .466(the program')72 734.903 R 3.216(ss)-.605 G .466 +(tack base\).)140.758 734.903 R(If)5.966 E F3(init_\215a)3.216 E(g)-.11 E F0 +.466(is nonzero, the interpreter scans its symbol table to in)3.216 F -.22(vo) +-.44 G -.11(ke).22 G EP +%%Page: 10 10 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(0-)288 51 S -.165(ex)72 87 S +1.012(tension initializers as described in 6.1.1.).165 F 1.012 +(C++ static constructors, ho)6.512 F(we)-.275 E -.165(ve)-.275 G 1.891 -.44 +(r, a).165 H 1.011(re ne).44 F -.165(ve)-.275 G 3.761(ri).165 G -2.09 -.44 +(nv o)472.386 87 T -.11(ke).44 G(d).11 E(by)72 102 Q/F1 11/Times-Italic@0 SF +(module)3.11 E(.o)-.165 E F0(\(re)3.11 E -.055(ga)-.165 G .36(rless of).055 F +F1(init_\215a)3.11 E(g)-.11 E F0 .36(\), because the)B 3.111(ya)-.165 G .361 +(re already tak)298.393 102 R .361(en care of by the runtime startup)-.11 F +(in this case.)72 117 Q(If)5.5 E F1(\214lename)2.75 E F0 +(is nonzero, it is the name of Scheme \214le to be loaded by)2.75 E F1 +(Elk_Init\(\))2.75 E F0(.)A/F2 11/Times-Bold@0 SF 2.75(6.2.1. An)72 147 R +(Example `)2.75 E(`main\(\)')-.693 E 2.75('F)-.693 G(unction)217.266 147 Q F0 +.225(Figure 1 sho)97 165.6 R .224(ws a realistic \(yet some)-.275 F .224 +(what simpli\214ed\) e)-.275 F(xample)-.165 E F1(main\(\))2.974 E F0 .224 +(function of an applica-)2.974 F(tion using Elk.)72 180.6 Q(__________________\ +____________________________________________________________)75 208.1 Q/F3 10 +/Courier@0 SF(char *directory;)72 227.6 Q(int main\(int ac, char **av\) {)72 +250 Q(char **eav;)97 264 Q(int eac = 1, c;)97 278 Q(Set_App_Name\(av[0]\);)97 +300.4 Q(eav = safe_malloc\(\(ac+2+1\) * sizeof\(char *\)\);)97 314.4 Q +(/* ac + -p xxx + 0 */)391 314.4 Q(eav[0] = av[0];)97 328.4 Q +(while \(\(c = getopt\(ac, av, "gh:o"\)\) != EOF\) switch \(c\) {)97 342.4 Q +(case 'o':)122 356.4 Q/F4 10/Times-Italic@0 SF(pr)147 370.4 Q(ocess option...) +-.45 E F3(case 'g':)122 384.4 Q(eav[eac++] = "-g"; break;)147 398.4 Q +(case 'h':)122 412.4 Q(eav[eac++] = "-h"; eav[eac++] = optarg; break;)147 426.4 +Q(case '?':)122 440.4 Q(usage\(\); return 1;)147 454.4 Q(})97 468.4 Q +(if \(\(directory = getenv\("APP_DIR"\)\) == 0\))97 482.4 Q +(directory = DEFAULT_DIR;)122 496.4 Q(eav[eac++] = "-p";)97 510.4 Q +(eav[eac] = safe_malloc\(strlen\(directory\) + 11\);)97 524.4 Q +(sprintf\(eav[eac++], ".:%s/elk/scm", directory\);)97 538.4 Q(eav[eac] = 0;)97 +552.4 Q(Elk_Init\(eac, eav, 0, 0\);)97 566.4 Q F4(initialize application')97 +588.8 Q 2.5(sm)-.4 G(odules...)196.61 588.8 Q F3(boot_code\(\);)97 611.2 Q F4 +(application')97 633.6 Q 2.5(sm)-.4 G(ain loop \(if written in C\))159.1 633.6 +Q F3(...)97 647.6 Q/F5 10/Times-Bold@0 SF(Figur)152.97 665.4 Q 2.5(e1)-.18 G(:) +188.62 665.4 Q/F6 10/Times-Roman@0 SF(Example)5 E F4(main\(\))2.5 E F6 +(of an Elk-based application \(simpli\214ed\))2.5 E F0(_______________________\ +_______________________________________________________)75 684 Q 2.011 +(The code sho)97 717.6 R 2.011(wn in the e)-.275 F 2.011 +(xample must construct a ne)-.165 F 4.762(wa)-.275 G -.198(rg)359.575 717.6 S +2.012(ument v).198 F 2.012(ector to be passed to)-.165 F F1(Elk_Init\(\))72 +732.6 Q F0 3.079(,b)C .328 +(ecause the application has command line options of its o)126.097 732.6 R .328 +(wn \(just)-.275 F F13.078 E F0 .328(in the e)3.078 F(xample\).)-.165 E +EP +%%Page: 11 11 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(1-)288 51 S -1.1 -.88(Tw o)72 +87 T .223(Elk-options \()3.853 F/F1 11/Times-Italic@0 SFA F0(and)2.973 E +F12.973 E F0 2.973(\)a)C .223(re handed to)211.319 87 R F1(Elk_Init\(\)) +2.973 E F0 .224(if present, so that a mixture of Elk-speci\214c)2.973 F .384 +(and application-speci\214c options can be gi)72 102 R -.165(ve)-.275 G 3.134 +(n\().165 G .384(see the manual page for the Scheme interpreter for)278.552 102 +R .873(the meaning of Elk')72 117 R 3.623(so)-.605 G 3.623(ptions\). \()175.097 +117 R F1(safe_malloc\(\))A F0 .874(is assumed to be a wrapper around)3.623 F F1 +(malloc\(\))3.624 E F0(with)3.624 E .497(proper error)72 132 R(-checking.\)) +-.22 E F1(Set_App_Name\(\))5.997 E F0 .497(is pro)3.247 F .496 +(vided by Elk and is called with a name to be dis-)-.165 F +(played in front of f)72 147 Q(atal error messages by the interpreter)-.11 E(.) +-.605 E .604(When all the options ha)97 165.6 R .934 -.165(ve b)-.22 H .604 +(een parsed, an additional option).165 F F13.354 E F0 .605 +(is synthesized to pro)3.354 F .605(vide a)-.165 F .262(minimal initial)72 +180.6 R F1(load-path)3.012 E F0 .262(for Elk.)3.012 F .261 +(This load-path consists of the current directory and a subdirec-)5.762 F .541 +(tory of the directory under which the application e)72 195.6 R .542 +(xpects its \214les that are needed during runtime.)-.165 F .746(An en)72 210.6 +R .746(vironment v)-.44 F .746(ariable can be used to set this directory)-.275 +F 6.246(.D)-.715 G .746(e\214ning a load-path lik)345.649 210.6 R 3.495(et)-.11 +G .745(his has the)456.068 210.6 R .273 +(bene\214t that a minimal, self-contained Elk runtime en)72 225.6 R .273 +(vironment \(e.)-.44 F .274(g. a tople)1.833 F -.165(ve)-.275 G 3.024(la).165 G +.274(nd the deb)429.136 225.6 R(ugger\))-.22 E .764 +(can be shipped with binary distrib)72 240.6 R .763 +(utions of the application so that users are not required to ha)-.22 F -.165 +(ve)-.22 G(Elk installed at their sites.)72 255.6 Q 1.742 +(When Elk has been initialized by calling)97 274.2 R F1(Elk_Init\(\))4.492 E F0 +4.492(,t)C 1.743(he application may initialize all its)343.432 274.2 R .217 +(other modules and \214nally load an initial Scheme \214le that `)72 289.2 R +(`boots')-.814 E 2.966('t)-.814 G .216(he Scheme part of the applica-)368.819 +289.2 R .114(tion \(which may in)72 304.2 R -.22(vo)-.44 G(lv).22 E 2.864(el) +-.165 G .114(oading further Scheme \214les\).)185.294 304.2 R .114 +(This initial Scheme \214le may be quite sim-)5.614 F .591 +(ple and just de\214ne a fe)72 319.2 R 3.341(wf)-.275 G .59 +(unctions used later)188.912 319.2 R 3.34(,o)-.44 G 3.34(ri)283.731 319.2 S +3.34(tm)293.792 319.2 S .59(ain contain the application')308.748 319.2 R 3.34 +(se)-.605 G .59(ntire `)442.481 319.2 R(`dri)-.814 E(ving)-.275 E(logic')72 +334.2 Q 3.649('o)-.814 G 3.649(ri)109.661 334.2 S(nteracti)120.031 334.2 Q +1.229 -.165(ve u)-.275 H(ser).165 E(-interf)-.22 E 3.649(ace. This)-.11 F .899 +(is accomplished by a function)3.649 F F1(boot_code\(\))3.649 E F0 .899 +(which may)3.649 F(as simple as this:)72 348.2 Q/F2 10/Courier@0 SF +(void boot_code\(void\) {)100.346 370.703 Q +(char *fn = safe_malloc\(strlen\(directory\) + 30\);)127.846 384.703 Q +(sprintf\(fn, "%s/scm/app.scm", directory\);)127.846 407.103 Q +(Set_Error_Tag\("initial load"\);)127.846 421.103 Q(Load_File\(fn\);)127.846 +435.103 Q(free\(fn\);)127.846 449.103 Q(})100.346 463.103 Q F1(Load_F)97 +489.203 Q(ile\(\))-.495 E F0 .175(is de\214ned by Elk and loads a Scheme \214l\ +e whose name is supplied as a C string.)2.925 F F1(Set_Err)72 504.203 Q(or_T) +-.495 E -.11(ag)-1.012 G(\(\)).11 E F0 .78(may be used by e)3.53 F .78 +(xtensions and applications to de\214ne the symbol that is passed)-.165 F .97 +(as the \214rst ar)72 519.203 R .97(gument to the standard error handler when \ +a Scheme error is signaled \(see section)-.198 F(12.5\).)72 534.203 Q/F3 11 +/Times-Bold@0 SF 2.75(6.3. Who)72 564.203 R(is in Contr)2.75 E(ol?)-.198 E F0 +.742(When an application')97 582.803 R 3.493(so)-.605 G .743 +(bject \214les are loaded into the interpreter dynamically or are link)205.851 +582.803 R(ed)-.11 E 1.024(with the interpreter using)72 597.803 R F1(linksc) +3.774 E(heme)-.165 E F0 3.774(,c)C 1.024 +(ontrol initially rests in the interpreter)249.864 597.803 R 6.523(.I)-.605 G +3.773(nc)429.552 597.803 S 1.023(ontrast, when)443.709 597.803 R .155 +(the application is link)72 612.803 R .155(ed using)-.11 F F1(module)2.905 E +(.o)-.165 E F0(and)2.905 E F1(Elk_Init\(\))2.905 E F0 .155(as sho)2.905 F .155 +(wn in the pre)-.275 F .156(vious section, it de\214nes)-.275 F(its o)72 +627.803 Q(wn)-.275 E F1(main\(\))2.75 E F0 +(function, and hence the application is `)2.75 E(`in control')-.814 E 2.75('o) +-.814 G 2.75(ns)369.495 627.803 S(tartup.)382.024 627.803 Q .378 +(From a technical point of vie)97 646.403 R 1.808 -.715(w, i)-.275 H 3.128(td) +.715 G .377(oes not really mak)253.866 646.403 R 3.127(ead)-.11 G(if)357.369 +646.403 Q .377(ference whether control rests in)-.275 F .31 +(the interpreter or in the application initially)72 661.403 R 5.81(.I)-.715 G +3.061(nt)275.404 661.403 S .311(he \214rst case, the main `)287.023 661.403 R +(`dri)-.814 E .311(ving logic')-.275 F 3.061('\()-.814 G .311(or `)463.264 +661.403 R(`main)-.814 E(loop')72 676.403 Q .919 +('\) of the application can simply be wrapped in a Scheme primiti)-.814 F 1.249 +-.165(ve w)-.275 H .919(hich is then called by).165 F .933(the Scheme tople)72 +691.403 R -.165(ve)-.275 G 3.683(lo).165 G 3.683(ns)171.819 691.403 S .934 +(tartup to pass control back to the application, if this is desired.)185.281 +691.403 R .934(In an)6.434 F(y)-.165 E .998(case, control usually changes freq\ +uently between the Scheme interpreter and the actual applica-)72 706.403 R +1.021(tion an)72 721.403 R(yw)-.165 E 1.021(ay\212the Scheme interpreter in) +-.11 F -.22(vo)-.44 G -.11(ke).22 G 3.772(sc).11 G 1.022 +(allback functions or Scheme primiti)285.325 721.403 R -.165(ve)-.275 G 3.772 +(sp).165 G(ro)470.56 721.403 Q(vided)-.165 E EP +%%Page: 12 12 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(2-)288 51 S .259 +(by the application, which may in turn in)72 87 R -.22(vo)-.44 G .478 -.11 +(ke S).22 H .258(cheme procedures or load Scheme \214les, and so on.).11 F +1.251(The Tcl-lik)97 105.6 R 4.002(es)-.11 G 1.252 +(tyle of use, where control rests in the C-part of the application most of the) +161.103 105.6 R .4(time, and where this C code `)72 120.6 R .399(`calls out') +-.814 F 3.149('t)-.814 G 3.149(ot)256.564 120.6 S .399 +(he interpreter occasionally by passing it an e)268.271 120.6 R(xtension)-.165 +E .286(language e)72 135.6 R .286 +(xpression or a small script, is not typical for Elk.)-.165 F .287 +(It is supported, though; Elk pro)5.787 F(vides)-.165 E 3.929(as)72 150.6 S +1.179(imple e)85.092 150.6 R 1.179(xtension to pass a Scheme e)-.165 F 1.179 +(xpression to the interpreter as a C string and recei)-.165 F 1.508 -.165(ve t) +-.275 H(he).165 E 1.168(result in the same form, similar to what)72 165.6 R/F1 +11/Times-Italic@0 SF(Tcl_Eval\(\))3.918 E F0 1.169 +(does in Tcl \(see section 12.2\).)3.918 F 1.169(In a typical)6.669 F 1.491 +(Elk-based application the e)72 180.6 R 1.49(xtension language serv)-.165 F +1.49(es as the `)-.165 F(`backbone')-.814 E 4.24('o)-.814 G 4.24(ft)408.791 +180.6 S 1.49(he application: the)419.752 180.6 R(application')72 195.6 Q 3.051 +(sd)-.605 G(ri)136.772 195.6 Q .302(ving logic or main loop is written entirel\ +y in Scheme, and this Scheme code calls)-.275 F .802(out to the application')72 +210.6 R 3.552(sCl)-.605 G(ayer)192.435 210.6 Q 3.552(,u)-.44 G .802 +(sing the data types, primiti)222.728 210.6 R -.165(ve)-.275 G .802 +(s, and other callbacks e).165 F .802(xported to)-.165 F .092(the e)72 225.6 R +.093(xtension language by the application.)-.165 F -.44(Wi)5.593 G .093 +(th the help of the X11 e).44 F .093(xtensions, the entire \(graph-)-.165 F +.697(ical\) user interf)72 240.6 R .697(ace of an application can be written i\ +n Scheme easily; control can then passed to)-.11 F .171(the application')72 +255.6 R 2.921(sC)-.605 G .172(/C++ layer whene)154.842 255.6 R -.165(ve)-.275 G +2.922(ra).165 G 2.922(nX)255.601 255.6 S 2.922(tc)271.965 255.6 S .172 +(allback is triggered.)282.829 255.6 R .172(In this case, the application') +5.672 F(s)-.605 E -.814(``)72 270.6 S 1.094(main loop').814 F 3.844('c)-.814 G +1.094(onsists of a call to the Scheme primiti)139.154 270.6 R 1.424 -.165(ve c) +-.275 H 1.094(orresponding to the X toolkit function).165 F F1 +(XtAppMainLoop\(\))72 285.6 Q F0(\(the main e)2.75 E -.165(ve)-.275 G +(nt dispatch loop\).).165 E/F2 11/Times-Bold@0 SF 2.75(7. Notes)72 315.6 R +-.275(fo)2.75 G 2.75(rW).275 G(riting C/C++ Code Using Elk)142.29 315.6 Q F0 +.704(This chapter describes general con)97 334.2 R -.165(ve)-.44 G .704 +(ntions and usage notes for Elk-based C/C++ code and).165 F(introduces a fe)72 +349.2 Q 2.75(wu)-.275 G(seful f)152.674 349.2 Q +(acilities that are not directly related to Scheme.)-.11 E F2 2.75(7.1. Elk)72 +379.2 R(Include Files)2.75 E F0(Ev)97 397.8 Q .855 +(ery C or C++ \214le using functions, macros, or v)-.165 F .854 +(ariables de\214ned by Elk must include the)-.275 F(\214le)72 411.8 Q F1(sc) +2.75 E(heme)-.165 E(.h)-.165 E F0(:)A/F3 10/Courier@0 SF(#include ) +100.346 434.303 Q/F4 10/Times-Roman@0 SF(or:)250.346 434.303 Q F3 +(#include "scheme.h")297.456 434.303 Q F0 2.231 +(This include \214le resides in a subdirectory)97 460.403 R F1(include)4.981 E +F0 2.232(of the directory where Elk has been)4.981 F 1.372 +(installed on your system.)72 475.403 R -1.21(Yo)6.872 G 4.122(um)1.21 G 1.372 +(ust insert a suitable \255I option into your Mak)223.401 475.403 R 1.372 +(e\214les to add this)-.11 F .15(directory to the C compiler')72 490.403 R 2.9 +(ss)-.605 G .15(earch path.)206.268 490.403 R -.814(``)5.65 G(scheme.h').814 E +2.9('i)-.814 G .15(ncludes se)320.546 490.403 R -.165(ve)-.275 G .15 +(ral other Elk-speci\214c include).165 F 3.063(\214les from the same directory\ + and, in addition, the standard C include \214les)72 505.403 R F1() +5.812 E F0(and)5.812 E F1()72 520.403 Q F0(.)A F2 2.75(7.2. Standard) +72 550.403 R 2.75(Ca)2.75 G(nd Function Pr)156.953 550.403 Q(ototypes)-.198 E +F0 .866(All the e)97 569.003 R .866(xamples sho)-.165 F .866 +(wn in this manual are written in ANSI/ISO C.)-.275 F .866 +(This assumes that the)6.366 F .9(Elk include \214les ha)72 584.003 R 1.229 +-.165(ve b)-.22 H .899(een installed with function prototypes enabled.).165 F +.899(Whether or not function)6.399 F .809(prototypes are enabled is controlled\ + by a de\214nition in the platform- and compiler)72 599.003 R .81 +(-speci\214c `)-.22 F(`con-)-.814 E(\214g/system')72 614.003 Q 4.381<278c>-.814 +G 1.631(le that has been selected for con\214guring Elk.)134.241 614.003 R(Ho) +7.131 E(we)-.275 E -.165(ve)-.275 G 2.511 -.44(r, i).165 H 4.381(ft).44 G 1.631 +(he include \214les ha)409.37 614.003 R -.165(ve)-.22 G .485(function prototyp\ +es disabled, prototypes are enable automatically if you are compiling your cod\ +e)72 629.003 R 1.196(with a C compiler that de\214nes the symbol `)72 644.003 R +-1.834(`_ _STDC_ _')-.814 F 3.945('a)-.814 G 3.945(sn)341.752 644.003 S 1.195 +(on-zero, or with a C++ compiler)355.476 644.003 R(that de\214nes `)72 659.003 +Q -1.834(`_ _cplusplus')-.814 F(')-.814 E/F5 9/Times-Roman@0 SF(1)-3.6 I F0(.) +3.6 I .36 LW 76.5 681.2 72 681.2 DL 81 681.2 76.5 681.2 DL 85.5 681.2 81 681.2 +DL 90 681.2 85.5 681.2 DL 94.5 681.2 90 681.2 DL 99 681.2 94.5 681.2 DL 103.5 +681.2 99 681.2 DL 108 681.2 103.5 681.2 DL 112.5 681.2 108 681.2 DL 117 681.2 +112.5 681.2 DL 121.5 681.2 117 681.2 DL 126 681.2 121.5 681.2 DL 130.5 681.2 +126 681.2 DL 135 681.2 130.5 681.2 DL 139.5 681.2 135 681.2 DL 144 681.2 139.5 +681.2 DL/F6 7/Times-Roman@0 SF(1)82 691.2 Q F5 .654 +(Although the public include \214les pro)4.5 2.8 N .654 +(vided by Elk can be used by C++ code, Elk itself cannot be com-)-.135 F +(piled with a C++ compiler)72 705 Q 4.5(.T)-.495 G +(he interpreter has been written in C to maximize portability)178.902 705 Q(.) +-.585 E EP +%%Page: 13 13 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(3-)288 51 S 2.125 +(Elk include \214les that ha)97 87 R 2.455 -.165(ve b)-.22 H 2.125 +(een installed with function prototypes disabled can also be).165 F -.814(``)72 +102 S(upgraded').814 E 5.017('b)-.814 G 5.017(yd)136.472 102 S 2.267 +(e\214ning the symbol `)152.489 102 R(`W)-.814 E(ANT_PR)-1.32 E -2.068 -.44 +(OT OT)-.44 H(YPES').44 E 5.017('b)-.814 G 2.267(efore including `)372.801 102 +R(`scheme.h')-.814 E('.)-.814 E(Similarly)72 117 Q 4.683(,i)-.715 G 1.932(nclu\ +de \214les installed without function prototypes can be used with a non-ANSI C) +122.729 117 R(compiler by de\214ning the symbol `)72 132 Q(`NO_PR)-.814 E +-2.068 -.44(OT OT)-.44 H(YPES').44 E 2.75('b)-.814 G(efore including `)328.564 +132 Q(`scheme.h')-.814 E('.)-.814 E/F1 11/Times-Bold@0 SF 2.75(7.3. Exter)72 +162 R(nal Symbols De\214ned by Elk)-.165 E F0 .583(As e)97 180.6 R .584 +(xtensions or applications are link)-.165 F .584(ed with Elk \(re)-.11 F -.055 +(ga)-.165 G .584(rless of whether dynamic loading or).055 F 1.461 +(static linking is used\), the)72 195.6 R 4.211(yc)-.165 G 1.461 +(an in general reference all e)205.024 195.6 R 1.46(xternal symbols e)-.165 F +1.46(xported by Elk.)-.165 F(Of)6.96 E .328 +(these, only the symbols described in this manual may be used safely)72 210.6 R +5.828(.U)-.715 G .328(se of other \(pri)391.434 210.6 R -.275(va)-.275 G .328 +(te\) sym-).275 F 1.945(bols results in non-portable code, as the symbols may \ +change their meaning or may e)72 225.6 R -.165(ve)-.275 G 4.694(nb).165 G(e) +499.116 225.6 Q(remo)72 240.6 Q -.165(ve)-.165 G 5.22(df).165 G 2.47 +(rom future releases of Elk.)119.042 240.6 R 2.47 +(The same restriction applies to the macros and types)7.97 F +(de\214ned by the include \214les of Elk.)72 255.6 Q .133 +(In addition to the symbols de\214ned by the Scheme interpreter k)97 274.2 R +.133(ernel, those e)-.11 F .132(xported by other)-.165 F 1.061(Scheme e)72 +289.2 R 1.061(xtensions that are present in the same e)-.165 F -.165(xe)-.165 G +1.062(cutable \(or ha).165 F 1.392 -.165(ve b)-.22 H 1.062 +(een loaded earlier\) can be).165 F .261(referenced from within C/C++ code.)72 +304.2 R .261(These e)5.761 F .26 +(xtensions are not subject of this manual; you should)-.165 F +(refer to the rele)72 319.2 Q -.275(va)-.275 G +(nt documentation and the public include \214les that are part of the e).275 E +(xtensions.)-.165 E .809(If Elk is link)97 337.8 R .809 +(ed with an application that has its o)-.11 F(wn)-.275 E/F2 11/Times-Italic@0 +SF(main\(\))3.559 E F0 .81(function, none of the functions)3.559 F -.165(ex)72 +352.8 S(ported by Elk must be used before the initial call to).165 E F2 +(Elk_Init\(\))2.75 E F0(\(e)2.75 E(xcept)-.165 E F2(Set_App_Name\(\))2.75 E F0 +(\).)A F1 2.75(7.4. Calling)72 382.8 R(Scheme Primiti)2.75 E -.11(ve)-.11 G(s) +.11 E F0 4.266(Al)97 401.4 S(ar)112.266 401.4 Q 1.515 +(ge subset of the symbols e)-.198 F 1.515 +(xported by the Scheme interpreter is the set of functions)-.165 F .736 +(implementing the Scheme primiti)72 416.4 R -.165(ve)-.275 G 3.487(s. These) +.165 F .737(may be used safely by e)3.487 F .737(xtensions and applications.) +-.165 F 1.529(There e)72 431.4 R 1.528 +(xists one C function for each Scheme primiti)-.165 F -.165(ve)-.275 G 7.028 +(.I).165 G 1.528(ts name is that of the corresponding)337.796 431.4 R(primiti) +72 446.4 Q .33 -.165(ve w)-.275 H(ith the follo).165 E(wing con)-.275 E -.165 +(ve)-.44 G(rsions applied:).165 E 21.15<8364>97 465 S .066 +(ashes are replaced by underscores, and the initial letters of the resulting w) +127.5 465 R .067(ord compo-)-.11 F(nents are capitalized;)122 480 Q 21.15<8374> +97 498.6 S(he pre\214x `)125.058 498.6 Q(`P_')-.814 E 2.75('i)-.814 G 2.75(sp) +197.053 498.6 S(repended;)209.582 498.6 Q 21.15<8360>97 517.2 S(`)124.849 517.2 +Q/F3 11/Symbol SF(-)A F0(>')A 2.75('i)-.814 G 2.75(sr)153.075 517.2 S +(eplaced by `)163.767 517.2 Q(`_T)-.814 E(o_')-.88 E 2.75('\()-.814 G(as in) +255.639 517.2 Q F2(vector)2.75 E F3(-)A F2(>list)A F0(\);)A 21.15<8361>97 535.8 +S .285(trailing e)129.919 535.8 R .285(xclamation mark is deleted, e)-.165 F +.284(xcept for)-.165 F F2(append!)3.034 E F0(and)3.034 E F2 -2.101 -.407(re v) +3.034 H(er).407 E(se!)-.11 E F0 3.034(,w)C .284(here `)449.453 535.8 R(`_Set') +-.814 E(')-.814 E(is appended;)122 550.8 Q 21.15<8361>97 569.4 S .448 +(trailing question mark is replaced by the letter `p' \(e)130.082 569.4 R .448 +(xcept for)-.165 F F2 .449(eq?, eqv?, equal?)3.199 F F0(and)3.199 E +(the string and character comparison primiti)122 584.4 Q -.165(ve)-.275 G +(s, where it is deleted\);).165 E(The names of a fe)72 603 Q 2.75(wf)-.275 G +(unctions are deri)164.884 603 Q -.165(ve)-.275 G 2.75(dd).165 G(if)261.893 603 +Q(ferently as sho)-.275 E(wn by this table:)-.275 E EP +%%Page: 14 14 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(4-)288 51 S .44 LW 312.545 +76.75 97 76.75 DL(Scheme Primiti)102.5 89 Q 44.456 -.165(ve C)-.275 H(Function) +2.915 E 312.545 93.75 97 93.75 DL 52.443(P)138.442 121 S(_Generic_Greater\(\))203.205 121 Q 52.443 +(=P)138.442 136 S(_Generic_Equal\(\))203.205 136 Q 46.591 +(<= P_Generic_Eq_Less\(\))135.34 151 R 46.591(>= P_Generic_Eq_Greater\(\)) +135.34 166 R 46.943(1+ P_Inc\(\))135.692 181 R(1)116.211 196 Q/F1 11/Symbol SF +(-)A F0(and)2.75 E F1(-)2.75 E F0 27.462(1+ P_Dec\(\))B 52.443(+P)138.442 211 S +(_Generic_Plus\(\))203.205 211 Q F1(-)138.525 226 Q F0(P_Generic_Minus\(\)) +197.089 226 Q 52.795(*P)138.794 241 S(_Generic_Multiply\(\))203.205 241 Q +54.016(/P)140.015 256 S(_Generic_Di)203.205 256 Q(vide\(\))-.275 E 44.545 +(let* P_Letseq\(\))133.294 271 R 312.545 275.75 97 275.75 DL 312.545 76.75 +312.545 275.75 DL 97 76.75 97 275.75 DL 2.798 +(According to these rules, the primiti)97 295.6 R -.165(ve)-.275 G/F2 11 +/Times-Italic@0 SF -.22(ex)5.712 G(act).22 E F1(-)A F2(>ine)A(xact)-.22 E F0 +2.797(can be used from within C as)5.547 F F2(P_Exact_T)72 310.6 Q(o_Ine)-1.012 +E(xact\(\))-.22 E F0 6.336(,t)C 3.586(he predicate)182.495 310.6 R F2(inte) +6.337 E -.11(ge)-.44 G(r?).11 E F0 3.587(is a)6.337 F -.275(va)-.22 G 3.587 +(ilable as).275 F F2(P_Inte)6.337 E -.11(ge)-.44 G(rp\(\)).11 E F0 6.337(,e)C +6.337(tc. Authors)433.279 310.6 R(of)6.337 E 1.362(reusable Scheme e)72 325.6 R +1.362(xtensions are encouraged to follo)-.165 F 4.112(wt)-.275 G 1.362 +(hese \(or similar\) naming con)322.731 325.6 R -.165(ve)-.44 G 1.361 +(ntions in).165 F(their code.)72 340.6 Q 2.103 +(All the functions implementing Scheme primiti)97 359.2 R -.165(ve)-.275 G +4.853(s\().165 G 2.103(as well as special forms, which are)338.339 359.2 R +1.957(treated as primiti)72 374.2 R -.165(ve)-.275 G 4.707(si).165 G 4.707(nE) +172.449 374.2 S 1.957(lk\) recei)189.377 374.2 R 2.287 -.165(ve S)-.275 H 1.957 +(cheme objects or arrays thereof as their ar).165 F 1.957(guments and)-.198 F +.448(return Scheme objects as their v)72 389.2 R 3.199(alues. The)-.275 F .449 +(underlying C type will be described in the ne)3.199 F .449(xt chap-)-.165 F +(ter)72 404.2 Q 6.432(.F)-.605 G .932 +(or the semantics of the non-standard Scheme primiti)98.133 404.2 R -.165(ve) +-.275 G 3.682(sd).165 G .932(e\214ned by Elk refer to the Refer)358.116 404.2 R +(-)-.22 E(ence Manual for the interpreter)72 419.2 Q(.)-.605 E/F3 11 +/Times-Bold@0 SF 2.75(7.5. P)72 449.2 R(ortable alloca\(\))-.22 E F0 .309 +(Elk pro)97 467.8 R .31(vides a portable v)-.165 F .31(ariant of)-.275 F F2 +(alloca\(\))3.06 E F0 .31(as a set of macros that can be used by e)3.06 F +(xtensions)-.165 E .681(and applications.)72 482.8 R F2(alloca\(\))6.18 E F0 +3.43(,w)C .68(hich is supported by most modern UNIX systems and C compilers,) +202.356 482.8 R 1.952(allocates memory in the caller')72 497.8 R 4.703(ss)-.605 +G 1.953(tack frame; the memory is automatically released when the)228.71 497.8 +R 1.575(function returns.)72 512.8 R 1.575 +(Elk simulates this functionality on the \(rare\) platforms where)7.075 F F2 +(alloca\(\))4.324 E F0 1.574(is not)4.324 F -.22(av)72 527.8 S(ailable.)-.055 E +2.804 -.88(To a)97 546.4 T 1.044(llocate memory).88 F 3.794(,t)-.715 G 1.044 +(he macro)195.689 546.4 R F2(Alloca\(\))3.794 E F0 1.044(is called with a v) +3.794 F 1.045(ariable to which the ne)-.275 F 1.045(wly allo-)-.275 F .879 +(cated memory is assigned, the type of that v)72 561.4 R .878 +(ariable, and the number of bytes that are requested.)-.275 F .102(The macro)72 +576.4 R F2(Alloca_End)2.852 E F0 .103(must be called \(without an ar)2.852 F +.103(gument list\) before returning from a function)-.198 F 1.853 +(or block that uses)72 591.4 R F2(Alloca\(\))4.602 E F0 4.602(;t)C 1.852 +(his macro is empty on those platforms that support the ordinary)206.223 591.4 +R F2(alloca\(\))72 606.4 Q F0 6.062(.F)C(inally)121.754 606.4 Q 3.312(,ac)-.715 +G .562(all to the macro)165.239 606.4 R F2(Alloca_Be)3.312 E(gin)-.44 E F0 .563 +(must be placed in the function')3.312 F 3.313(sd)-.605 G(eclarations.)453.598 +606.4 Q F2(Alloca\(\))72 621.4 Q F0 1.637(usually is more ef)4.387 F 1.637 +(\214cient than)-.275 F F2(malloc\(\))4.387 E F0(and)4.387 E F2(fr)4.387 E +(ee\(\))-.407 E F0 4.387(,a)C 1.636(nd the memory need not be freed)348.775 +621.4 R(when the function is left prematurely because of an interrupt or by ca\ +lling a continuation.)72 636.4 Q .206(As an e)72 655 R .206 +(xample, here is the sk)-.165 F .207 +(eleton of a function that is called with a \214lename pre\214x and a suf)-.11 +F(\214x,)-.275 E +(concatenates them \(separated by a period\), and opens the resulting \214le:) +72 669 Q EP +%%Page: 15 15 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(5-)288 51 S/F1 10/Courier@0 +SF(int some_function\(char *prefix, char *suffix\) {)100.346 86 Q(char *name;) +124.346 100 Q(int len, fd;)124.346 114 Q(Alloca_Begin;)124.346 128 Q +(len = strlen\(prefix\) + 1 + strlen\(suffix\) + 1;)124.346 150.4 Q +(Alloca\(name, char*, len\);)124.346 164.4 Q +(sprintf\(name, "%s.%s", prefix, suffix\);)124.346 178.4 Q +(fd = open\(name, ...\);)124.346 192.4 Q(...)124.346 206.4 Q(Alloca_End;) +124.346 220.4 Q(})100.346 234.4 Q/F2 11/Times-Bold@0 SF 2.75(7.6. Other)72 +271.9 R(Useful Macr)2.75 E(os and Functions)-.198 E F0 .159 +(The preprocessor symbols ELK_MAJOR and ELK_MINOR e)97 290.5 R .159 +(xpand to the major and minor)-.165 F -.165(ve)72 305.5 S +(rsion number of the current release of Elk.).165 E(The)5.5 E 2.75(yd)-.165 G +(id not e)304.749 305.5 Q(xist in v)-.165 E(ersions older than Elk 3.0.)-.165 E +/F3 11/Times-Italic@0 SF(inde)97 324.1 Q(x\(\))-.22 E F0(,)A F3(bcopy\(\))3.396 +E F0(,)A F3(bcmp\(\))3.396 E F0 3.396(,a)C(nd)216 324.1 Q F3(bzer)3.396 E +(o\(\))-.495 E F0 .647(are de\214ned as suitable macros on systems that do not) +3.396 F(ha)72 339.1 Q .367 -.165(ve t)-.22 H .037(hem in their C library; the) +.165 F 2.787(ym)-.165 G .037(ay be used by source \214les that include `) +229.669 339.1 R(`scheme.h')-.814 E .036(', re)-.814 F -.055(ga)-.165 G(rdless) +.055 E(of the actual platform.)72 354.1 Q(Code link)72 371.7 Q +(ed with Elk may use the tw)-.11 E 2.75(of)-.11 G(unctions)246.548 371.7 Q F1 +(char *Safe_Malloc\(unsigned size\);)100.346 394.203 Q +(char *Safe_Realloc\(char *old_pointer, unsigned size\);)100.346 408.203 Q F0 +.71(as alternati)72 430.703 R -.165(ve)-.275 G 3.46(st).165 G(o)141.411 430.703 +Q F3(malloc\(\))3.46 E F0(and)3.46 E F3 -.407(re)3.46 G(alloc\(\)).407 E F0 +6.21(.I)C 3.46(ft)261.148 430.703 S .711 +(he request for memory cannot be satis\214ed, the stan-)271.329 430.703 R +(dard Elk error handler is called with a suitable error message.)72 445.703 Q +F2 2.75(8. The)72 475.703 R(Anatomy of Scheme Objects)2.75 E F0 .416 +(All Scheme objects, re)97 494.303 R -.055(ga)-.165 G .416 +(rless of their Scheme type, are represented as instances of the type).055 F F3 +(Object)72 509.303 Q F0 .302(in C.)3.052 F F3(Object)5.802 E F0 .302 +(is implemented as a small C)3.052 F F3(struct)3.052 E F0 .302(in ne)3.052 F +.303(wer Elk releases and w)-.275 F .303(as an inte)-.11 F(gral)-.165 E 1.873 +(type earlier)72 524.303 R 7.373(.H)-.605 G -.275(ow)141.119 524.303 S -2.365 +-.275(ev e).275 H 2.753 -.44(r, c).275 H 1.873 +(ode using Elk should not assume a speci\214c representation, as it may).44 F +(change ag)72 539.303 Q(ain in future re)-.055 E 2.75(visions. An)-.275 F F3 +(Object)2.75 E F0(consists of three components:)2.75 E 21.15<8374>97 557.903 S +1.272(he type of the corresponding Scheme object as a small inte)125.058 +557.903 R 1.273(ger \(the `)-.165 F 1.273(`type \214eld')-.814 F 4.023('o)-.814 +G(r)500.337 557.903 Q -.814(``)122 572.903 S(tag \214eld').814 E('\),)-.814 E +21.15<8374>97 591.503 S 1.311(he contents of the object, either directly \(for\ + small objects\) or as a pointer into the)125.058 591.503 R +(Scheme heap \(the `)122 606.503 Q(`pointer \214eld')-.814 E('\),)-.814 E 21.15 +<8361>97 625.103 S -.814(``)130.259 625.103 S .625(const bit').814 F 3.375('w) +-.814 G .626 +(hich, if set, indicates that the object is read-only and cannot be modi-) +192.812 625.103 R(\214ed by destructi)122 640.103 Q .33 -.165(ve S)-.275 H +(cheme primiti).165 E -.165(ve)-.275 G(s.).165 E .928(Elk de\214nes a fe)97 +658.703 R 3.678(wm)-.275 G .928(acros to retrie)187.81 658.703 R 1.258 -.165 +(ve a)-.275 H .927(nd modify the \214elds of an).165 F F3(Object)3.677 E F0 +.927(independent of its)3.677 F(representation:)72 672.703 Q F1 54 +(TYPE\(obj\) ISCONST\(obj\))100.346 695.206 R(SET\(obj,t,ptr\))328.346 695.206 +Q 36(POINTER\(obj\) SETCONST\(obj\))100.346 709.206 R EP +%%Page: 16 16 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(6-)288 51 S/F1 11 +/Times-Italic@0 SF(TYPE\(\))97 87 Q F0 .615 +(returns the contents of the type \214eld of an)3.365 F F1(Object)3.365 E F0(;) +A F1(POINTER\(\))3.365 E F0 .616(returns the contents)3.366 F .436 +(of the pointer \214eld as an)72 102 R F1 .436(unsigned long)3.186 F F0(\(dif) +3.186 E .436(ferent macros are pro)-.275 F .435(vided for types which ha)-.165 +F .765 -.165(ve t)-.22 H(heir).165 E -.275(va)72 117 S .837 +(lues stored directly in the).275 F F1(Object)3.588 E F0 .838 +(rather than in the heap\);)3.588 F F1(ISCONST\(\))3.588 E F0 .838 +(returns the v)3.588 F .838(alue of the)-.275 F 1.545(const bit; and)72 132 R +F1(SETCONST\(\))4.294 E F0 1.544 +(sets the const bit to 1 \(it cannot be cleared once it has been set\).)4.294 F +F1(ISCONST\(\))72 147 Q F0(and)3.343 E F1(SETCONST\(\))3.343 E F0 .593 +(may only be applied to)3.343 F F1(Objects)3.343 E F0 .593(that ha)3.343 F .923 +-.165(ve t)-.22 H .593(heir v).165 F .593(alue stored on the)-.275 F 1.222 +(heap \(such as v)72 162 R 1.222 +(ectors, strings, etc.\); all other types of Scheme objects are)-.165 F F1 +1.221(ipso facto)3.971 F F0(read-only)3.971 E(.)-.715 E(Another macro,)72 177 Q +F1(SET\(\))2.75 E F0 2.75(,c)C +(an be used to set both the type and pointer \214eld of a ne)179.833 177 Q 2.75 +(wo)-.275 G(bject.)436.188 177 Q -1.1 -.88(Tw o)97 195.6 T .602 +(objects can be compared by means of the macro)4.232 F F1(EQ\(\))3.352 E F0 +3.353(,w)C .603(hich is also used as the basis)375.114 195.6 R +(for the Scheme predicate)72 209.6 Q F1(eq?)2.75 E F0(:)A/F2 10/Courier@0 SF +(EQ\(obj1,obj2\))100.346 232.103 Q F1(EQ\(\))72 254.603 Q F0 -.165(ex)3.733 G +.983(pands to a non-zero v).165 F .982 +(alue if the type \214elds and the pointer \214elds of the tw)-.275 F 3.732(oo) +-.11 G .982(bjects are)461.174 254.603 R 1.035(identical, else zero \(re)72 +269.603 R -.055(ga)-.165 G 1.035 +(rdless of whether the pointer \214eld really holds a pointer or the object') +.055 F(s)-.605 E .609(actual v)72 284.603 R 3.359(alue\). As)-.275 F F1(EQ\(\)) +3.359 E F0 .609(may e)3.359 F -.275(va)-.275 G .609(luate its ar).275 F .608 +(guments twice, it should not be in)-.198 F -.22(vo)-.44 G -.11(ke).22 G 3.358 +(dw).11 G .608(ith function)452.363 284.603 R(calls or comple)72 299.603 Q 2.75 +(xe)-.165 G(xpressions.)152.014 299.603 Q/F3 11/Times-Bold@0 SF 2.75(8.1. T)72 +329.603 R(ype-speci\214c Macr)-.814 E(os)-.198 E F0 -.165(Fo)97 348.203 S 4.157 +(re).165 G 1.407(ach prede\214ned Scheme type, there e)121.155 348.203 R 1.407 +(xists a preprocessor symbol that e)-.165 F 1.408(xpands to the)-.165 F(inte)72 +363.203 Q 1.045(ger v)-.165 F 1.044(alue of that type \(the contents of the ty\ +pe \214eld of members of the type\).)-.275 F 1.044(The name of)6.544 F +(each such symbol is the name of the type with the pre\214x `)72 377.203 Q +(`T_')-.814 E(':)-.814 E F2 24(T_Boolean T_Pair T_Vector)100.346 399.706 R/F4 +10/Times-Roman@0 SF(etc...)328.346 399.706 Q F0 .587(These symbols are typical\ +ly used as case labels in switch-statements to discriminate the possible)72 +422.206 R(types of a gi)72 436.206 Q -.165(ve)-.275 G 2.75(no).165 G +(bject, or in if-statements to check whether a Scheme object is of a gi)149.77 +436.206 Q -.165(ve)-.275 G 2.75(nt).165 G(ype:)471.63 436.206 Q F2 +(if \(TYPE\(obj\) == T_Vector\))100.346 458.709 Q(...)127.846 472.709 Q F0 .3 +(In addition, each type de\214nes a macro to e)72 495.209 R .3 +(xtract the contents of an object of that type and to con-)-.165 F -.165(ve)72 +509.209 S(rt it to the correct C type.).165 E -.165(Fo)5.5 G 2.75(re).165 G +(xample, the macro)221.204 509.209 Q F2(CHAR\(obj\))100.346 531.712 Q F0 .34 +(is used to fetch the character v)72 554.212 R .341(alue \(a C)-.275 F F1(int) +3.091 E F0 3.091(\)f)C .341(rom members of the Scheme type)273.077 554.212 R F1 +-.165(ch)3.091 G(ar).165 E(acter)-.165 E F0 3.091(,t)C .341(hat is,)477.38 +554.212 R(from objects whose type \214eld contains the v)72 568.212 Q(alue) +-.275 E F1(T_Char)2.75 E(acter)-.165 E F0 5.5(.S)C(imilarly)357.846 568.212 Q +2.75(,t)-.715 G(he macro)400.526 568.212 Q F2(VECTOR\(obj\))100.346 590.715 Q +F0 .281(gets the heap pointer con)72 613.215 R -.165(vey)-.44 G .28 +(ed in objects of the Scheme type).165 F F1(vector)3.03 E F0 5.78(.F)C .28 +(or objects such as v)387.875 613.215 R(ectors,)-.165 E .341 +(pairs, and procedures, the heap address is coerced to a pointer to a C)72 +628.215 R F1(struct)3.091 E F0 .341(de\214ning the layout of)3.091 F .035 +(the object.)72 643.215 R .035(There e)5.535 F .035(xists one structure type d\ +eclaration for each such Scheme type; their names are)-.165 F 1 +(that of the type with `)72 658.215 R(`S_')-.814 E 3.751('p)-.814 G 3.751 +(repended. F)202.248 658.215 R 1.001(or e)-.165 F(xample,)-.165 E F1(VECT)3.751 +E(OR\(\))-.198 E F0 1.001(returns a pointer to a structure)3.751 F 1.386 +(with the components)72 673.215 R F1(size)4.136 E F0 1.386 +(\(the number of elements in the v)4.136 F 1.386(ector\) and)-.165 F F1(data) +4.136 E F0 1.385(\(the elements as an)4.136 F(array of)72 687.215 Q F1(Objects) +2.75 E F0 2.75(\). These)B(can be used from within C code lik)2.75 E 2.75(et) +-.11 G(his:)348.661 687.215 Q EP +%%Page: 17 17 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(7-)288 51 S/F1 10/Courier@0 +SF(int i, num = VECTOR\(obj\)->size;)100.346 86 Q(for \(i = 0; i < num; i++\)) +100.346 108.4 Q(VECTOR\(obj\)->data[i] = ...;)127.846 122.4 Q F0(Similarly)72 +143.9 Q 2.75(,t)-.715 G(he structure underlying the Scheme type)120.796 143.9 Q +/F2 11/Times-Italic@0 SF(pair)2.75 E F0(is de\214ned as:)2.75 E F1 +(struct S_Pair { Object car, cdr; };)100.346 166.403 Q F0 .463(and the macro)72 +188.903 R F2 -.99(PA)3.214 G(IR\(\)).99 E F0 .464 +(returns a \(heap\) pointer to a member of the structure)3.214 F F2(S_P)3.214 E +(air)-.88 E F0 5.964(.M)C .464(acros such)457.413 188.903 R(as)72 203.903 Q F2 +(VECT)3.45 E(OR\(\))-.198 E F0(and)3.45 E F2 -.99(PA)3.45 G(IR\(\)).99 E F0 .7 +(just con)3.45 F -.165(ve)-.44 G .7 +(rt the contents of the pointer \214eld to a pointer of the correct).165 F +(type:)72 217.903 Q F1(#define VECTOR\(obj\))100.346 240.406 Q +(\(\(struct S_Vector *\)POINTER\(obj\)\))232.346 240.406 Q(#define PAIR\(obj\)) +100.346 254.406 Q(\(\(struct S_Pair)232.346 254.406 Q(*\)POINTER\(obj\)\)) +340.346 254.406 Q F0 1.297(Authors of Scheme e)97 280.506 R 1.297 +(xtensions and Elk-based applications are encouraged to follo)-.165 F 4.047(wt) +-.275 G(hese)484.453 280.506 Q(con)72 295.506 Q -.165(ve)-.44 G .285 +(ntions in their code and, for each ne).165 F 3.035(wt)-.275 G(ype)271.048 +295.506 Q F2(xyz)3.035 E F0 3.034(,s)C .284(tore the ne)314.077 295.506 R 3.034 +(wt)-.275 G .284(ype v)374.835 295.506 R .284(alue \(which is allocated)-.275 F +.531(by the interpreter when the type is re)72 310.506 R .532 +(gistered\) in a v)-.165 F(ariable)-.275 E F2(T_Xyz)3.282 E F0 3.282(,a)C .532 +(nd de\214ne a structure or class)375.786 310.506 R F2(S_Xyz)72 325.506 Q F0 +2.808(,a)C .058(nd a macro)109.326 325.506 R F2(XYZ\(\))2.808 E F0 .058 +(that mak)2.808 F .058 +(es a pointer to this structure from a member of the type.)-.11 F(Capi-)5.557 E +(talization may v)72 340.506 Q(ary according to personal preference.)-.275 E/F3 +11/Times-Bold@0 SF 2.75(9. De\214ning)72 370.506 R(New Scheme Primiti)2.75 E +-.11(ve)-.11 G(s).11 E F0 1.047(In Elk, there e)97 389.106 R 1.048 +(xists a one-to-one relationship between Scheme primiti)-.165 F -.165(ve)-.275 +G 3.798(sa).165 G 1.048(nd C functions:)434.067 389.106 R .179 +(each Scheme primiti)72 404.106 R -.165(ve)-.275 G .178 +(\212whether prede\214ned or user).165 F .178 +(-de\214ned\212is implemented by a corresponding)-.22 F 3.312(Cf)72 419.106 S +3.312(unction. This)86.312 419.106 R .562 +(includes special forms, which are treated as a special kind of primiti)3.312 F +-.165(ve)-.275 G 3.313(si).165 G 3.313(nE)477.158 419.106 S(lk.)492.692 419.106 +Q .649(Extensions and applications use the function)72 434.106 R F2 +(De\214ne_Primitive\(\))3.399 E F0 .649(to re)3.399 F .649(gister a ne)-.165 F +3.398(wS)-.275 G .648(cheme primi-)444.392 434.106 R(ti)72 449.106 Q 1.777 +-.165(ve w)-.275 H 1.447(ith the interpreter).165 F 4.197(,s)-.44 G 1.448 +(upplying its name and the C function that implements it.)190.252 449.106 R +1.448(In case of)6.948 F 3.043(dynamically loadable e)72 464.106 R 3.042 +(xtensions or application modules, the calls to)-.165 F F2 +(De\214ne_Primitive\(\))5.792 E F0(are)5.792 E 1.233(placed in the e)72 479.106 +R 1.233(xtension initialization functions that are called automatically as the\ + object \214le is)-.165 F(loaded.)72 493.106 Q F2(De\214ne_Primitive\(\))5.5 E +F0(is declared as)2.75 E F1 +(void Define_Primitive\(\(Object \(*func\)\(\)\), const char *name,)100.346 +515.609 Q(int minargs, int maxargs,)232.346 529.609 Q(enum discipline disc\);) +232.346 543.609 Q F0(The ar)72 566.109 Q(guments are:)-.198 E F2(func)97 +584.709 Q F0 2.75(ap)6.058 G(ointer to the C function implementing the ne) +135.134 584.709 Q 2.75(wp)-.275 G(rimiti)346.906 584.709 Q -.165(ve)-.275 G(;) +.165 E F2(name)97 603.309 Q F0(the name of the primiti)1.174 E .33 -.165(ve a) +-.275 H 2.75(san).165 G(ull-terminated C string;)260.567 603.309 Q F2(minar)97 +621.909 Q(gs)-.407 E F0(the minimum number of ar)122 636.909 Q +(guments accepted by the primiti)-.198 E -.165(ve)-.275 G(;).165 E F2(maxar)97 +655.509 Q(gs)-.407 E F0(the maximum number of ar)122 670.509 Q +(guments \(identical to)-.198 E F2(minar)2.75 E(gs)-.407 E F0(in most cases\);) +2.75 E F2(disc)97 689.109 Q F0(the)7.279 E F2(calling discipline)2.75 E F0 +(\(usually)2.75 E F2(EV)2.75 E(AL)-.66 E F0(\).)A F2(De\214ne_Primitive\(\))97 +707.709 Q F0 .947(creates a Scheme v)3.697 F .946 +(ariable of the speci\214ed name in the current \(i.)-.275 F .946(e. the)1.833 +F(caller')72 722.709 Q 1.112(s\) le)-.605 F 1.112(xical en)-.165 F 1.112 +(vironment and binds it to the ne)-.44 F 1.112(wly created procedure.)-.275 F +1.113(Each C function that)6.613 F EP +%%Page: 18 18 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(8-)288 51 S .659 +(implements a primiti)72 87 R .989 -.165(ve h)-.275 H .659(as a return type of) +.165 F/F1 11/Times-Italic@0 SF(Object)3.409 E F0 .658 +(and, for a calling discipline of)3.409 F F1(EV)3.408 E(AL)-.66 E F0 3.408(,z)C +.658(ero or)477.382 87 R .125(more ar)72 102 R .126(guments of type)-.198 F F1 +(Object)2.876 E F0 .126(which are bound to the e)2.876 F -.275(va)-.275 G .126 +(luated ar).275 F .126(guments passed to the Scheme)-.198 F(primiti)72 117 Q +.33 -.165(ve w)-.275 H(hen it is called.).165 E +(The calling discipline must be one of the follo)5.5 E(wing:)-.275 E F1(EV)97 +135.6 Q(AL)-.66 E F0 1.685(The primiti)122 150.6 R 2.015 -.165(ve ex)-.275 H +1.684(pects a \214x).165 F 1.684(ed number of ar)-.165 F(guments;)-.198 E F1 +(minar)4.434 E(gs)-.407 E F0(and)4.434 E F1(maxar)4.434 E(gs)-.407 E F0 1.684 +(must be)4.434 F(identical)122 165.6 Q/F2 9/Times-Roman@0 SF(2)-3.6 I F0(.)3.6 +I F1 -.66(VA)97 184.2 S(RARGS).66 E F0 1.16(The primiti)122 199.2 R 1.49 -.165 +(ve h)-.275 H 1.16(as a v).165 F 1.16(ariable number of ar)-.275 F 1.159 +(guments, and the underlying C function is)-.198 F .613(called with an ar)122 +214.2 R .614(gument count and an array of ar)-.198 F 3.364(guments. De\214ning) +-.198 F(primiti)3.364 E -.165(ve)-.275 G 3.364(sw).165 G .614(ith a)484.136 +214.2 R -.275(va)122 229.2 S(riable number of ar).275 E(guments will e)-.198 E +(xplained in more detail in section 9.2.)-.165 E F1(NOEV)97 247.8 Q(AL)-.66 E +F0 .396(The ar)122 262.8 R .395(guments are passed as a Scheme list of une) +-.198 F -.275(va)-.275 G .395(luated objects\212a single ar).275 F(gument)-.198 +E .124(of the type)122 277.8 R F1(Object)2.874 E F0 5.624(.P)C(rimiti)215.985 +277.8 Q -.165(ve)-.275 G 2.874(su).165 G .124 +(sing this discipline will then use)263.035 277.8 R F1(Eval\(\))2.875 E F0 .125 +(as described in)2.875 F 1.265(section 12.2 to e)122 292.8 R -.275(va)-.275 G +1.265(luate some or all of the ar).275 F(guments.)-.198 E F1(NOEV)6.764 E(AL) +-.66 E F0 1.264(is only rarely used)4.014 F 1.021(\(with the e)122 307.8 R +1.021(xception of the b)-.165 F 1.022(uilt-in special forms of Elk\); e)-.22 F +1.022(xtensions and applications)-.165 F(mostly use macros as a more con)122 +322.8 Q -.165(ve)-.44 G(nient w).165 E(ay to de\214ned ne)-.11 E 2.75(ws)-.275 +G(yntactical forms.)394.437 322.8 Q(Figure 2 sho)72 341.4 Q(ws a simple e)-.275 +E(xample for de\214ning a ne)-.165 E 2.75(wS)-.275 G(cheme primiti)310.205 +341.4 Q -.165(ve)-.275 G(.).165 E(____________________________________________\ +__________________________________)75 368.9 Q/F3 10/Courier@0 SF +(#include "scheme.h")72 388.4 Q(Object p_vector_reverse\(Object vec\) {)72 +410.8 Q(Object tmp, *s, *t;)99.5 424.8 Q(Check_Type\(vec, T_Vector\);)99.5 +447.2 Q +(for \(s = VECTOR\(vec\)->data, t = s+VECTOR\(vec\)->size; --t > s; s++\))99.5 +461.2 Q(tmp = *s, *s = *t, *t = tmp;)127 475.2 Q(return vec;)99.5 489.2 Q(})72 +503.2 Q(void elk_init_vector\(void\) {)72 525.6 Q +(Define_Primitive\(p_vector_reverse, "vector-reverse!", 1, 1, EVAL\);)99.5 +539.6 Q(})72 553.6 Q/F4 10/Times-Bold@0 SF(Figur)198.84 571.4 Q 2.5(e2)-.18 G +(:)234.49 571.4 Q/F5 10/Times-Roman@0 SF(De\214ning a ne)5 E 2.5(wS)-.25 G +(cheme Primiti)311.73 571.4 Q -.15(ve)-.25 G F0(______________________________\ +________________________________________________)75 590 Q 1.05(The primiti)97 +623.6 R -.165(ve)-.275 G F1(vector)3.965 E(-r)-.22 E -.165(ev)-.407 G(er).165 E +(se!)-.11 E F0 1.05(de\214ned by the e)3.8 F 1.05(xample e)-.165 F 1.049 +(xtension re)-.165 F -.165(ve)-.275 G 1.049(rses the elements of a).165 F .868 +(Scheme v)72 638.6 R .868(ector in place and returns its ar)-.165 F .868 +(gument \(note the \214nal e)-.198 F .868(xclamation mark indicating the)-.165 +F(destructi)72 653.6 Q 1.397 -.165(ve o)-.275 H(peration\).).165 E F1(Chec) +6.567 E(k_T)-.22 E(ype\(\))-.814 E F0 1.067 +(is a simple macro that compares the type \214eld of the \214rst)3.817 F(ar)72 +668.6 Q .532(gument \(an)-.198 F F1(Object)3.282 E F0 3.282(\)w)C .532 +(ith the second ar)178.173 668.6 R .533(gument and signals and error if the) +-.198 F 3.283(yd)-.165 G 3.283(on)422.651 668.6 S .533(ot match.)436.934 668.6 +R(This)6.033 E 1.748(macro is used primarily for type-checking the ar)72 683.6 +R 1.748(guments to Scheme primiti)-.198 F -.165(ve)-.275 G 4.498(s. A).165 F +1.748(call to the)4.498 F .36 LW 76.5 694.6 72 694.6 DL 81 694.6 76.5 694.6 DL +85.5 694.6 81 694.6 DL 90 694.6 85.5 694.6 DL 94.5 694.6 90 694.6 DL 99 694.6 +94.5 694.6 DL 103.5 694.6 99 694.6 DL 108 694.6 103.5 694.6 DL 112.5 694.6 108 +694.6 DL 117 694.6 112.5 694.6 DL 121.5 694.6 117 694.6 DL 126 694.6 121.5 +694.6 DL 130.5 694.6 126 694.6 DL 135 694.6 130.5 694.6 DL 139.5 694.6 135 +694.6 DL 144 694.6 139.5 694.6 DL/F6 7/Times-Roman@0 SF(2)82 704.6 Q F2 1.228 +(Because of a limitation in the C language, primiti)4.5 2.8 N -.135(ve)-.225 G +3.478(so).135 G 3.478(ft)297.18 707.4 S(ype)306.157 707.4 Q/F7 9/Times-Italic@0 +SF(EV)3.478 E(AL)-.54 E F2 1.228(can only ha)3.478 F 1.499 -.135(ve a \214)-.18 +H -.135(xe).135 G 3.479(dm).135 G(aximum)438.498 707.4 Q(number of ar)72 718.4 +Q(guments \(currently 10\).)-.162 E(If more ar)4.5 E(guments are required,) +-.162 E F7 -.54(VA)2.25 G(RARGS).54 E F2(must be used instead.)2.25 E EP +%%Page: 19 19 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(9-)288 51 S(macro)72 87 Q/F1 +11/Times-Italic@0 SF(Chec)3.215 E(k_Mutable\(\))-.22 E F0 .465(with the v)3.215 +F .466(ector as an ar)-.165 F .466(gument could ha)-.198 F .796 -.165(ve b)-.22 +H .466(een inserted before the loop).165 F .046(to check whether the v)72 102 R +.046 +(ector is read-only and to automatically raise an error if this is the case.) +-.165 F(The)5.545 E -.165(ex)72 117 S .142(ample code forms a complete e).165 F +.143(xtension including an e)-.165 F .143 +(xtension initialization function and could)-.165 F(be link)72 131 Q +(ed with the interpreter)-.11 E 2.75(,o)-.44 G 2.75(rl)210.149 131 S +(oaded dynamically into the interpreter as follo)219.62 131 Q(ws:)-.275 E/F2 10 +/Courier-Bold@0 SF(%)100.346 153.503 Q/F3 10/Courier@0 SF +(cc \255c \255I/usr/elk/include vec.c; makedl vec.o vec.o)6 E F2(%)100.346 +167.503 Q F3(scheme)6 E F2(>)100.346 181.503 Q F3(\(load 'vec.o\))6 E F2(>) +100.346 195.503 Q F3(\(define v '#\(hello word\)\))6 E F2(v)100.346 209.503 Q +(>)100.346 223.503 Q F3(\(vector-reverse! v\))6 E F2(#\(world hello\))100.346 +237.503 Q(>)100.346 251.503 Q F3(v)6 E F2(#\(world hello\))100.346 265.503 Q(>) +100.346 279.503 Q/F4 11/Times-Bold@0 SF 2.75(9.1. Making)72 317.003 R +(Objects Kno)2.75 E(wn to the Garbage Collector)-.11 E F0 2.207 +(Consider the non-destructi)97 335.603 R 2.537 -.165(ve ve)-.275 H 2.207 +(rsion of the primiti).165 F -.165(ve)-.275 G F1(vector)5.122 E(-r)-.22 E -.165 +(ev)-.407 G(er).165 E(se)-.11 E F0(sho)4.957 E 2.207(wn in Figure 3,)-.275 F +(which returns a ne)72 350.603 Q 2.75(wv)-.275 G +(ector instead of altering the contents of the original v)168.701 350.603 Q +(ector)-.165 E(.)-.605 E(_____________________________________________________\ +_________________________)75 378.103 Q F3 +(Object p_vector_reverse\(Object vec\) {)72 397.603 Q(Object ret;)99.5 411.603 +Q(int i, j;)99.5 425.603 Q(Check_Type\(vec, T_Vector\);)99.5 448.003 Q +(ret = Make_Vector\(VECTOR\(vec\)->size, False\);)99.5 462.003 Q +(for \(i = 0, j = VECTOR\(vec\)->size; --j >= 0; i++\))99.5 476.003 Q +(VECTOR\(ret\)->data[i] = VECTOR\(vec\)->data[j];)127 490.003 Q(return ret;) +99.5 504.003 Q(})72 518.003 Q/F5 10/Times-Bold@0 SF(Figur)167.815 535.803 Q 2.5 +(e3)-.18 G(:)203.465 535.803 Q/F6 10/Times-Roman@0 SF(Non-destructi)5 E .3 -.15 +(ve S)-.25 H(cheme primiti).15 E -.15(ve)-.25 G/F7 10/Times-Italic@0 SF(vector) +2.65 E(-r)-.2 E -.15(ev)-.37 G(er).15 E(se)-.1 E F0(__________________________\ +____________________________________________________)75 554.403 Q .37 +(The code in Figure 3 is identical to that sho)97 588.003 R .371 +(wn in Figure 2, e)-.275 F .371(xcept that a ne)-.165 F 3.121(wv)-.275 G .371 +(ector is allo-)448.269 588.003 R .513 +(cated, \214lled with the contents of the original v)72 603.003 R .513 +(ector in re)-.165 F -.165(ve)-.275 G .513(rse order).165 F 3.263(,a)-.44 G +.513(nd returned as the result of)383.824 603.003 R(the primiti)72 617.003 Q +-.165(ve)-.275 G(.).165 E F1(Mak)5.5 E(e_V)-.11 E(ector\(\))-1.221 E F0 +(is declared by Elk:)2.75 E F3(Object Make_Vector\(int size, Object fill\);) +100.346 639.506 Q F1(size)72 662.006 Q F0 1.035(is the length of the v)3.785 F +(ector)-.165 E 3.785(,a)-.44 G 1.035 +(nd all elements are initialized to the Scheme object)220.397 662.006 R F1 +(\214ll)3.785 E F0 6.535(.I)C 3.786(nt)481.272 662.006 S(he)493.616 662.006 Q +-.165(ex)72 677.006 S 2.325(ample, the prede\214ned global v).165 F(ariable) +-.275 E F1 -.825(Fa)5.075 G(lse).825 E F0 2.324(is used as the)5.075 F F1 +(\214ll)5.074 E F0 2.324(object; it holds the boolean)5.074 F +(Scheme constant #f \(an)72 692.006 Q(y)-.165 E F1(Object)2.75 E F0(could ha) +2.75 E .33 -.165(ve b)-.22 H(een used here\).).165 E .789 +(Although the C function may look right, there is a problem when it comes to g) +97 710.606 R .79(arbage col-)-.055 F 3.056(lection. T)72 725.606 R 3.056(ou) +-.88 G .305(nderstand the problem and its solution, it may be helpful to ha) +130.395 725.606 R .635 -.165(ve a b)-.22 H .305(rief look at ho).165 F(w)-.275 +E EP +%%Page: 20 20 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(0-)288 51 S .627(the g)72 87 +R .627(arbage collector)-.055 F/F1 9/Times-Roman@0 SF(3)-3.6 I F0 -.11(wo)3.377 +3.6 O .627(rks \(the follo).11 F .627 +(wing description presents a simpli\214ed vie)-.275 F .626(w; the real algo-) +-.275 F 2.402(rithm is more comple)72 102 R 5.153(x\). In)-.165 F 2.403 +(Elk, a g)5.153 F 2.403(arbage collection is triggered automatically whene) +-.055 F -.165(ve)-.275 G 5.153(ra).165 G 1.444 +(request for heap space cannot be satis\214ed because the heap is full, or e)72 +117 R 1.444(xplicitly by calling the)-.165 F(primiti)72 132 Q -.165(ve)-.275 G +/F2 11/Times-Italic@0 SF(collect)3.42 E F0 .506(from within Scheme code.)3.255 +F .506(The g)6.006 F .506(arbage collector traces all `)-.055 F(`li)-.814 E +-.165(ve)-.275 G 2.134 -.814('' o).165 H .506(bjects start-).814 F .002 +(ing with a kno)72 147 R(wn)-.275 E F2 -.495(ro)2.752 G .002(ot set).495 F F0 +.002(of pointers to reachable objects \(basically the interpreter')2.752 F +2.752(sg)-.605 G .002(lobal le)450.087 147 R(xical)-.165 E(en)72 162 Q 1.167 +(vironment and its symbol table\).)-.44 F -.165(Fo)6.667 G(llo).165 E 1.168 +(wing these pointers, all accessible Scheme objects are)-.275 F .368 +(located and copied to a ne)72 177 R 3.118(wh)-.275 G .367 +(eap space in memory \(`)204.679 177 R(`forw)-.814 E(arded')-.11 E .367 +('\), thereby compacting the heap.)-.814 F(Whene)72 192 Q -.165(ve)-.275 G +3.115(ra).165 G 3.115(no)124.758 192 S .365 +(bject is relocated in memory during g)138.873 192 R .365 +(arbage collection, the contents of the pointer)-.055 F .673 +(\214eld of the corresponding C)72 207 R F2(Object)3.423 E F0 .673 +(is updated to point to the ne)3.423 F 3.423(wl)-.275 G 3.422(ocation. After) +374.702 207 R .672(that, an)3.422 F 3.422(yc)-.165 G(on-)489.337 207 Q +(stituent objects \(e.)72 222 Q(g. the elements of a v)1.833 E +(ector\) are forw)-.165 E(arded in the same w)-.11 E(ay)-.11 E(.)-.715 E .706 +(As li)97 240.6 R 1.036 -.165(ve o)-.275 H .706(bjects are relocated in memory) +.165 F(,)-.715 E F2(all)3.457 E F0 .707 +(pointers to an object need to be updated prop-)3.457 F .056 +(erly when that object is forw)72 255.6 R .056(arded during g)-.11 F .056 +(arbage collection.)-.055 F .056(If a pointer to a li)5.556 F .386 -.165(ve o) +-.275 H .056(bject were not).165 F 1.158 +(in the root set \(that is, not reachable by the g)72 270.6 R 1.158 +(arbage collector\), the object w)-.055 F 1.159(ould either become)-.11 F -.055 +(ga)72 285.6 S .884(rbage erroneously during the ne).055 F .884(xt g)-.165 F +.884(arbage collection, or)-.055 F 3.634(,i)-.44 G 3.634(fi)344.128 285.6 S +3.634(th)354.483 285.6 S .883(ad been reached through some)366.675 285.6 R +1.055(other pointer)72 300.6 R 3.805(,t)-.44 G 1.055(he original pointer w) +138.746 300.6 R 1.054(ould no)-.11 F 3.804(wp)-.275 G 1.054(oint to an in) +285.093 300.6 R -.275(va)-.44 G 1.054(lid location.).275 F F1(4)-3.6 I F0 1.054 +(This is e)3.804 3.6 N 1.054(xactly what)-.165 F(happens in the e)72 315.6 Q +(xample sho)-.165 E(wn in Figure 3.)-.275 E .178(The call to)97 334.2 R F2(Mak) +2.928 E(e_V)-.11 E(ector\(\))-1.221 E F0 .179(in the e)2.928 F .179 +(xample triggers a g)-.165 F .179(arbage collection if the heap is too full) +-.055 F .201(to satisfy the request for heap space.)72 349.2 R .2(As the)5.701 +F F2(Object)2.95 E F0 .2(pointer stored in the ar)2.95 F(gument)-.198 E F2(vec) +2.95 E F0 .2(is in)2.95 F(visible)-.44 E .685(to the g)72 364.2 R .685 +(arbage collector)-.055 F 3.435(,i)-.44 G .686 +(ts pointer \214eld cannot be updated when the v)186.357 364.2 R .686 +(ector to which it points is)-.165 F(forw)72 379.2 Q .262(arded during the g) +-.11 F .261(arbage collection started inside)-.055 F F2(Mak)3.011 E(e_V)-.11 E +(ector\(\))-1.221 E F0 5.761(.A)C 3.011(sar)395.786 379.2 S .261 +(esult, all further ref-)414.634 379.2 R 2.163(erences to)72 394.2 R F2(VECT) +4.913 E(OR\(vec\))-.198 E F0 2.163(will return an in)4.913 F -.275(va)-.44 G +2.164(lid address and may cause the program to crash).275 F .862 +(\(immediately or)72 409.2 R 3.612(,w)-.44 G .862(orse, at a later point\).) +157.192 409.2 R .862(The solution is simple: the primiti)6.362 F 1.192 -.165 +(ve j)-.275 H .862(ust needs to add).165 F F2(vec)72 423.2 Q F0 +(to the set of initial pointers used by the g)2.75 E(arbage collector)-.055 E +5.5(.T)-.605 G(his is done by inserting the line)353.622 423.2 Q/F3 10 +/Courier@0 SF(GC_Link\(vec\);)100.346 445.703 Q F0 .04(at the be)72 468.203 R +.041(ginning of the function before the call to)-.165 F F2(Mak)2.791 E(e_V)-.11 +E(ector\(\))-1.221 E F0(.)A F2(GC_Link\(\))5.541 E F0 .041(is a macro.)2.791 F +(Another)5.541 E(macro,)72 483.203 Q F2(GC_Unlink)3.145 E F0 3.145(,m)C .395 +(ust be called later \(e.)170.558 483.203 R .395 +(g. at the end of the function\) without an ar)1.833 F .394(gument list)-.198 F +.996(to remo)72 498.203 R 1.326 -.165(ve t)-.165 H .996 +(he object from the root set ag).165 F 3.746(ain. In)-.055 F .996 +(addition, a call to)3.746 F F2(GC_Node)3.747 E F0(\(ag)3.747 E .997 +(ain without an)-.055 F(ar)72 513.203 Q 1.389 +(gument list\) must be placed in the declarations at the be)-.198 F 1.388 +(ginning of the enclosing function or)-.165 F 2.75(block. Figure)72 528.203 R +2.75(4s)2.75 G(ho)148.692 528.203 Q(ws the re)-.275 E(vised, correct code.) +-.275 E .171(Appendix A lists the C functions which can trigger a g)97 546.803 +R .172(arbage collection.)-.055 F(An)5.672 E 2.922(yl)-.165 G .172(ocal v) +447.596 546.803 R(ariable)-.275 E 1.038(or ar)72 561.803 R 1.038 +(gument of type)-.198 F F2(Object)3.788 E F0 1.038 +(must be protected in the manner sho)3.788 F 1.038(wn abo)-.275 F 1.367 -.165 +(ve i)-.165 H 3.787(fo).165 G 1.037(ne of these func-)427.277 561.803 R 1.398 +(tions is called during its lifetime.)72 576.803 R 1.398(This may sound more b) +6.898 F 1.399(urdensome than it really is, because)-.22 F 1.632(most of the `) +72 591.803 R(`dangerous')-.814 E 4.382('f)-.814 G 1.632 +(unctions are rarely or ne)195.425 591.803 R -.165(ve)-.275 G 4.382(ru).165 G +1.631(sed from within C/C++ e)332.351 591.803 R 1.631(xtensions or)-.165 F .36 +LW 76.5 602.803 72 602.803 DL 81 602.803 76.5 602.803 DL 85.5 602.803 81 +602.803 DL 90 602.803 85.5 602.803 DL 94.5 602.803 90 602.803 DL 99 602.803 +94.5 602.803 DL 103.5 602.803 99 602.803 DL 108 602.803 103.5 602.803 DL 112.5 +602.803 108 602.803 DL 117 602.803 112.5 602.803 DL 121.5 602.803 117 602.803 +DL 126 602.803 121.5 602.803 DL 130.5 602.803 126 602.803 DL 135 602.803 130.5 +602.803 DL 139.5 602.803 135 602.803 DL 144 602.803 139.5 602.803 DL/F4 7 +/Times-Roman@0 SF(3)82 612.803 Q F1 .507(Elk actually emplo)4.5 2.8 N .507 +(ys tw)-.09 F 2.757(og)-.09 G .507 +(arbage collectors, one based on the traditional stop-and-cop)190.299 615.603 R +2.758(ys)-.09 G(trate)418.969 615.603 Q(gy)-.135 E 2.758(,a)-.585 G .508(nd a) +452.246 615.603 R(generational, incremental g)72 626.603 Q +(arbage collector which is less disrupti)-.045 E .27 -.135(ve b)-.225 H +(ut not supported on all platforms.)-.045 E F4(4)82 636.603 Q F1 2.044 +(The problem of managing an `)4.5 2.8 N(`e)-.666 E 2.045(xact root set')-.135 F +4.295('c)-.666 G 2.045(an be a)277.843 639.403 R -.18(vo)-.18 G 2.045 +(ided by a technique called).18 F/F5 9/Times-Italic@0 SF(conservative)4.295 E +F1 -.045(ga)72 650.403 S .487(rbage collection.).045 F 2.737(Ac)4.987 G(onserv) +159.141 650.403 Q(ati)-.225 E .757 -.135(ve g)-.225 H .487 +(arbage collector treats the data se).09 F .486(gment, stack, and re)-.135 F +.486(gisters of the run-)-.135 F .059(ning program as)72 661.403 R F5 .059 +(ambiguous r)2.309 F(oots)-.405 E F1 4.559(.I)C 2.309(ft)202.633 661.403 S .059 +(he set of ambiguous roots is a superset of the)210.441 661.403 R F5(actual) +2.31 E F1 .06(roots, then a point-)2.31 F .109(er that looks lik)72 672.403 R +2.359(eah)-.09 G .109(eap pointer can safely be considered as pointing to an a\ +ccessible object that cannot be re-)145.697 672.403 R 2.508(claimed. At)72 +683.403 R .259(the time Elk w)2.508 F .259(as designed, conserv)-.09 F(ati) +-.225 E .529 -.135(ve G)-.225 H 2.509(Cw).135 G .259(as still in its inf) +288.034 683.403 R(anc)-.09 E 2.509(ya)-.135 G .259(nd suf)367.854 683.403 R +.259(\214cient e)-.225 F .259(xperience did)-.135 F 1.178(not e)72 694.403 R +3.428(xist. F)-.135 F 1.177(or this reason, and because of the implied risks o\ +n certain machine architectures, the inherent)-.135 F .502(portability problem\ +s, and the inability to precisely determine the actual memory utilization, a t\ +raditional GC)72 705.403 R(strate)72 716.403 Q(gy w)-.135 E(as chosen for Elk.) +-.09 E EP +%%Page: 21 21 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(1-)288 51 S(________________\ +______________________________________________________________)75 99.5 Q/F1 10 +/Courier@0 SF(Object p_vector_reverse\(Object vec\) {)72 119 Q(Object ret;)99.5 +133 Q(int i, j;)99.5 147 Q(GC_Node;)99.5 161 Q(GC_Link\(vec\);)99.5 183.4 Q +(Check_Type\(vec, T_Vector\);)99.5 197.4 Q +(ret = Make_Vector\(VECTOR\(vec\)->size, False\);)99.5 211.4 Q +(for \(i = 0, j = VECTOR\(vec\)->size; --j >= 0; i++\))99.5 225.4 Q +(VECTOR\(ret\)->data[i] = VECTOR\(vec\)->data[j];)127 239.4 Q(GC_Unlink;)99.5 +253.4 Q(return ret;)99.5 267.4 Q(})72 281.4 Q/F2 10/Times-Bold@0 SF(Figur) +130.82 299.2 Q 2.5(e4)-.18 G(:)166.47 299.2 Q/F3 10/Times-Roman@0 SF +(Non-destructi)5 E .3 -.15(ve S)-.25 H(cheme primiti).15 E -.15(ve)-.25 G/F4 10 +/Times-Italic@0 SF(vector)2.65 E(-r)-.2 E -.15(ev)-.37 G(er).15 E(se)-.1 E F3 +2.5(,c)C(orrected v)380.63 299.2 Q(ersion)-.15 E F0(__________________________\ +____________________________________________________)75 317.8 Q .949 +(applications in practice.)72 347.8 R .949(Most primiti)6.449 F -.165(ve)-.275 +G 3.699(st).165 G .949(hat require calls to)262.381 347.8 R/F5 11 +/Times-Italic@0 SF(GC_Link\(\))3.699 E F0 .95(use some function that)3.699 F +(creates a ne)72 362.8 Q 2.75(wS)-.275 G(cheme object, such as)139.837 362.8 Q +F5(Mak)2.75 E(e_V)-.11 E(ector\(\))-1.221 E F0(in the e)2.75 E(xample abo)-.165 +E -.165(ve)-.165 G(.).165 E 3.091 -.88(To s)97 381.4 T 1.33 +(implify GC protection of more than a single ar).88 F 1.33(gument or v)-.198 F +1.33(ariable, additional macros)-.275 F F5(GC_Link2\(\))72 396.4 Q F0(,)A F5 +(GC_Link3\(\))3.149 E F0 3.149(,a)C .399(nd so on up to)195.008 396.4 R F5 +(GC_Link7\(\))3.149 E F0 .4(are pro)3.149 F 3.15(vided. Each)-.165 F .4 +(of these can be called)3.15 F .388(with as man)72 411.4 R 3.138(ya)-.165 G +-.198(rg)139.296 411.4 S .388(uments of type).198 F F5(Object)3.138 E F0 .387 +(as is indicated by the digit \(separate macros are required,)3.138 F .778 +(because macros with a v)72 426.4 R .778(ariable number of ar)-.275 F .779 +(guments cannot be de\214ned in C\).)-.198 F 3.529(Ac)6.279 G(orresponding) +445.953 426.4 Q(macro)72 441.4 Q F5(GC_Node2)6.619 E F0(,)A F5(GC_Node3)6.618 E +F0 6.618(,a)C 3.868(nd so on, must be placed in the declarations.)228.728 441.4 +R(Dif)9.368 E(ferent)-.275 E F5(GC_Link*\(\))72 456.4 Q F0 1.339 +(calls cannot be mix)4.088 F 4.089(ed. All)-.165 F 1.339(local v)4.089 F 1.339 +(ariables passed to one of the macros must ha)-.275 F -.165(ve)-.22 G 1.202 +(been initialized.)72 471.4 R 1.201(GC protection is not required for `)6.702 F +(`pointer)-.814 E(-less')-.22 E 3.951('o)-.814 G 1.201 +(bjects such as booleans and)378.218 471.4 R 2.165(small inte)72 486.4 R 2.165 +(gers, and for the ar)-.165 F 2.165(guments of primiti)-.198 F -.165(ve)-.275 G +4.915(sw).165 G 2.165(ith a v)321.629 486.4 R 2.166(ariable number of ar)-.275 +F 2.166(guments \(as)-.198 F .974(described in section 9.2\).)72 501.4 R .974 +(Section 12.3 will describe ho)6.474 F 3.724(wg)-.275 G .973(lobal \(e)340.487 +501.4 R(xternal\))-.165 E F5(Object)3.723 E F0 -.275(va)3.723 G .973 +(riables can).275 F(be added to the root set.)72 516.4 Q .81(Here is ho)97 535 +R 3.56(wt)-.275 G .81(he implementation of the primiti)158.115 535 R -.165(ve) +-.275 G F5(cons)3.725 E F0(uses)3.56 E F5(GC_Link2\(\))3.56 E F0 .81 +(to protect its ar)3.56 F(gu-)-.198 E(ments \(the car and the cdr of the ne)72 +549 Q 2.75(wp)-.275 G(air\):)243.094 549 Q F1 +(Object P_Cons\(Object car, Object cdr\) {)100.346 571.503 Q(Object new_pair;) +127.846 585.503 Q(GC_Node2;)127.846 599.503 Q(GC_Link2\(car, cdr\);)127.846 +621.903 Q(new_pair =)127.846 635.903 Q F4 +(allocate heap space and initialize object)6 E F1(;)A(GC_Unlink;)127.846 +649.903 Q(return new_pair;)127.846 663.903 Q(})100.346 677.903 Q F0 .303 +(There are a fe)97 704.003 R 3.052(wp)-.275 G(itf)174.891 704.003 Q .302 +(alls to be a)-.11 F -.11(wa)-.165 G .302(re of when using `).11 F(`dangerous') +-.814 E 3.052('f)-.814 G .302(unctions from within your)387.902 704.003 R .265 +(C/C++ code.)72 719.003 R -.165(Fo)5.765 G 3.015(re).165 G .265 +(xample, consider this code fragment which \214lls a Scheme v)157.286 719.003 R +.266(ector with the pro-)-.165 F(gram')72 733.003 Q 2.75(se)-.605 G -.44(nv) +109.576 733.003 S(ironment strings that are a).44 E -.275(va)-.22 G +(ilable through the null-terminated string array).275 E F5(en)2.75 E(vir)-.44 E +(on[])-.495 E F0(:)A EP +%%Page: 22 22 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 50 S 2.75(2-)288 50 S/F1 10/Courier@0 +SF(Object vec =)100.346 86 Q/F2 10/Times-Italic@0 SF(ne)6 E 2.5(wv)-.15 G +(ector of the right size)201.246 86 Q F1(;)A(int i;)100.346 100 Q(GC_Node;) +100.346 114 Q(GC_Link\(vec\);)100.346 136.4 Q +(for \(i = 0; environ[i] != 0; i++\))100.346 150.4 Q +(VECTOR\(vec\)->data[i] = Make_String\(environ[i], strlen\(environ[i]\)\);) +127.846 164.4 Q F0(\()72 186.9 Q/F3 11/Times-Italic@0 SF(Mak)A(e_String\(\)) +-.11 E F0 .395(creates and initializes a ne)3.145 F 3.145(wS)-.275 G .395 +(cheme string.\))276.825 186.9 R .395(The body of the for)5.895 F .395 +(-loop contains a)-.22 F .636(subtle b)72 201.9 R .636(ug: depending on the co\ +mpiler used, the left hand side of the assignment \(the e)-.22 F(xpression) +-.165 E(in)72 216.9 Q -.22(vo)-.44 G(lving).22 E F3(vec)3.062 E F0 3.062(\)m)C +.312(ay be e)146.511 216.9 R -.275(va)-.275 G .312(luated before).275 F F3(Mak) +3.062 E(e_String\(\))-.11 E F0 .312(is in)3.062 F -.22(vo)-.44 G -.11(ke).22 G +3.062(d. As).11 F 3.062(ar)3.062 G .312(esult, a cop)396.852 216.9 R 3.062(yo) +-.11 G 3.062(ft)461.225 216.9 S .311(he con-)471.008 216.9 R 1.353(tents of)72 +231.9 R F3(vec)4.103 E F0 1.353(might be, for instance, stored in a re)4.103 F +1.354(gister before a g)-.165 F 1.354(arbage collection is triggered)-.055 F +.861(while e)72 246.9 R -.275(va)-.275 G .861 +(luating the right hand side of the assignment.).275 F .861(The g)6.361 F .861 +(arbage collector w)-.055 F .861(ould then mo)-.11 F -.165(ve)-.165 G 1.987 +(the v)72 261.9 R 1.987(ector object in memory)-.165 F 4.738(,u)-.715 G 1.988 +(pdating the\212properly GC-protected\212v)216.093 261.9 R(ariable)-.275 E F3 +(vec)4.738 E F0 4.738(,b)C 1.988(ut not the)458.466 261.9 R .011(temporary cop) +72 276.9 R 2.761(yi)-.11 G 2.761(nt)147.064 276.9 S .011(he re)158.383 276.9 R +(gister)-.165 E 2.761(,w)-.44 G .011(hich is no)217.365 276.9 R 2.761(wad)-.275 +G .011(angling reference.)283.739 276.9 R 1.771 -.88(To a)5.511 H -.22(vo).66 G +.01(id this, the loop must be).22 F(modi\214ed along these lines:)72 290.9 Q F1 +(for \(i = 0; environ[i]; i++\) {)100.346 313.403 Q +(Object temp = Make_String\(environ[i], strlen\(environ[i]\)\);)127.846 327.403 +Q(VECTOR\(vec\)->data[i] = temp;)127.846 341.403 Q(})100.346 355.403 Q F0 2.75 +(Ar)72 376.903 S(elated pitf)86.355 376.903 Q(all to w)-.11 E +(atch out for is e)-.11 E -.165(xe)-.165 G(mpli\214ed by this code fragment:) +.165 E F1(Object obj;)100.346 399.406 Q(...)100.346 413.406 Q(GC_Link\(obj\);) +100.346 427.406 Q(...)100.346 441.406 Q +(some_function\(obj, P_Cons\(car, cdr\)\);)100.346 455.406 Q F0 2.085 +(Here, the call to)72 477.906 R F3(P_Cons\(\))4.836 E F0 2.086(\212just lik)B +(e)-.11 E F3(Mak)4.836 E(e_String\(\))-.11 E F0(abo)4.836 E -.165(ve)-.165 G +2.086(\212can trigger a g).165 F 2.086(arbage collection.)-.055 F .112 +(Depending on the C compiler)72 492.906 R 2.861(,t)-.44 G .111 +(he properly GC-protected object pointer)210.829 492.906 R F3(obj)2.861 E F0 +.111(may be pushed on the)2.861 F(ar)72 507.906 Q .803(gument stack before) +-.198 F F3(P_Cons\(\))3.553 E F0 .803(is in)3.553 F -.22(vo)-.44 G -.11(ke).22 +G .804(d, as the order in which function ar).11 F .804(guments\212just lik) +-.198 F(e)-.11 E 1.088(the operands of the assignment operator\212are e)72 +522.906 R -.275(va)-.275 G 1.088(luated is unde\214ned in the C language.).275 +F 1.088(In this)6.588 F .062(case, if a g)72 537.906 R .062 +(arbage collection tak)-.055 F .062(es place and the heap object to which)-.11 +F F3(obj)2.812 E F0 .062(points is mo)2.812 F -.165(ve)-.165 G(d,).165 E F3 +(obj)2.813 E F0(will)2.813 E .181(be updated properly)72 552.906 R 2.931(,b) +-.715 G .181(ut the cop)170.586 552.906 R 2.931(yo)-.11 G 2.931(nt)228.153 +552.906 S .181(he stack will not.)239.642 552.906 R(Ag)5.681 E .181 +(ain, the problem can be a)-.055 F -.22(vo)-.22 G .181(ided easily).22 F .087 +(by assigning the result of the nested function call to a temporary)72 567.906 +R F3(Object)2.837 E F0 -.275(va)2.837 G .088(riable and use this v).275 F(ari-) +-.275 E(able in the enclosing function call:)72 581.906 Q F1 +(temp = P_Cons\(car, cdr\);)100.346 604.409 Q(some_function\(obj, temp\);) +100.346 618.409 Q/F4 11/Times-Bold@0 SF 2.75(9.2. Primiti)72 655.909 R -.11(ve) +-.11 G 2.75(sw).11 G(ith V)152.74 655.909 Q(ariable-Length Ar)-1.012 E +(gument Lists)-.11 E F0(Primiti)97 674.509 Q -.165(ve)-.275 G 2.91(sw).165 G +.159(ith a v)152.644 674.509 R .159(ariable number of ar)-.275 F .159 +(guments are re)-.198 F .159(gistered with the interpreter by calling)-.165 F +F3(De\214ne_Primitive\(\))72 689.509 Q F0 1.619(with the calling discipline) +4.369 F F3 -.66(VA)4.37 G(RARGS).66 E F0 1.62(and with dif)4.37 F 1.62 +(ferent v)-.275 F 1.62(alues for)-.275 F F3(minar)4.37 E(gs)-.407 E F0(and)72 +704.509 Q F3(maxar)3.329 E(gs)-.407 E F0 6.079(.T)C .579(he special symbol) +144.24 704.509 R F3(MANY)3.329 E F0 .578(can be gi)3.329 F -.165(ve)-.275 G +3.328(na).165 G 3.328(st)324.741 704.509 S .578(he maximum number of ar)335.406 +704.509 R .578(guments to)-.198 F .945 +(indicate that there is no upper limit on the primiti)72 719.509 R -.165(ve) +-.275 G 2.155 -.605('s n).165 H .945(umber of actual ar).605 F 3.695 +(guments. The)-.198 F(C/C++)3.696 E 2.781(function implementing a primiti)72 +734.509 R 3.11 -.165(ve w)-.275 H 2.78(ith a v).165 F 2.78 +(ariable number of ar)-.275 F 2.78(guments is called with tw)-.198 F(o)-.11 E +EP +%%Page: 23 23 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(3-)288 51 S(ar)72 87 Q .514 +(guments: an inte)-.198 F .514 +(ger count that speci\214es the number of actual ar)-.165 F .515 +(guments, and the Scheme ar)-.198 F(gu-)-.198 E 1.128(ments as an array of)72 +102 R/F1 11/Times-Italic@0 SF(Objects)3.878 E F0 1.128(\(that is, a pointer to) +3.878 F F1(Object)3.878 E F0 3.877(\). The)B 1.127(objects passed as the ar) +3.877 F(gument)-.198 E -.165(ve)72 117 S 3.742(ctor of).165 F F1 -.66(VA)6.492 +G(RARGS).66 E F0(primiti)6.492 E -.165(ve)-.275 G 6.492(sa).165 G 3.742 +(re already re)229.902 117 R 3.743(gistered with the g)-.165 F 3.743 +(arbage collector; calls to)-.055 F F1(GC_Link\(\))72 132 Q F0 1.503 +(are not required.)4.253 F 1.503(As an e)7.003 F 1.502(xample for a primiti) +-.165 F 1.832 -.165(ve w)-.275 H 1.502(ith an arbitrary number of ar).165 F +(gu-)-.198 E 1.463(ments, here is the de\214nition of a simpli\214ed v)72 147 R +1.464(ariant of)-.275 F F1(append!)4.214 E F0 1.464 +(\(which does not handle empty)6.964 F(lists\):)72 161 Q/F2 10/Courier@0 SF +(Object p_append_set \(int argc, Object *argv\); {)100.346 183.503 Q(int i;) +127.846 197.503 Q(for \(i = 0; i < argc-1; i++\))127.846 219.903 Q +(\(void\)P_Set_Cdr \(P_Last_Pair \(argv[i]\), argv[i+1]\);)155.346 233.903 Q +(return *argv;)127.846 247.903 Q(})100.346 261.903 Q F0 +(The corresponding call to)72 283.403 Q F1(De\214ne_Primitive\(\))2.75 E F0 +-.11(wo)2.75 G(uld read:).11 E F2 +(Define_Primitive\(p_append_set, "append!", 0, MANY, VARARGS\);)100.346 305.906 +Q F0 1.929(Besides implementing primiti)97 332.006 R -.165(ve)-.275 G 4.679(sw) +.165 G 1.928(ith an inde\214nite maximum number of ar)258.492 332.006 R 1.928 +(guments, the)-.198 F F1 -.66(VA)72 347.006 S(RARGS).66 E F0 .359 +(discipline is frequently used for primiti)3.109 F -.165(ve)-.275 G 3.109(sw) +.165 G .36(ith an optional ar)320.583 347.006 R 3.11(gument. F)-.198 F .36 +(or e)-.165 F .36(xample, a)-.165 F(primiti)72 362.006 Q 1.171 -.165(ve e)-.275 +H .841(ncapsulating the UNIX).165 F F1(open\(\))3.591 E F0 .84 +(system call, which has tw)3.59 F 3.59<6f8c>-.11 G -.165(xe)391.176 362.006 S +3.59(da).165 G -.198(rg)415.369 362.006 S .84(uments \(\214lename,).198 F 1.271 +(\215ags\) and an optional third ar)72 377.006 R 1.271 +(gument \(the mode for ne)-.198 F 1.271(wly created \214les, i.)-.275 F 1.272 +(e. calls with the \215ag)1.833 F F1(O_CREA)72 391.006 Q(T)-.407 E F0 +(\), could be de\214ned as follo)A(ws:)-.275 E F2 +(Object p_unix_open\(int argc, Object *argv\) {)100.346 413.509 Q +(char *name = get_file_name\(argv[0]\);)127.846 427.509 Q +(int flags = get_flags\(argv[1]\);)127.846 441.509 Q(mode_t mode;)127.846 +455.509 Q(if \(flags & O_CREAT\) {)127.846 477.909 Q(if \(argc < 3\))155.346 +491.909 Q/F3 10/Times-Italic@0 SF(err)182.846 505.909 Q(or)-.45 E(--too fe)-.2 +E 2.5(wa)-.15 G -.37(rg)246.486 505.909 S(uments).37 E F2 +(mode = get_mode\(argv[2]\);)155.346 519.909 Q(...)155.346 533.909 Q F0 +(The call to)72 555.409 Q F1(De\214ne_Primitive\(\))2.75 E F0 +(could then be written as:)2.75 E F2 +(Define_Primitive\(p_unix_open, "unix-open", 2, 3, VARARGS\);)100.346 577.912 Q +/F4 11/Times-Bold@0 SF 2.75(10. Pr)72 615.412 R(ede\214ned Scheme T)-.198 E +(ypes)-.814 E F0 1.108 +(This chapter introduces the Scheme types prede\214ned by Elk.)97 634.012 R +1.107(It be)6.607 F 1.107(gins with the `)-.165 F(`pointer)-.814 E(-)-.22 E +(less')72 649.012 Q 2.851('t)-.814 G .101(ypes such as boolean, whose v)100.921 +649.012 R .102(alues are stored directly in the pointer \214eld of an)-.275 F +F1(Object)2.852 E F0 2.852(;f)C(ol-)491.779 649.012 Q(lo)72 664.012 Q +(wed by the types whose members are C)-.275 E F1(structs)2.75 E F0 +(that reside on the Scheme heap.)2.75 E EP +%%Page: 24 24 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(4-)288 51 S/F1 11 +/Times-Bold@0 SF 2.75(10.1. Booleans)72 87 R(\(T_Boolean\))2.75 E/F2 11 +/Times-Italic@0 SF(Objects)97 105.6 Q F0 .502(of type)3.252 F F2(T_Boolean) +3.252 E F0 .502(can hold the v)3.252 F .502(alues #t and #f.)-.275 F -1.1 -.88 +(Tw o)6.002 H F2(Objects)4.132 E F0 .501(initialized to #t and)3.252 F +(#f, respecti)72 119.6 Q -.165(ve)-.275 G(ly).165 E 2.75(,a)-.715 G(re a) +149.044 119.6 Q -.275(va)-.22 G(ilable as the e).275 E(xternal C v)-.165 E +(ariables)-.275 E F2 -.605(Tr)2.75 G(ue).605 E F0(and)2.75 E F2 -.825(Fa)2.75 G +(lse).825 E F0 5.5(.T)C(he macro)400.845 119.6 Q/F3 10/Courier@0 SF +(Truep\(obj\))100.346 142.103 Q F0 .933 +(can be used to check whether an arbitrary Scheme object is re)72 164.603 R +-.055(ga)-.165 G .933(rded as true.).055 F .933(Use of)6.433 F F2 -.605(Tr) +3.683 G(uep\(\)).605 E F0(is)3.683 E(not necessarily equi)72 178.603 Q -.275 +(va)-.275 G(lent to).275 E F3(!EQ\(obj,False\))100.346 201.106 Q F0 1.236 +(because the empty list may count as f)72 223.606 R 1.235 +(alse in addition to #f if backw)-.11 F 1.235(ards compatibility to older)-.11 +F .095(Scheme language v)72 238.606 R .095(ersions has been enabled.)-.165 F F2 +-.605(Tr)5.595 G(uep\(\)).605 E F0 .095(may e)2.845 F -.275(va)-.275 G .096 +(luate its ar).275 F .096(gument twice and should)-.198 F(therefore not be in) +72 253.606 Q -.22(vo)-.44 G -.11(ke).22 G 2.75(dw).11 G +(ith a function call or a comple)189.755 253.606 Q 2.75(xe)-.165 G(xpression.) +334.537 253.606 Q(The tw)72 271.206 Q 2.75(of)-.11 G(unctions)114.658 271.206 Q +F3(int Eqv\(Object, Object\);)100.346 293.709 Q(int Equal\(Object, Object\);) +100.346 307.709 Q F0 .921(are identical to the primiti)72 330.209 R -.165(ve) +-.275 G(s).165 E F2(P_Eqv\(\))3.67 E F0(and)3.67 E F2(P_Equal\(\))3.67 E F0 +3.67(,e)C .92(xcept that the)324.684 330.209 R 3.67(yr)-.165 G .92 +(eturn a C inte)398.46 330.209 R .92(ger rather)-.165 F +(than a Scheme boolean and therefore can be used more con)72 345.209 Q -.165 +(ve)-.44 G(niently in C/C++.).165 E F1 2.75(10.2. Characters)72 375.209 R +(\(T_Character\))2.75 E F0(The character v)97 392.809 Q(alue stored in an)-.275 +E F2(Object)2.75 E F0(of type)2.75 E F2(T_Char)2.75 E(acter)-.165 E F0 +(can be obtained by the macro)2.75 E F3(CHAR\(char_obj\))100.346 415.312 Q F0 +(as a non-ne)72 436.812 Q -.055(ga)-.165 G(ti).055 E -.165(ve)-.275 G F2(int) +2.915 E F0 5.5(.A)C(ne)181.626 436.812 Q 2.75(wc)-.275 G +(haracter object is created by calling the function)207.311 436.812 Q F3 +(Object Make_Char\(int c\);)100.346 459.315 Q F0(The prede\214ned e)72 481.815 +Q(xternal C v)-.165 E(ariable)-.275 E F2(Ne)2.75 E(wline)-.165 E F0 +(holds the ne)2.75 E(wline character as a Scheme)-.275 E F2(Object)2.75 E F0(.) +A F1 2.75(10.3. Empty)72 511.815 R(List \(T_Null\))2.75 E F0 .319(The type)97 +530.415 R F2(T_Null)3.069 E F0 .319(has e)3.069 F .32 +(xactly one member\212the empty list; hence all)-.165 F F2(Objects)3.07 E F0 +.32(of this type are)3.07 F 3.399(identical. The)72 545.415 R .648 +(empty list is a)3.399 F -.275(va)-.22 G .648(ilable as the e).275 F .648 +(xternal C v)-.165 F(ariable)-.275 E F2(Null)3.398 E F0 6.148(.T)C .648(his v) +392.31 545.415 R .648(ariable is often used)-.275 F .07(to initialize)72 +560.415 R F2(Objects)2.82 E F0 .07(that will be assigned their real v)2.82 F +.07(alues later)-.275 F 2.82(,f)-.44 G .071(or e)355.569 560.415 R .071 +(xample, as the \214ll element for)-.165 F(ne)72 575.415 Q 1.395(wly created v) +-.275 F 1.395(ectors or to initialize)-.165 F F2(Objects)4.145 E F0 1.395 +(in order to)4.145 F F2(GC_Link\(\))4.144 E F0 4.144(them. A)4.144 F(macro) +4.144 E F2(Nullp\(\))4.144 E F0(is)4.144 E(pro)72 589.415 Q +(vided as a shorthand for checking if an)-.165 E F2(Object)2.75 E F0 +(is the empty list:)2.75 E F3(#define Nullp\(obj\))100.346 611.918 Q +(\(TYPE\(obj\) == T_Null\))220.346 611.918 Q F0 +(This macro is used frequently in the termination condition of for)72 633.418 Q +(-loops that scan a Scheme list:)-.22 E F3(Object tail;)100.346 655.921 Q(...) +100.346 669.921 Q(for \(tail = some_list; !Nullp\(tail\); tail = Cdr\(tail\)\)) +100.346 683.921 Q(process_element\(Car\(tail\)\);)127.846 697.921 Q F0(\()72 +720.421 Q F2(Car\(\))A F0(and)3.4 E F2(Cdr\(\))3.4 E F0 .65 +(essentially are shorthands for)3.4 F F2(P_Car\(\))3.4 E F0(and)3.4 E F2 +(P_Cdr\(\))3.4 E F0 .651(and will be re)3.4 F .651(visited in the)-.275 F EP +%%Page: 25 25 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(5-)288 51 S +(section on pairs\).)72 87 Q/F1 11/Times-Bold@0 SF 2.75(10.4. End)72 117 R +(of File \(T_End_Of_File\))2.75 E F0 .745(The type)97 135.6 R/F2 11 +/Times-Italic@0 SF(T_End_Of_F)3.495 E(ile)-.495 E F0 .745 +(has one member\212the end-of-\214le object\212and is only rarely used)3.495 F +.906(from within user)72 150.6 R .906(-supplied C/C++ code.)-.22 F .906(The e) +6.406 F .906(xternal C v)-.165 F(ariable)-.275 E F2(Eof)3.657 E F0 .907 +(is initialized to the end-of-)3.657 F(\214le object.)72 165.6 Q F1 2.75 +(10.5. Integers)72 195.6 R(\(T_Fixnum and T_Bignum\))2.75 E F0(Inte)97 214.2 Q +1.875(gers come in tw)-.165 F 4.624<6f8d>-.11 G -.22(avo)205.655 214.2 S(rs:) +.22 E F2(\214xnums)4.624 E F0(and)4.624 E F2(bignums)4.624 E F0 7.374(.T)C +1.874(he former ha)349.584 214.2 R 2.204 -.165(ve t)-.22 H 1.874(heir v).165 F +1.874(alue stored)-.275 F .493 +(directly in the pointer \214eld and are wide enough to hold most C)72 229.2 R +F2(ints)3.243 E F0 5.993(.B)C .493(ignums can hold inte)392.389 229.2 R(gers) +-.165 E 1.481(of arbitrary size and are stored in the heap.)72 244.2 R -1.1 +-.88(Tw o)6.981 H 1.481(macros are pro)5.111 F 1.481 +(vided to test whether a gi)-.165 F -.165(ve)-.275 G(n).165 E +(signed \(or unsigned, respecti)72 258.2 Q -.165(ve)-.275 G(ly\) inte).165 E +(ger \214ts into a \214xnum:)-.165 E/F3 10/Courier@0 SF(FIXNUM_FITS\(integer\)) +100.346 280.703 Q(UFIXNUM_FITS\(unsigned_integer\))100.346 294.703 Q F0 .001 +(The former al)72 317.203 R -.11(wa)-.11 G .001(ys returns 1 in Elk 3.0, b).11 +F .001(ut the range of inte)-.22 F .001(ger v)-.165 F .001 +(alues that can be represented as a)-.275 F .555 +(\214xnum may be restricted in future re)72 332.203 R 3.305(visions. It)-.275 F +.555(is guaranteed, ho)3.305 F(we)-.275 E -.165(ve)-.275 G 1.434 -.44(r, t).165 +H .554(hat at least tw).44 F 3.304(ob)-.11 G .554(its less)473.801 332.203 R +(than the machine')72 347.203 Q 2.75(sw)-.605 G(ord size will be a)165.071 +347.203 Q -.275(va)-.22 G(ilable for \214xnums in future v).275 E +(ersions of Elk.)-.165 E(The v)72 364.803 Q +(alue stored in a \214xnum can be obtained as a C)-.275 E F2(int)2.75 E F0 +(by calling the macro)2.75 E F3(FIXNUM\(fixnum_obj\))100.346 387.306 Q F0 2.75 +(Am)72 408.806 S(acro)91.25 408.806 Q F3(Check_Integer\(obj\))100.346 431.309 Q +F0 .082(can be used as a shorthand for checking whether an)72 453.809 R F2 +(Object)2.832 E F0 .082(is a \214xnum or a bignum and raising an)2.832 F +(error otherwise.)72 468.809 Q(The follo)72 486.409 Q(wing functions are pro) +-.275 E(vided to con)-.165 E -.165(ve)-.44 G(rt C inte).165 E +(gers to Scheme inte)-.165 E(gers:)-.165 E F3(Object Make_Integer\(int\);) +100.346 508.912 Q(Object Make_Unsigned\(unsigned\);)100.346 522.912 Q +(Object Make_Long\(long\);)100.346 536.912 Q +(Object Make_Unsigned_Long\(unsigned long\);)100.346 550.912 Q F2(Mak)72 +573.412 Q(e_Inte)-.11 E -.11(ge)-.44 G(r\(\)).11 E F0 .832 +(returns a \214xnum object if)3.583 F F2(FIXNUM_FITS\(\))3.582 E F0 .832 +(returns true for the ar)3.582 F .832(gument, other)-.198 F(-)-.22 E 2.369 +(wise a bignum.)72 588.412 R(Lik)7.869 E -.275(ew)-.11 G(ise,).275 E F2(Mak) +5.119 E(e_Long\(\))-.11 E F0 2.369(usually returns a \214xnum b)5.119 F 2.37 +(ut may ha)-.22 F 2.7 -.165(ve t)-.22 H 5.12(or).165 G 2.37(esort to)468.938 +588.412 R 2.585(bignums on architectures where a C)72 603.412 R F2(long)5.335 E +F0 2.585(is wider than an)5.335 F F2(int)5.335 E F0(.)A F2(Mak)8.084 E +(e_Unsigned\(\))-.11 E F0 2.584(returns a)5.334 F 2.58 +(bignum if the speci\214ed inte)72 618.412 R 2.58(ger is lar)-.165 F 2.581 +(ger than the lar)-.198 F 2.581(gest positi)-.198 F -.165(ve)-.275 G F2(int) +5.496 E F0 2.581(that \214ts into a \214xnum)5.331 F(\()72 633.412 Q F2 +(UFIXNUM_FITS\(\))A F0 .168(returns zero in this case\).)2.918 F .167 +(Another set of functions con)5.667 F -.165(ve)-.44 G .167(rt a Scheme number) +.165 F(to a C inte)72 647.412 Q(ger:)-.165 E EP +%%Page: 26 26 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(6-)288 51 S/F1 10/Courier@0 +SF(int Get_Integer\(Object\);)100.346 86 Q(int Get_Exact_Integer\(Object\);) +100.346 100 Q(unsigned Get_Unsigned\(Object\);)100.346 122.4 Q +(unsigned Get_Exact_Unsigned\(Object\);)100.346 136.4 Q +(long Get_Long\(Object\);)100.346 158.8 Q(long Get_Exact_Long\(Object\);) +100.346 172.8 Q(unsigned long Get_Unsigned_Long\(Object\);)100.346 195.2 Q +(unsigned long Get_Exact_Unsigned_Long\(Object\);)100.346 209.2 Q F0 +(These functions signal an error if one of the follo)72 231.7 Q +(wing conditions is true:)-.275 E 21.15<8374>97 250.3 S 1.384(he ar)125.058 +250.3 R 1.385(gument is neither a \214xnum, nor a bignum, nor a \215onum \(rea\ +l number\) with a)-.198 F +(fractional part of zero \(more about \215onums in the ne)122 265.3 Q +(xt section\);)-.165 E 21.15<8374>97 283.9 S(he function is one of the `) +125.058 283.9 Q(`unsigned')-.814 E 2.75('v)-.814 G(ariants and the ar)295.151 +283.9 Q(gument is a ne)-.198 E -.055(ga)-.165 G(ti).055 E .33 -.165(ve n)-.275 +H(umber;).165 E 21.15<8374>97 302.5 S(he ar)125.058 302.5 Q +(gument is a bignum too lar)-.198 E(ge for the respecti)-.198 E .33 -.165(ve r) +-.275 H(eturn type;).165 E 21.15<8374>97 321.1 S .456 +(he function is one of the `)125.058 321.1 R(`e)-.814 E(xact')-.165 E 3.205('v) +-.814 G .455(ariants and the ar)281.665 321.1 R .455 +(gument is neither a \214xnum nor a)-.198 F(bignum;)122 336.1 Q 21.15<8374>97 +354.7 S(he ar)125.058 354.7 Q +(gument is a \215onum that cannot be coerced to the respecti)-.198 E .33 -.165 +(ve r)-.275 H(eturn type.).165 E .296(As all of the abo)72 373.3 R .627 -.165 +(ve f)-.165 H .297(unctions include suitable type-checks, primiti).165 F -.165 +(ve)-.275 G 3.047(sr).165 G(ecei)384.903 373.3 Q .297(ving inte)-.275 F .297 +(ger ar)-.165 F(guments)-.198 E .974 +(can be written in a simple and straightforw)72 388.3 R .974(ard w)-.11 F(ay) +-.11 E 6.474(.F)-.715 G .974(or e)317.652 388.3 R .974(xample, a primiti)-.165 +F 1.304 -.165(ve e)-.275 H .974(ncapsulating the).165 F(UNIX)72 403.3 Q/F2 11 +/Times-Italic@0 SF(dup)3.982 E F0 1.232(system call \(which returns an inte) +3.982 F 1.233(ger \214le descriptor pointing to the same \214le as the)-.165 F +(original one\) can be written as:)72 417.3 Q F1 +(Object p_unix_dup\(Object fd\) {)100.346 439.803 Q +(return Make_Integer\(dup\(Get_Exact_Unsigned\(fd\)\)\);)124.346 453.803 Q F0 +.875(Note that if)72 476.303 R F2(Get_Unsigned\(\))3.625 E F0(\(or)3.625 E F2 +(Get_Inte)3.625 E -.11(ge)-.44 G(r\(\)).11 E F0 3.625(\)h)C .875 +(ad been used here in place of the `)291.145 476.303 R(`e)-.814 E(xact')-.165 E +3.624('c)-.814 G(on-)489.337 476.303 Q -.165(ve)72 490.303 S +(rsion function, it w).165 E(ould be possible to write e)-.11 E +(xpressions such as:)-.165 E F1(\(define fd \(unix-dup \(truncate 1.2\)\)\)) +100.346 512.806 Q/F3 11/Times-Bold@0 SF 2.75(10.6. Floating)72 550.306 R -.22 +(Po)2.75 G(int Numbers \(T_Flonum\)).22 E F0 .795(Real and ine)97 568.906 R +.795(xact numbers are represented as)-.165 F F2(Objects)3.545 E F0 .796 +(of type)3.545 F F2(T_Flonum)3.546 E F0 6.296(.E)C .796(ach such object)434.593 +568.906 R .17(holds a pointer to a structure on the heap with a component)72 +583.906 R F2(val)2.92 E F0 .17(of type)2.92 F F2(double)2.92 E F0 2.92(,s)C +2.92(ot)427.59 583.906 S .17(hat the e)439.068 583.906 R(xpres-)-.165 E(sion)72 +597.906 Q F1(FLONUM\(flonum_obj\)->val)100.346 620.409 Q F0 .213 +(can be used to obtain the)72 642.909 R F2(double)2.963 E F0 -.275(va)2.963 G +2.963(lue. T).275 F 2.963(oc)-.88 G(on)269.2 642.909 Q -.165(ve)-.44 G .213 +(rt a Scheme number to a).165 F F2(double)2.963 E F0(re)2.963 E -.055(ga)-.165 +G .214(rdless of its).055 F(type, the more general function)72 656.909 Q F1 +(double Get_Double\(Object\);)100.346 679.412 Q F0 1.144(can be used.)72 +701.912 R 1.144(It raises an error if the ar)6.644 F 1.144 +(gument is not a \214xnum, bignum, or \215onum, or if it is a)-.198 F +(bignum too lar)72 716.912 Q(ge to \214t into a)-.198 E F2(double)2.75 E F0(.)A +EP +%%Page: 27 27 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(7-)288 51 S(The functions)72 +86 Q/F1 10/Courier@0 SF(Object Make_Flonum\(double\);)100.346 108.503 Q +(Object Make_Reduced_Flonum\(double\);)100.346 122.503 Q F0(con)72 145.003 Q +-.165(ve)-.44 G .18(rt a C).165 F/F2 11/Times-Italic@0 SF(double)2.93 E F0 .181 +(to a \215onum; the latter returns a \214xnum if the)2.93 F F2(double)2.931 E +F0 .181(is small enough to \214t into)2.931 F 2.75<618c>72 159.003 S +(xnum and has a fractional part of zero.)85.75 159.003 Q(The macro)5.5 E F1 +(Check_Number\(obj\))100.346 181.506 Q F0 .493(checks whether the gi)72 204.006 +R -.165(ve)-.275 G(n).165 E F2(Object)3.243 E F0 .493 +(is a number \(that is, a \214xnum, bignum, or \215onum in the current)3.243 F +(re)72 219.006 Q(vision of Elk\) and raises an error otherwise.)-.275 E/F3 11 +/Times-Bold@0 SF 2.75(10.7. P)72 249.006 R(airs \(T_P)-.11 E(air\))-.11 E F0 +-.165(Pa)97 266.606 S(irs ha).165 E .33 -.165(ve t)-.22 H .22 -.11(wo c).165 H +(omponents of type).11 E F2(Object)2.75 E F0 2.75(,t)C(he car and the cdr) +291.26 266.606 Q 2.75(,t)-.44 G(hat can be accessed as:)377.566 266.606 Q F1 +(PAIR\(pair_obj\)->car)100.346 289.109 Q(PAIR\(pair_obj\)->cdr)100.346 303.109 +Q F0 -1.1 -.88(Tw o)72 325.609 T(macros)3.836 E F2(Car\(\))2.956 E F0(and)2.956 +E F2(Cdr\(\))2.956 E F0 .206(are pro)2.956 F .207 +(vided as shorthands for these e)-.165 F .207(xpressions, and another macro) +-.165 F F2(Cons\(\))72 339.609 Q F0(can be used in place of)2.75 E F2 +(P_Cons\(\))2.75 E F0(to create a ne)2.75 E 2.75(wp)-.275 G(air)327.101 339.609 +Q 5.5(.T)-.605 G(he macro)353.072 339.609 Q F1(Check_List\(obj\))100.346 +362.112 Q F0 .932(checks whether the speci\214ed)72 384.612 R F2(Object)3.682 E +F0 .931(is either a pair or the empty list and signals an error other)3.682 F +(-)-.22 E 2.75(wise. The)72 398.612 R(prede\214ned function)2.75 E F1 +(int Fast_Length\(Object list\);)100.346 421.115 Q F0 .634 +(can be used to compute the length of the gi)72 443.615 R -.165(ve)-.275 G +3.385(nS).165 G .635(cheme list.)291.765 443.615 R .635 +(This function is more ef)6.135 F .635(\214cient than)-.275 F 1.859 +(the primiti)72 458.615 R -.165(ve)-.275 G F2(P_Length\(\))4.774 E F0 4.609(,b) +C 1.859(ecause it neither checks the type of the ar)197.521 458.615 R 1.858 +(gument nor whether the)-.198 F(gi)72 472.615 Q -.165(ve)-.275 G 2.75(nl).165 G +(ist is proper)101.81 472.615 Q 2.75(,a)-.44 G(nd the result need not be con) +163.696 472.615 Q -.165(ve)-.44 G(rted to a Scheme number).165 E 5.5(.T)-.605 G +(he function)424.297 472.615 Q F1(Object Copy_List\(Object list\);)100.346 +495.118 Q F0(returns a cop)72 517.618 Q 2.75(yo)-.11 G 2.75(ft)142.455 517.618 +S(he speci\214ed list \(including all its sublists\).)151.926 517.618 Q .349 +(As e)97 536.218 R .349(xplained in section 9.1, care must be tak)-.165 F .349 +(en when mixing calls to these macros, because)-.11 F F2(Cons\(\))72 550.218 Q +F0(may trigger a g)2.75 E(arbage collection: an e)-.055 E(xpression such as) +-.165 E F1(Car\(x\) = Cons\(y, z\);)100.346 572.721 Q F0(is wrong, e)72 594.221 +Q -.165(ve)-.275 G 2.75(ni).165 G(f)141.828 594.221 Q F2(x)2.75 E F0 +(is properly `)2.75 E(`GC_Link)-.814 E(ed')-.11 E(', and should be replaced by) +-.814 E F1(tmp = Cons\(x, y\);)100.346 616.724 Q(Car\(x\) = tmp;)100.346 +630.724 Q F0(or a similar sequence.)72 653.224 Q F3 2.75(10.8. Symbols)72 +683.224 R(\(T_Symbol\))2.75 E F2(Objects)97 701.824 Q F0 1.564(of type)4.314 F +F2(T_Symbol)4.314 E F0(ha)4.314 E 1.894 -.165(ve o)-.22 H 1.564 +(ne public component\212the symbol').165 F 4.314(sn)-.605 G 1.563 +(ame as a Scheme)423.861 701.824 R(string \(that is, an)72 715.824 Q F2(Object) +2.75 E F0(of type)2.75 E F2(T_String)2.75 E F0(\):)A EP +%%Page: 28 28 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 50 S 2.75(8-)288 50 S/F1 10/Courier@0 +SF(SYMBOL\(symbol_obj\)->name)100.346 86 Q F0 2.75(An)72 107.5 S .55 -.275 +(ew s)88.192 107.5 T(ymbol can be created by calling one of the functions).275 +E F1(Object Intern\(const char *\);)100.346 130.003 Q +(Object CI_Intern\(const char *\);)100.346 144.003 Q F0 2.465(with the ne)72 +166.503 R 5.215(ws)-.275 G(ymbol')142.975 166.503 Q 5.215(sn)-.605 G 2.465 +(ame as the ar)189.143 166.503 R(gument.)-.198 E/F2 11/Times-Italic@0 SF +(CI_Intern\(\))7.966 E F0 2.466(is the case-insensiti)5.216 F 2.796 -.165(ve v) +-.275 H 2.466(ariant of)-.11 F F2(Intern\(\))72 181.503 Q F0 3.039(;i)C 3.039 +(tm)115.365 181.503 S .289(aps all upper case characters to lo)130.02 181.503 R +.289(wer case.)-.275 F F2(EQ\(\))5.788 E F0 .288(yields true for all)3.038 F F2 +(Objects)3.038 E F0(returned)3.038 E .953(by calls to)72 196.503 R F2 +(Intern\(\))3.703 E F0 .953(with strings with the same contents \(or calls to) +3.703 F F2(CI_Intern\(\))3.704 E F0 .954(with strings that)3.704 F 1.34 +(are identical after case con)72 211.503 R -.165(ve)-.44 G 4.089(rsion\). This) +.165 F 1.339(is the main property that distinguishes symbols from)4.089 F +(strings in Scheme.)72 226.503 Q 3.4(As)97 245.103 S .651 +(ymbol that is used by more than one function can be stored in a global v) +112.621 245.103 R .651(ariable to sa)-.275 F -.165(ve)-.22 G(calls to)72 +259.103 Q F2(Intern\(\))2.75 E F0 5.5(.T)C(his can be done using the con) +155.402 259.103 Q -.165(ve)-.44 G(nience function).165 E F1 +(void Define_Symbol\(Object *var, const char *name\);)100.346 281.606 Q F2 +(De\214ne_Symbol\(\))72 304.106 Q F0 2.09(is called with the address of a v) +4.84 F 2.09(ariable where the ne)-.275 F 2.089(wly-interned symbol is)-.275 F +.117(stored and the name of the symbol to be handed to)72 319.106 R F2 +(Intern\(\))2.867 E F0 5.617(.T)C .117(he function adds the ne)347.139 319.106 +R 2.868(ws)-.275 G .118(ymbol to)464.458 319.106 R(the g)72 333.106 Q +(arbage collector')-.055 E 2.75(sr)-.605 G(oot set to mak)177.941 333.106 Q +2.75(ei)-.11 G 2.75(tr)250.552 333.106 S +(eachable \(as described in section 12.3.)260.023 333.106 Q(Example:)5.5 E F1 +(static Object sym_else;)100.346 355.609 Q(...)100.346 369.609 Q +(void elk_init_example\(void\) {)100.346 383.609 Q +(Define_Symbol\(&sym_else, "else"\);)127.846 397.609 Q(...)127.846 411.609 Q(}) +100.346 425.609 Q/F3 11/Times-Bold@0 SF 2.75(10.8.1. The)72 463.109 R +(Non-Printing Symbol)2.75 E F0 1.077(By con)97 481.709 R -.165(ve)-.44 G 1.077 +(ntion, Scheme primiti).165 F -.165(ve)-.275 G 3.827(st).165 G 1.077 +(hat do not ha)258.234 481.709 R 1.406 -.165(ve a u)-.22 H 1.076 +(seful return v).165 F 1.076(alue \(for e)-.275 F 1.076(xample the)-.165 F .406 +(output primiti)72 496.709 R -.165(ve)-.275 G .406(s\) return the `).165 F .407 +(`non-printing symbol')-.814 F 3.157('i)-.814 G 3.157(nE)310.081 496.709 S +3.157(lk. The)325.459 496.709 R .407(name of this symbol consists of)3.157 F +.781(the empty string; it does not produce an)72 511.709 R 3.531(yo)-.165 G +.781(utput when it is printed, for e)266.293 511.709 R .78 +(xample, by the tople)-.165 F -.165(ve)-.275 G(l).165 E(read-e)72 526.709 Q +-.275(va)-.275 G 1.642(l-print loop.).275 F 1.642 +(In Scheme code, the non-printing symbol can be generated by using the)7.142 F +.096(reader syntax `)72 541.709 R(`#v')-.814 E 2.846('o)-.814 G 2.846(rb) +166.261 541.709 S 2.846(yc)178.27 541.709 S(alling)191.5 541.709 Q F2(string) +2.846 E/F4 11/Symbol SF(-)A F2(>symbol)A F0 .096(with the empty string.)2.846 F +.096(On the C language le)5.596 F -.165(ve)-.275 G(l,).165 E .131 +(the non-printing symbol is a)72 556.709 R -.275(va)-.22 G .132 +(ilable as the e).275 F .132(xternal v)-.165 F(ariable)-.275 E F2 -1.221(Vo) +2.882 G(id)1.221 E F0 2.882(,s)C 2.882(ot)367.82 556.709 S .132(hat primiti) +379.26 556.709 R -.165(ve)-.275 G 2.882(sl).165 G .132(acking a use-)445.7 +556.709 R(ful return v)72 570.709 Q(alue can use)-.275 E F1(return Void;) +100.346 593.212 Q F3 2.75(10.9. Strings)72 630.712 R(\(T_String\))2.75 E F2 +(Objects)97 649.312 Q F0 .627(of type string ha)3.377 F .957 -.165(ve t)-.22 H +.847 -.11(wo c).165 H .627 +(omponents\212the length and the contents of the string as a).11 F(pointer to) +72 663.312 Q F2 -.165(ch)2.75 G(ar).165 E F0(:)A F1(STRING\(string_obj\)->size) +100.346 685.815 Q(STRING\(string_obj\)->data)100.346 699.815 Q F0(The)72 +722.315 Q F2(data)3.854 E F0 1.105(component is not null-terminated, as a stri\ +ng itself may contain a null-byte as a v)3.854 F(alid)-.275 E EP +%%Page: 29 29 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(9-)288 51 S +(character in Elk.)72 86 Q 2.75(AS)5.5 G +(cheme string is created by calling the function)166.699 86 Q/F1 10/Courier@0 +SF(Object Make_String\(const char *init, int size\);)100.346 108.503 Q/F2 11 +/Times-Italic@0 SF(size)72 131.003 Q F0 1.328(is the length of the ne)4.078 F +1.328(wly-created string.)-.275 F F2(init)6.828 E F0 1.327 +(is either the null-pointer or a pointer to)4.078 F F2(size)4.077 E F0 +(characters that are copied into the ne)72 145.003 Q 2.75(wS)-.275 G +(cheme string.)249.815 145.003 Q -.165(Fo)5.5 G 2.75(re).165 G +(xample, the sequence)337.166 145.003 Q F1(Object str;)100.346 167.506 Q(...) +100.346 181.506 Q(str = Make_String\(0, 100\);)100.346 195.506 Q +(bzero\(STRING\(str\)->data, 100\);)100.346 209.506 Q F0 +(generates a string holding 100 null-bytes.)72 232.006 Q .136(Most primiti)97 +250.606 R -.165(ve)-.275 G 2.886(st).165 G .136(hat recei)172.622 250.606 R +.466 -.165(ve a S)-.275 H .136(cheme string as one of their ar).165 F .137 +(guments pass the string')-.198 F 2.887(sc)-.605 G(on-)489.337 250.606 Q .009 +(tents to a C function \(for e)72 265.606 R .009 +(xample a C library function\) that e)-.165 F .008(xpects an ordinary)-.165 F +2.758(,n)-.715 G .008(ull-terminated C)431.579 265.606 R 2.75(string. F)72 +279.606 R(or this purpose Elk pro)-.165 E(vides a function)-.165 E F1 +(char *Get_String\(Object\);)100.346 302.109 Q F0 .318 +(that returns the contents of the Scheme string ar)72 324.609 R .318 +(gument as a null-terminated C string.)-.198 F .319(An error is)5.818 F 1.376 +(raised if the ar)72 339.609 R 1.376(gument is not a string.)-.198 F F2 +(Get_String\(\))6.876 E F0 1.376(has to create a cop)4.126 F 4.126(yo)-.11 G +4.126(ft)411.123 339.609 S 1.376(he contents of the)421.97 339.609 R .528 +(Scheme string in order to append the null-character)72 354.609 R 6.029(.T) +-.605 G 3.279(oa)315.464 354.609 S -.22(vo)328.907 354.609 S .529 +(id requiring the caller to pro).22 F .529(vide and)-.165 F .858 +(release space for the cop)72 369.609 R -.715(y,)-.11 G F2(Get_String\(\))4.323 +E F0 .858(operates on and returns NUMSTRB)3.608 F .857(UFS internal, c)-.11 F +(ycli-)-.165 E .818(cally reused b)72 384.609 R(uf)-.22 E .818(fers \(the v) +-.275 F .818(alue of NUMSTRB)-.275 F .818(UFS is 3 in Elk 3.0\).)-.11 F +(Consequently)6.318 E 3.569(,n)-.715 G 3.569(om)449.815 384.609 S .819 +(ore than)467.442 384.609 R(NUMSTRB)72 399.609 Q .266(UFS results of)-.11 F F2 +(Get_String\(\))3.016 E F0 .265 +(can be used simultaneously \(which is rarely a problem in)3.016 F 5.082 +(practice\). As)72 414.609 R 2.332(an e)5.082 F 2.332(xample, a Scheme primiti) +-.165 F 2.663 -.165(ve t)-.275 H 2.333(hat calls the C library function).165 F +F2 -.11(ge)5.083 G(ten).11 E(v\(\))-.44 E F0(and)5.083 E +(returns #f on error can be written as)72 428.609 Q F1 +(Object p_getenv\(Object name\) {)100.346 451.112 Q +(char *ret = getenv\(Get_String\(name\)\);)127.846 465.112 Q +(return ret ? Make_String\(ret, strlen\(ret\)\) : False;)127.846 479.112 Q(}) +100.346 493.112 Q F0 1.488(If more strings are to be used simultaneously)97 +519.212 R 4.237(,t)-.715 G 1.487(he macro)314.416 519.212 R F2(Get_String_Stac) +4.237 E(k\(\))-.22 E F0 1.487(can be used)4.237 F 3.163(instead. It)72 534.212 +R .413(is called with the Scheme object and the name of a v)3.163 F .414 +(ariable of type `)-.275 F(`char*')-.814 E 3.164('t)-.814 G 3.164(ow)468.452 +534.212 S(hich)485.058 534.212 Q 2.674(the C string will be assigned.)72 +549.212 R F2(Get_String_Stac)8.174 E(k\(\))-.22 E F0 2.673 +(allocates space by means of)5.424 F F2(Alloca\(\))5.423 E F0(\(as)5.423 E +-.165(ex)72 564.212 S .783(plained in section 7.5\); hence a call to).165 F F2 +(Alloca_Be)3.534 E(gin)-.44 E F0 .784 +(must be placed in the declarations of the)3.534 F +(enclosing function or block, and)72 579.212 Q F2(Alloca_End)2.75 E F0 +(must be called before returning from it.)2.75 E .97(An additional function)97 +597.812 R F2(Get_Str)3.719 E(sym\(\))-.11 E F0 .969(and an additional macro) +3.719 F F2(Get_Str)3.719 E(sym_Stac)-.11 E(k\(\))-.22 E F0 .969(are pro-)3.719 +F .333(vided by Elk; these are identical to)72 612.812 R F2(Get_String\(\)) +3.083 E F0(and)3.084 E F2(Get_String_Stac)3.084 E(k\(\))-.22 E F0 3.084(,r)C +(especti)401.703 612.812 Q -.165(ve)-.275 G(ly).165 E 3.084(,e)-.715 G .334 +(xcept that)460.59 612.812 R .198(the Scheme object may also be a symbol.)72 +627.812 R .198(In this case, the symbol')5.698 F 2.948(sn)-.605 G .198 +(ame is tak)380.715 627.812 R .197(en as the string to)-.11 F(be con)72 642.812 +Q -.165(ve)-.44 G(rted.).165 E 1.193(As an e)97 661.412 R 1.193 +(xample for the use of)-.165 F F2(Get_String_Stac)3.943 E(k\(\))-.22 E F0 3.944 +(,h)C 1.194(ere is a simple Scheme primiti)331.308 661.412 R -.165(ve)-.275 G +F2 -.22(ex)4.109 G(ec).22 E F0 .759 +(that is called with the name of a program and one more more ar)72 676.412 R +.758(guments and passes them to the)-.198 F F2 -.22(ex)72 690.412 S(ecv\(\)).22 +E F0(system call:)2.75 E EP +%%Page: 30 30 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(0-)288 51 S/F1 10/Courier@0 +SF(Object p_exec\(int argc, Object *argv\) {)100.346 86 Q(char **argp; int i;) +127.846 100 Q(Alloca_Begin;)127.846 114 Q +(Alloca\(argp, char**, argc*sizeof\(char *\)\);)127.846 136.4 Q +(for \(i = 1; i < argc; i++\))127.846 150.4 Q +(Get_String_Stack\(argv[i], argp[i-1]\);)155.346 164.4 Q(argp[i-1] = 0;)127.846 +178.4 Q(execv\(Get_String\(*argv\), argp\);)127.846 192.4 Q +(/* must not return */)331.846 192.4 Q/F2 10/Times-Italic@0 SF(err)127.846 +206.4 Q(or)-.45 E(...)-1.11 E F1(})100.346 220.4 Q(elk_init_example\(\) {) +100.346 242.8 Q(Define_Primitive\(p_exec, "exec", 2, MANY, VARARGS\);)127.846 +256.8 Q(})100.346 270.8 Q F0(The primiti)72 292.3 Q .33 -.165(ve c)-.275 H +(an be used as follo).165 E(ws:)-.275 E F1(\(exec "/bin/ls" "ls" "-l"\))100.346 +314.803 Q/F3 11/Times-Italic@0 SF(Get_String\(\))72 337.303 Q F0 1.507 +(could not be used in this primiti)4.256 F -.165(ve)-.275 G 4.257(,b).165 G +1.507(ecause the number of string ar)303.305 337.303 R 1.507(guments may)-.198 +F -.165(ex)72 352.303 S(ceed the number of static b).165 E(uf)-.22 E +(fers maintained by)-.275 E F3(Get_String\(\))2.75 E F0(.)A/F4 11/Times-Bold@0 +SF 2.75(10.10. V)72 382.303 R(ectors \(T_V)-1.1 E(ector\))-1.1 E F0 .31 +(The layout of)97 400.903 R F3(Objects)3.06 E F0 .31(of type v)3.06 F .31 +(ector is identical to that of strings, e)-.165 F .31(xcept that the)-.165 F F3 +(data)3.06 E F0(com-)3.059 E 2.465(ponent is an array of)72 415.903 R F3 +(Objects)5.215 E F0 7.965(.A)C(function)234.972 415.903 Q F3(Mak)5.215 E(e_V) +-.11 E(ector\(\))-1.221 E F0 2.465(creates a ne)5.215 F 5.216(wv)-.275 G 2.466 +(ector as has been)421.769 415.903 R -.165(ex)72 430.903 S +(plained in section 9.1 abo).165 E -.165(ve)-.165 G(.).165 E F4 2.75(10.11. P) +72 460.903 R(orts \(T_P)-.22 E(ort\))-.22 E F0 .848(The components of)97 +479.503 R F3(Objects)3.598 E F0 .848(of type)3.598 F F3(T_P)3.598 E(ort)-.88 E +F0 .848(are not normally accessed directly from within)3.598 F(C/C++ code, e)72 +493.503 Q(xcept for)-.165 E F1(PORT\(port_obj\)->closefun)100.346 516.006 Q F0 +.099(which is a pointer to a function recei)72 538.506 R .099(ving an ar)-.275 +F .1(gument of type `)-.198 F(`FILE*')-.814 E 2.85('\()-.814 G .1(for e)395.316 +538.506 R .1(xample, a pointer to)-.165 F F3(fclose\(\))72 553.506 Q F0 1.967 +(\), pro)B 1.967(vided that the port is a \214le port.)-.165 F 1.967 +(It is called automatically whene)7.467 F -.165(ve)-.275 G 4.716(rt).165 G +1.966(he port is)459.126 553.506 R .194(closed, either because)72 568.506 R F3 +(close-input-port)2.944 E F0(or)2.944 E F3(close-output-port)2.944 E F0 .195 +(is applied to it or because the g)2.944 F(arbage)-.055 E +(collector has determined that the port is no longer reachable.)72 583.506 Q +2.75(An)72 601.106 S .55 -.275(ew \214)88.192 601.106 T +(le port is created by calling).275 E F1 +(Object Make_Port\(int flags, FILE *f, Object name\);)100.346 623.609 Q F0 .037 +(with a \214rst ar)72 646.109 R .037(gument of either zero \(output port\),) +-.198 F F3(P_INPUT)2.787 E F0 .036(\(input port\) or)2.787 F F3(P_BIDIR)2.786 E +F0(\(bidirectional)2.786 E(port\), the \214le pointer)72 660.109 Q 2.75(,a)-.44 +G(nd the name of the \214le as a Scheme string.)172.991 660.109 Q(The macros) +5.5 E F1(Check_Input_Port\(obj\))100.346 682.612 Q(Check_Output_Port\(obj\)) +100.346 696.612 Q F0 .278(check whether the speci\214ed port is open and is ca\ +pable of input \(or output, respecti)72 719.112 R -.165(ve)-.275 G .279 +(ly\); an error).165 F(is raised otherwise.)72 734.112 Q EP +%%Page: 31 31 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(1-)288 51 S 2.313 -.88(To a) +97 87 T .553(rrange for a ne).88 F .552 +(wly-created port to be closed automatically when it becomes g)-.275 F .552 +(arbage, it)-.055 F(must be passed to the function)72 101 Q/F1 11 +/Times-Italic@0 SF(Re)2.75 E(gister_Object\(\))-.44 E F0(as follo)2.75 E(ws:) +-.275 E/F2 10/Courier@0 SF(Register_Object\(the_port, 0, Terminate_File, 0\);) +100.346 123.503 Q F1(Re)72 146.003 Q(gister_Object\(\))-.44 E F0 .559 +(will be described in section 12.4.)3.309 F .56 +(The current input and output port as well as)6.059 F .002 +(ports pointing to the program')72 161.003 R 2.751(si)-.605 G .001 +(nitial standard input and output are a)214.096 161.003 R -.275(va)-.22 G .001 +(ilable as four e).275 F .001(xternal v)-.165 F(ari-)-.275 E(ables of type)72 +175.003 Q F1(Object)2.75 E F0(:)A F2 30(Curr_Input_Port Standard_Input_Port) +100.346 197.506 R 24(Curr_Output_Port Standard_Output_Port)100.346 211.506 R F0 +(The function)72 233.006 Q F2(void Reset_IO\(int destructive_flag\);)100.346 +255.509 Q F0 .641(clears an)72 278.009 R 3.391(yi)-.165 G .641(nput queued at \ +the current input port, then \215ushes the current output port \(if)123.211 +278.009 R F1(destruc-)3.392 E(tive_\215a)72 293.009 Q(g)-.11 E F0 .259 +(is zero\) or discards characters queued at the output port \(if)3.01 F F1 +(destructive_\215a)3.009 E(g)-.11 E F0 .259(is non-zero\),)3.009 F 1.179(and \ +\214nally resets the current input and current output port to their initial v) +72 308.009 R 1.179(alues \(the program')-.275 F(s)-.605 E .223 +(standard input and standard output\).)72 323.009 R .223 +(This function is typically used in error situations to reset the)5.723 F +(current ports to a de\214ned state.)72 338.009 Q 1.352 +(In addition to the standard Scheme primiti)97 356.609 R -.165(ve)-.275 G 4.102 +(sf).165 G 1.352(or output, e)312.868 356.609 R 1.352 +(xtensions and applications can)-.165 F(use a function)72 370.609 Q F2 +(void Printf\(Object port, char *fmt, ...\);)100.346 393.112 Q F0 .45 +(to send output to a Scheme port using C)72 415.612 R F1(printf)3.2 E F0 5.95 +(.T)C .45(he \214rst ar)294.674 415.612 R .449(gument to)-.198 F F1(Printf\(\)) +3.199 E F0 .449(is the Scheme port)3.199 F .723(to which the output will be se\ +nt \(it must be an output port\); the remaining ar)72 430.612 R .723 +(guments are that of)-.198 F(the C library function)72 445.612 Q F1(printf\(\)) +2.75 E F0(.)A 1.76 -.88(To o)72 463.212 T(utput a Scheme object, the follo).88 +E(wing function can be used in addition to the usual primiti)-.275 E -.165(ve) +-.275 G(s:).165 E F2(void Print_Object\(Object obj, Object port, int raw_flag,) +100.346 485.715 Q(int print_depth, int print_length\);)167.346 499.715 Q F0 +.538(The ar)72 522.215 R .538(guments to)-.198 F F1(Print_Object\(\))3.288 E F0 +.538(are identical to the ar)3.288 F .538(guments of the `)-.198 F .538 +(`print function')-.814 F 3.288('t)-.814 G .538(hat must)465.875 522.215 R +2.114(be supplied for each user)72 537.215 R 2.115 +(-de\214ned Scheme type \(as described in section 11: the)-.22 F F1(Object) +4.865 E F0 2.115(to be)4.865 F .061(printed, the output port, a \215ag indicat\ +ing that the object should be printed in human-readable form)72 552.215 R(\()72 +567.215 Q F1(display)A F0 .108(sets the \215ag,)2.858 F F1(write)2.858 E F0 +.108(does not\), and the `)2.858 F .109(`print depth')-.814 F 2.859('a)-.814 G +.109(nd `)343.779 567.215 R .109(`print length')-.814 F 2.859('f)-.814 G .109 +(or that operation.)428.322 567.215 R -.165(Fo)72 581.215 S 2.75(rd).165 G(eb) +95.364 581.215 Q(ugging purposes, the macro)-.22 E F2(Print\(obj\);)100.346 +603.718 Q F0(may be used to output an)72 626.218 Q F1(Object)2.75 E F0 +(to the current output port.)2.75 E 2.75(Af)72 643.818 S(unction)86.355 643.818 +Q F2(void Load_Source_Port\(Object port\);)100.346 666.321 Q F0 1.217 +(can be used to load Scheme e)72 688.821 R 1.216 +(xpressions from a \214le that has already been opened as a Scheme)-.165 F +(port.)72 703.821 Q EP +%%Page: 32 32 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(2-)288 51 S/F1 11 +/Times-Bold@0 SF 2.75(10.12. Miscellaneous)72 87 R -.814(Ty)2.75 G(pes).814 E +F0 .377(Other b)97 105.6 R .377(uilt-in Scheme types are le)-.22 F .377 +(xical en)-.165 F .377(vironments, primiti)-.44 F .708 -.165(ve p)-.275 H .378 +(rocedures, compound pro-).165 F 3.44 +(cedures, macros, continuations \(also called `)72 120.6 R 3.439 +(`control points')-.814 F 6.189('a)-.814 G 6.189(taf)369.087 120.6 S 3.989 +-.275(ew p)393.07 120.6 T 3.439(laces in Elk\), and).275 F 3.695 +(promises. These)72 135.6 R .946 +(types are not normally created or manipulated from within C or C++ code.)3.695 +F(If)6.446 E .544(you are writing a specialized e)72 150.6 R .543 +(xtension that depends on the C representation of these types, refer)-.165 F +2.146(to the declarations in the public include \214le `)72 165.6 R(`object.h') +-.814 E 4.897('\()-.814 G 2.147(which is included automatically via)338.981 +165.6 R -.814(``)72 180.6 S(scheme.h').814 E('\).)-.814 E(Le)97 199.2 Q .066 +(xical en)-.165 F .066(vironments are identical to pairs e)-.44 F .066 +(xcept that the type is)-.165 F/F2 11/Times-Italic@0 SF(T_En)2.816 E(vir)-.44 E +(onment)-.495 E F0 .066(rather than)2.816 F F2(T_P)72 214.2 Q(air)-.88 E F0 +5.852(.T)C .352(he current en)117.617 214.2 R .353 +(vironment and the initial \(gobal\) en)-.44 F .353(vironment are a)-.44 F +-.275(va)-.22 G .353(ilable as the e).275 F(xternal)-.165 E 3.026(Cv)72 229.2 S +(ariables)87.588 229.2 Q F2(The_En)3.026 E(vir)-.44 E(onment)-.495 E F0(and) +3.026 E F2(Global_En)3.026 E(vir)-.44 E(onment)-.495 E F0 5.776(.T)C .276 +(he prede\214ned type constants for primi-)331.847 229.2 R(ti)72 244.2 Q -.165 +(ve)-.275 G 2.968(s, compound procedures \(the results of e).165 F -.275(va) +-.275 G 2.969(luating lambda e).275 F 2.969(xpressions\), and macros are)-.165 +F F2(T_Primitive)72 258.2 Q F0(,)A F2(T_Compound)2.75 E F0 2.75(,a)C(nd)200.337 +258.2 Q F2(T_Macr)2.75 E(o)-.495 E F0 2.75(,r)C(especti)263.697 258.2 Q -.165 +(ve)-.275 G(ly).165 E 5.5(.T)-.715 G(he function)327.002 258.2 Q/F3 10 +/Courier@0 SF(void Check_Procedure\(Object\);)100.346 280.703 Q F0 .253(checks\ + whether the speci\214ed object is either a compound procedure or a primiti)72 +303.203 R .582 -.165(ve p)-.275 H .252(rocedure with).165 F 3.43(ac)72 318.203 +S .68(alling discipline dif)85.198 318.203 R .68(ferent from)-.275 F F2(NOEV) +3.43 E(AL)-.66 E F0 .68(and raises an error otherwise.)3.43 F .681 +(The type constant for)6.18 F .806(continuations is)72 333.203 R F2(T_Contr) +3.556 E(ol)-.495 E F0 6.305(.`)C(`Promise')202.985 333.203 Q 3.555('i)-.814 G +3.555(st)255.831 333.203 S .805(he type of object returned by the special form) +266.723 333.203 R F2(delay)3.555 E F0(;)A +(the corresponding type constant is named)72 348.203 Q F2(T_Pr)2.75 E(omise) +-.495 E F0(.)A F1 2.75(11. De\214ning)72 378.203 R(New Scheme T)2.75 E(ypes) +-.814 E F0 3.916(An)97 396.803 S -.275(ew)114.358 396.803 S 3.916(,d)-.44 G +1.166(isjoint Scheme type is re)138.36 396.803 R 1.166 +(gistered with Elk by calling the function)-.165 F F2(De\214ne_T)3.916 E +(ype\(\))-.814 E F0(,)A .193(similar to)72 411.803 R F2(De\214ne_Primitive\(\)) +2.943 E F0 .193(for ne)2.943 F 2.942(wp)-.275 G(rimiti)244.685 411.803 Q -.165 +(ve)-.275 G 2.942(s. Making).165 F 2.942(an)2.942 G .742 -.275(ew t)342.292 +411.803 T .192(ype kno).275 F .192(wn to Elk in)-.275 F -.22(vo)-.44 G(lv).22 E +.192(es pass-)-.165 F 1.019(ing it information about the underlying C/C++ repr\ +esentation of the type and a number of C or)72 426.803 R .223 +(C++ functions that are `)72 441.803 R .223(`called back')-.814 F 2.973('b) +-.814 G 2.973(yt)246.016 441.803 S .223(he interpreter in v)257.547 441.803 R +.222(arious situations to pass control to the)-.275 F +(code that implements the type.)72 455.803 Q(The prototype of)5.5 E F2 +(De\214ne_T)2.75 E(ype\(\))-.814 E F0(is:)2.75 E F3 +(int Define_Type\(int zero, const char *name,)100.346 478.306 Q +(int \(*size\)\(Object\), int const_size,)127.846 492.306 Q +(int \(*eqv\)\(Object, Object\),)127.846 506.306 Q +(int \(*equal\)\(Object, Object\),)127.846 520.306 Q +(int \(*print\)\(Object, Object, int, int, int\),)127.846 534.306 Q +(int \(*visit\)\(Object*, int \(*\)\(Object*\)\)\);)127.846 548.306 Q F0 +(The ar)72 570.806 Q(guments to)-.198 E F2(De\214ne_Primitive\(\))2.75 E F0 +(are in detail:)2.75 E F2(zer)97 589.406 Q(o)-.495 E F0 1.588(The \214rst ar) +102.5 604.406 R 1.588(gument must be zero \(in early v)-.198 F 1.589 +(ersions of Elk it could be used to request a)-.165 F<8c78>102.5 619.406 Q +(ed, prede\214ned type number for the ne)-.165 E 2.75(wt)-.275 G(ype\);)292.69 +619.406 Q F2(name)97 638.006 Q F0(The name of the ne)102.5 653.006 Q 2.75(wt) +-.275 G(ype.)200.895 653.006 Q F2(size)97 671.606 Q 2.75(,c)-.11 G(onst_size) +123.774 671.606 Q F0 .09(The size of the corresponding C type \(usually a)102.5 +686.606 R F2(struct)2.839 E F0 2.839(\)i)C 2.839(nb)349.025 686.606 S .089 +(ytes, gi)362.864 686.606 R -.165(ve)-.275 G 2.839(na).165 G 2.839(so)417.899 +686.606 S .089(ne of tw)430.517 686.606 R .089(o, mutu-)-.11 F(ally-e)102.5 +701.606 Q(xclusi)-.165 E .444 -.165(ve a)-.275 H -.198(rg).165 G(uments:).198 E +F2(size)2.864 E F0 2.864(,ap)C .114 +(ointer to a function called by the interpreter to determine)253.381 701.606 R +.059(the size of an object \(for types whose indi)102.5 716.606 R .059 +(vidual members are of dif)-.275 F .059(ferent sizes, such as the)-.275 F F2 +(vector)102.5 731.606 Q F0 .819(type\); and)3.569 F F2(const_size)3.569 E F0 +3.569(,t)C .819(he size as a constant \(for all other types\).)236.841 731.606 +R 3.57(An)6.319 G .82(ull-pointer is)446.651 731.606 R EP +%%Page: 33 33 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(3-)288 51 S(gi)102.5 87 Q +-.165(ve)-.275 G 2.75(nf).165 G(or)132.915 87 Q/F1 11/Times-Italic@0 SF +(const_size)2.75 E F0(if)2.75 E F1(size)2.75 E F0(is to be used instead.)2.75 E +F1(eqv)97 105.6 Q 2.75(,e)-.814 G(qual)121.838 105.6 Q F0 1.127 +(Pointers to \(callback\) functions that are in)102.5 120.6 R -.22(vo)-.44 G +-.11(ke).22 G 3.877(db).11 G 3.876(yt)329.278 120.6 S 1.126 +(he interpreter whene)341.712 120.6 R -.165(ve)-.275 G 3.876(rt).165 G 1.126 +(he Scheme)454.914 120.6 R(predicate)102.5 135.6 Q F1(equal?)3.993 E F0 3.993 +(,o)C(r)188.993 135.6 Q F1(eqv?)3.994 E F0(respecti)3.994 E -.165(ve)-.275 G +(ly).165 E 3.994(,i)-.715 G 3.994(sa)283.211 135.6 S 1.244 +(pplied to members of the ne)296.368 135.6 R 1.244(wly de\214ned type.)-.275 F +.645(As an application-de\214ned type is opaque from the interpreter')102.5 +150.6 R 3.395(sp)-.605 G .645(oint of vie)392.116 150.6 R 2.074 -.715(w, t) +-.275 H .644(he equality).715 F 1.435(predicates ha)102.5 165.6 R 1.765 -.165 +(ve t)-.22 H 4.185(ob).165 G 4.185(es)194.09 165.6 S 1.435 +(upplied by the application or e)207.438 165.6 R 4.185(xtension. Each)-.165 F +1.435(of these \(boolean\))4.185 F(functions is passed tw)102.5 180.6 Q 2.75 +(oo)-.11 G(bjects of the ne)212.995 180.6 Q 2.75(wt)-.275 G(ype as ar)293.372 +180.6 Q(guments when called back.)-.198 E F1(print)97 199.2 Q F0 2.889(Ap)102.5 +214.2 S .139(ointer to a function that is used by the interpreter to print a m\ +ember of this type.)118.831 214.2 R(When)5.638 E 1.994 +(calling the print function, the interpreter passes as ar)102.5 229.2 R 1.995 +(guments the Scheme object to be)-.198 F .164(printed, a Scheme)102.5 244.2 R +F1(port)2.913 E F0 .163 +(to which the output is to be sent, a \215ag indicating whether output is)2.913 +F 1.184(to be rendered in human-readable form \()102.5 259.2 R F1(display)A F0 +1.185(Scheme primiti)3.935 F -.165(ve)-.275 G 3.935(\)o).165 G 3.935(rm)415.464 +259.2 S(achine-readable,)431.62 259.2 Q(read-write-in)102.5 274.2 Q -.275(va) +-.44 G 1.946(riance preserving form \().275 F F1(write)A F0 1.946 +(\), and \214nally the current remainders of the)B(maximum)102.5 289.2 Q F1 +.814(print depth)3.564 F F0(and)3.564 E F1 .814(print length)3.564 F F0 6.314 +(.T)C .814(he return v)291.337 289.2 R .814 +(alue of this function is not used \(the)-.275 F(type is)102.5 304.2 Q F1(int) +2.75 E F0(for historical reasons\).)2.75 E F1(visit)97 322.8 Q F0 3.51(Ap)102.5 +337.8 S .76(ointer to a `)119.452 337.8 R(`visit')-.814 E 3.51('f)-.814 G .76 +(unction called by the g)208.237 337.8 R .759 +(arbage collector when tracing the set of all)-.055 F 1.584 +(currently accessible objects.)102.5 352.8 R 1.585 +(This function is only required if other Scheme objects are)7.085 F .865 +(reachable from objects of the ne)102.5 367.8 R .865 +(wly de\214ned type \(a null pointer can be gi)-.275 F -.165(ve)-.275 G 3.615 +(no).165 G(therwise\).)460.319 367.8 Q .569(It is in)102.5 382.8 R -.22(vo)-.44 +G -.11(ke).22 G 3.32(dw).11 G .57(ith tw)169.131 382.8 R 3.32(oa)-.11 G -.198 +(rg)208.661 382.8 S .57(uments: a pointer to the object being visited by the g) +.198 F .57(arbage col-)-.055 F(lector)102.5 397.8 Q 3.49(,a)-.44 G .74(nd a po\ +inter to another function to be called once with the address of each object) +138.231 397.8 R 1.544(accessible through the original object.)102.5 412.8 R +-.165(Fo)7.044 G 4.294(re).165 G 1.544(xample, the implementation of pairs w) +306.959 412.8 R(ould)-.11 E .995(supply a visit function that in)102.5 427.8 R +-.22(vo)-.44 G -.11(ke).22 G 3.744(si).11 G .994(ts second ar)267.813 427.8 R +.994(gument twice\212once with the address of)-.198 F +(the car of the original object, and once with the address of the cdr)102.5 +442.8 Q(.)-.605 E .82(The return v)97 461.4 R .82(alue of)-.275 F F1 +(De\214ne_T)3.57 E(ype\(\))-.814 E F0 .821(is a small, unique inte)3.57 F .821 +(ger identifying the type; it is usu-)-.165 F(ally stored in a `)72 476.4 Q +(`T_*')-.814 E 2.75('\()-.814 G(or `)176.984 476.4 Q(`t_*')-.814 E('\) v)-.814 +E(ariable follo)-.275 E(wing the con)-.275 E -.165(ve)-.44 G +(ntion used for the b).165 E(uilt-in types.)-.22 E 1.422(In the current v)97 +495 R 1.422(ersion of Elk,)-.165 F F1(De\214ne_T)4.172 E(ype\(\))-.814 E F0 +1.421(cannot be used to de\214ne ne)4.172 F 4.171(w`)-.275 G(`pointer)442.719 +495 Q(-less')-.22 E(')-.814 E(types resembling b)72 510 Q +(uilt-in types such as)-.22 E F1(\214xnum)2.75 E F0(or)2.75 E F1(boolean)2.75 E +F0(.)A .063(The \214rst component of the C structure implementing a user)97 +528.6 R .063(-de\214ned Scheme type must be an)-.22 F F1(Object)72 543.6 Q F0 +3.527(;i)C .777(ts space is used by the g)110.969 543.6 R .777 +(arbage collector to store a special tag indicating that the object)-.055 F +1.023(has been forw)72 558.6 R 3.773(arded. If)-.11 F 1.023 +(you are de\214ning a type that has se)3.773 F -.165(ve)-.275 G 1.024 +(ral components one of which is an).165 F F1(Object)72 573.6 Q F0 3.18(,j)C .43 +(ust mo)110.314 573.6 R .76 -.165(ve t)-.165 H(he).165 E F1(Object)3.18 E F0 +.43(to the front of the)3.18 F F1(struct)3.179 E F0 3.179 +(declaration. Otherwise)3.179 F .429(insert an additional)3.179 F F1(Object)72 +588.6 Q F0(component.)2.75 E .173(The Scheme primiti)97 607.2 R .503 -.165 +(ve t)-.275 H .174(hat instantiates a ne).165 F 2.924(wt)-.275 G .174 +(ype can request heap space for the ne)301.286 607.2 R 2.924(wo)-.275 G(bject) +482.616 607.2 Q(by calling the function)72 621.2 Q F1(Alloc_Object\(\))2.75 E +F0(:)A/F2 10/Courier@0 SF +(Object Alloc_Object\(int size, int type, int const_flag\);)100.346 643.703 Q +F0 .401(The ar)72 666.203 R .401(guments to)-.198 F F1(Alloc_Object\(\))3.151 E +F0 .401(are the size of the object in bytes \(usually obtained by applying) +3.151 F F1(sizeof)72 681.203 Q F0 1.49(to the underlying)4.24 F F1(struct)4.24 +E F0 1.49(\), the type of which the ne)B 4.24(wo)-.275 G 1.49 +(bject is a member \(i.)350.256 681.203 R 1.491(e. the return)1.833 F -.275(va) +72 696.203 S 1.602(lue of).275 F F1(De\214ne_T)4.352 E(ype\(\))-.814 E F0 1.602 +(\), and a \215ag indicating whether the ne)B 1.601 +(wly created object is to be made)-.275 F(read-only)72 711.203 Q 5.5(.T)-.715 G +(he return v)128.408 711.203 Q(alue is a fully initialized)-.275 E F1(Object) +2.75 E F0(.)A EP +%%Page: 34 34 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(4-)288 51 S/F1 11 +/Times-Bold@0 SF 2.75(11.1. Example)72 87 R -.275(fo)2.75 G 2.75(raU).275 G +(ser)176.522 87 Q(-De\214ned Scheme T)-.407 E(ype)-.814 E F0 .608(Figure 5 sho) +97 105.6 R .608(ws the sk)-.275 F .609(eleton of an e)-.11 F .609 +(xtension that pro)-.165 F .609(vides a simple Scheme interf)-.165 F .609 +(ace to the)-.11 F(UNIX)72 120.6 Q/F2 11/Times-Italic@0 SF(ndbm)4.207 E F0 +1.456(library; it can be loaded dynamically into the Scheme interpreter)4.207 F +4.206(,o)-.44 G 4.206(ri)441.277 120.6 S 1.456(nto an Elk-)452.204 120.6 R +1.894 +(based application that needs access to a simple database from within the e)72 +135.6 R 1.895(xtension language.)-.165 F 1.33(Please refer to your system')72 +150.6 R 4.079(sd)-.605 G 1.329(ocumentation if you are not f)213.376 150.6 R +1.329(amiliar with)-.11 F F2(ndbm)4.079 E F0 6.829(.T)C 1.329(he e)447.539 +150.6 R(xtension)-.165 E .718(de\214nes a ne)72 165.6 R 2.148 -.715(w, \214) +-.275 H .718(rst-class Scheme type).715 F F2(dbm-\214le)3.468 E F0 .718 +(corresponding to the)3.468 F F2(DBM)3.469 E F0 .719(type de\214ned by the C) +3.469 F(library)72 180.6 Q 6.593(.A)-.715 G -.055(ga)117.896 180.6 S 1.093 +(in, note the naming con).055 F -.165(ve)-.44 G 1.093(ntion to use lo).165 F +(wer)-.275 E 1.093(-case for ne)-.22 F 3.842(wi)-.275 G 1.092 +(denti\214ers \(in contrast to)395.927 180.6 R(the prede\214ned ones\).)72 +195.6 Q(______________________________________________________________________\ +________)75 223.1 Q/F3 10/Courier@0 SF(#include )72 242.6 Q +(#include )72 256.6 Q(int t_dbm;)72 279 Q(struct s_dbm {)72 301.4 Q +(Object unused;)99.5 315.4 Q(DBM *dbm;)99.5 329.4 Q(char alive;)99.5 343.4 Q +(/* 0: has been closed, else 1 */)183.5 343.4 Q(};)72 357.4 Q +(#define DBMF\(obj\) \(\(struct s_dbm *\)POINTER\(obj\)\))72 379.8 Q +(int dbm_equal\(Object a, Object b\) {)72 402.2 Q(return DBMF\(a\)->alive && D\ +BMF\(b\)->alive && DBMF\(a\)->dbm == DBMF\(b\)->dbm;)99.5 416.2 Q(})72 430.2 Q +(int dbm_print\(Object d, Object port, int raw, int length, int depth\) {)72 +452.6 Q(Printf\(port, "#[dbm-file %lu]", DBMF\(d\)->dbm\);)99.5 466.6 Q +(return 0;)99.5 480.6 Q(})72 494.6 Q(Object p_is_dbm\(Object d\) {)72 517 Q +(return TYPE\(d\) == t_dbm ? True : False;)99.5 531 Q(})72 545 Q +(void elk_init_dbm\(void\) {)72 567.4 Q +(t_dbm = Define_Type\(0, "dbm-file", 0, sizeof\(struct s_dbm\),)99.5 581.4 Q +(dbm_equal, dbm_equal, dbm_print, 0\);)127 595.4 Q 18 +(Define_Primitive\(p_is_dbm, "dbm-file?",)99.5 617.8 R(1, 1, EVAL\);)6 E 6 +(Define_Primitive\(p_dbm_open, "dbm-open", 2,)99.5 631.8 R(3, VARARGS\);)6 E +(Define_Primitive\(p_dbm_close, "dbm-close", 1, 1, EVAL\);)99.5 645.8 Q(})72 +659.8 Q/F4 10/Times-Bold@0 SF(Figur)192.95 677.6 Q 2.5(e5)-.18 G(:)228.6 677.6 +Q/F5 10/Times-Roman@0 SF(Sk)5 E(eleton of a UNIX ndbm e)-.1 E(xtension)-.15 E +F0(___________________________________________________________________________\ +___)75 696.2 Q EP +%%Page: 35 35 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(5-)288 51 S 3.502 +(The code sho)97 87 R 3.502(wn in Figure 5 declares a v)-.275 F(ariable)-.275 E +/F1 11/Times-Italic@0 SF(t_dbm)6.252 E F0 3.503(to hold the return v)6.253 F +3.503(alue of)-.275 F F1(De\214ne_Primitive\(\))72 102 Q F0 2.881(,a)C .131 +(nd the C structure)164.993 102 R F1(s_dbm)2.881 E F0 .131 +(that represents the ne)2.881 F 2.881(wt)-.275 G 2.881(ype. The)385.556 102 R +.131(structure is com-)2.881 F 3.427(posed of the required initial)72 117 R F1 +(Object)6.177 E F0 6.177(,t)C(he)254.79 117 Q F1(DBM)6.177 E F0 3.427 +(pointer returned by the C library function)6.177 F F1(dbm_open\(\))72 132 Q F0 +2.997(,a)C .246(nd a \215ag indicating whether the database pointed to by this\ + object has already been)135.783 132 R .374 +(closed \(in this case the \215ag is cleared\).)72 147 R .374(As a)5.874 F F1 +(dbm-\214le)3.124 E F0 .375(Scheme object can still be passed to primi-)3.125 F +(ti)72 162 Q -.165(ve)-.275 G 4.321(sa).165 G 1.571(fter the)101.544 162 R F1 +(DBM)4.321 E F0 1.571(handle has been closed by a call to)4.321 F F1 +(dbm_close\(\))4.321 E F0 4.321(,t)C(he)399.301 162 Q F1(alive)4.321 E F0 1.571 +(\215ag had to be)4.321 F .642(added to a)72 177 R -.22(vo)-.22 G .642 +(id further use of a `).22 F(`stale')-.814 E 3.393('o)-.814 G .643 +(bject: the `)255.294 177 R(`dbm')-.814 E 3.393('p)-.814 G(rimiti)341.439 177 Q +-.165(ve)-.275 G 3.393(si).165 G .643(nclude an initial check for)386.566 177 R +(the \215ag and raise an error if it is zero.)72 192 Q .245(The macro)97 210.6 +R F1(DBMF)2.995 E F0 .244(is used to cast the pointer \214eld of an)2.995 F F1 +(Object)2.994 E F0 .244(of type)2.994 F F1(t_dbm)2.994 E F0 .244 +(to a pointer to)2.994 F 1.153(the correct structure type.)72 225.6 R F1 +(dbm_equal\(\))6.653 E F0 1.153(implements both the)3.903 F F1(eqv?)3.903 E F0 +1.153(and the)3.903 F F1(equal?)3.903 E F0 1.154(predicates; it)3.903 F .593 +(returns true if the)72 240.6 R F1(Objects)3.343 E F0 .592 +(compared point to an open database and contain identical)3.343 F F1(DBM)3.342 +E F0(point-)3.342 E 3.245(ers. The)72 255.6 R .495 +(print function just prints the numeric v)3.245 F .496(alue of the)-.275 F F1 +(DBM)3.246 E F0 .496(pointer; this could be impro)3.246 F -.165(ve)-.165 G(d) +.165 E 1.089(by printing the name of the database \214le instead, which must t\ +hen be included in each Scheme)72 270.6 R 3.203(object. The)72 285.6 R(primiti) +3.203 E -.165(ve)-.275 G F1(p_is_dbm\(\))3.368 E F0(pro)3.203 E .453 +(vides the usual type predicate.)-.165 F(Finally)5.954 E 3.204(,a)-.715 G 3.204 +(ne)420.757 285.6 S .454(xtension initial-)434.18 285.6 R .62(ization function\ + is supplied to enable dynamic loading of the compiled code; it re)72 300.6 R +.619(gisters the ne)-.165 F(w)-.275 E 2.709(type and three primiti)72 315.6 R +-.165(ve)-.275 G 5.459(so).165 G 2.709(perating on it.)200.327 315.6 R 2.71 +(Note that a visit function \(the \214nal ar)8.209 F 2.71(gument to)-.198 F F1 +(De\214ne_T)72 330.6 Q(ype\(\))-.814 E F0 4.221(\)i)C 4.221(sn)145.048 330.6 S +1.471(ot required here, as the ne)159.048 330.6 R 4.221(wt)-.275 G 1.471 +(ype does not include an)294.979 330.6 R 4.221(yc)-.165 G 1.47 +(omponents of type)419.176 330.6 R F1(Object)72 345.6 Q F0 .736(that the g) +3.486 F .736(arbage collector must kno)-.055 F 3.486(wo)-.275 G .736 +(f\212the required initial)279.981 345.6 R F1(Object)3.486 E F0 .736 +(is not used here and)3.486 F .193(therefore can be ne)72 360.6 R 2.942 +(glected. The)-.165 F .192(type constructor primiti)2.942 F -.165(ve)-.275 G F1 +(dbm-open)3.107 E F0 .192(and the primiti)2.942 F -.165(ve)-.275 G F1 +(dbm-close)3.107 E F0(are sho)72 375.6 Q(wn in Figure 6.)-.275 E 1.136 +(The primiti)97 397.8 R -.165(ve)-.275 G F1(dbm-open)4.051 E F0(sho)3.886 E +1.137(wn in Figure 6 is called with the name of the database \214le, a)-.275 F +1.281(symbol indicating the type of access \()72 412.8 R F1 -.407(re)C(ader) +.407 E F0 1.281(for read-only access,)4.031 F F1(writer)4.031 E F0 1.28 +(for read/write access,)4.031 F(and)72 427.8 Q F1(cr)3.016 E(eate)-.407 E F0 +.266(for creating a ne)3.016 F 3.016<778c>-.275 G .266 +(le with read/write access\), and an optional third ar)210.37 427.8 R .266 +(gument specify-)-.198 F .977(ing the \214le permissions for a ne)72 442.8 R +.976(wly-created database \214le.)-.275 F 3.726(Ad)6.476 G(ef)353.992 442.8 Q +.976(ault of 0666 is used for the \214le)-.11 F .342 +(permissions if the primiti)72 457.8 R .672 -.165(ve i)-.275 H 3.092(si).165 G +-2.09 -.44(nv o)210.473 457.8 T -.11(ke).44 G 3.092(dw).11 G .342(ith just tw) +253.121 457.8 R 3.092(oa)-.11 G -.198(rg)311.182 457.8 S 3.092(uments. Section) +.198 F .343(12.1 will introduce a set)3.092 F 1.594(of functions that a)72 +472.8 R -.22(vo)-.22 G 1.594(id clumsy if-cascades such as the one at the be) +.22 F 1.594(ginning of)-.165 F F1(p_dbm_open\(\))4.344 E F0(.)A F1 +(Primitive_Err)72 487.8 Q(or\(\))-.495 E F0 1.869(is called with a `)4.619 F +1.87(`format string')-.814 F 4.62('a)-.814 G 1.87(nd zero or more ar)313.007 +487.8 R 1.87(guments and signals a)-.198 F .347 +(Scheme error \(see section 12.5\).)72 502.8 R F1(dbm-open)5.847 E F0 .346 +(returns #f if the database \214le could not be opened, so)3.096 F +(that the caller can deal with the error)72 517.8 Q(.)-.605 E .885(Note that)97 +536.4 R F1(dbm-close)3.635 E F0 .885(\214rst checks the)3.635 F F1(alive)3.635 +E F0 .885(bit to raise an error if the database pointer is no)3.635 F 1.472 +(longer v)72 551.4 R 1.472(alid because of an earlier call to)-.275 F F1 +(dbm-close)4.222 E F0 6.972(.T)C 1.471(his check needs to be performed by all) +324.157 551.4 R(primiti)72 566.4 Q -.165(ve)-.275 G 4.924(sw).165 G 2.174 +(orking on)128.932 566.4 R F1(dbm-\214le)4.925 E F0 2.175 +(objects; it may be useful to wrap it in a separate function\212)4.925 F .258 +(together with the initial type-check.)72 581.4 R(Ideally)5.757 E 3.007(,d) +-.715 G .257(atabase objects should be closed automatically dur)276.606 581.4 R +(-)-.22 E 1.266(ing g)72 596.4 R 1.266(arbage collection when the)-.055 F 4.016 +(yb)-.165 G 1.267(ecome inaccessible; section 12.4 will introduce functions to) +232.385 596.4 R(accomplish this.)72 611.4 Q .359(At least tw)97 630 R 3.109(op) +-.11 G(rimiti)159.38 630 Q -.165(ve)-.275 G(s).165 E F1(dbm-stor)3.109 E(e) +-.407 E F0(and)3.108 E F1(dbm-fetc)3.108 E(h)-.165 E F0 .358 +(need to be added to the database e)3.108 F(xtension)-.165 E 2.049(to mak)72 +645 R 4.799(ei)-.11 G 4.799(tr)116.93 645 S 2.049 +(eally useful; these are not sho)128.45 645 R 2.05 +(wn here \(their implementation is f)-.275 F 2.05(airly simple and)-.11 F +(straightforw)72 660 Q 3.98(ard\). Using)-.11 F 1.23(these primiti)3.98 F -.165 +(ve)-.275 G 1.229(s, the e).165 F 1.229 +(xtension discussed in this section can be used to)-.165 F .001(write Scheme c\ +ode such as this procedure \(which looks up an electronic mailbox name in the \ +mail)72 675 R(alias database maintained on most UNIX systems\):)72 689 Q EP +%%Page: 36 36 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(6-)288 51 S(________________\ +______________________________________________________________)75 99.5 Q/F1 10 +/Courier@0 SF(Object p_dbm_open\(int argc, Object *argv\) {)72 119 Q(DBM *dp;) +99.5 133 Q(int flags = O_RDWR|O_CREAT;)99.5 147 Q(Object d, sym = argv[1];)99.5 +161 Q(Check_Type\(sym, T_Symbol\);)99.5 183.4 Q +(if \(EQ\(sym, Intern\("reader"\)\)\))99.5 197.4 Q(flags = O_RDONLY;)127 211.4 +Q(else if \(EQ\(sym, Intern\("writer"\)\)\))99.5 225.4 Q(flags = O_RDWR;)127 +239.4 Q(else if \(!EQ\(sym, Intern\("create"\)\)\))99.5 253.4 Q +(Primitive_Error\("invalid argument: ~s", sym\);)127 267.4 Q +(if \(\(dp = dbm_open\(Get_String\(argv[0]\), flags,)99.5 281.4 Q +(argc == 3 ? Get_Integer\(argv[2]\) : 0666\)\) == 0\))154.5 295.4 Q +(return False;)127 309.4 Q 6(d=A)99.5 323.4 S +(lloc_Object\(sizeof\(struct s_dbm\), t_dbm, 0\);)129.5 323.4 Q +(DBMF\(d\)->dbm = dp;)99.5 337.4 Q(DBMF\(d\)->alive = 1;)99.5 351.4 Q +(return d;)99.5 365.4 Q(})72 379.4 Q(Object p_dbm_close\(Object d\) {)72 401.8 +Q(Check_Type\(d, t_dbm\);)99.5 415.8 Q(if \(!DBMF\(d\)->alive\))99.5 429.8 Q +(Primitive_Error\("invalid dbm-file: ~s", d\);)127 443.8 Q +(DBMF\(d\)->alive = 0;)99.5 457.8 Q(dbm_close\(DBMF\(d\)->dbm\);)99.5 471.8 Q +(return Void;)99.5 485.8 Q(})72 499.8 Q/F2 10/Times-Bold@0 SF(Figur)177.415 +517.6 Q 2.5(e6)-.18 G(:)213.065 517.6 Q/F3 10/Times-Roman@0 SF +(Implementation of)5 E/F4 10/Times-Italic@0 SF(dbm-open)2.5 E F3(and)2.5 E F4 +(dbm-close)2.5 E F0(__________________________________________________________\ +____________________)75 536.2 Q F1(\(define expand-mail-alias)100.346 565.2 Q +(\(lambda \(alias\))112.346 579.2 Q +(\(let \(\(d \(dbm-open "/etc/aliases" 'reader\)\)\))124.346 593.2 Q +(\(if \(not d\))136.346 607.2 Q +(\(error 'expand-mail-alias "cannot open database"\)\))160.346 621.2 Q +(\(unwind-protect)136.346 635.2 Q(\(dbm-fetch d alias\))148.346 649.2 Q +(\(dbm-close d\)\)\)\)\))148.346 663.2 Q +(\(define address-of-staff \(expand-mail-alias "staff"\)\))100.346 685.6 Q EP +%%Page: 37 37 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(7-)288 51 S/F1 11 +/Times-Bold@0 SF 2.75(12. Adv)72 87 R(anced T)-.11 E(opics)-1.012 E 2.75 +(12.1. Con)72 117 R -.11(ve)-.44 G +(rting between Symbols, Integers, and Bitmasks).11 E F0 .594 +(Symbols are frequently used as the ar)97 135.6 R .594 +(guments to Scheme primiti)-.198 F -.165(ve)-.275 G 3.344(sw).165 G .594 +(hich call an underly-)411.49 135.6 R .865(ing C or C++ function with some kin\ +d of bitmask or with a prede\214ned enumeration constant or)72 150.6 R .905 +(preprocessor symbol.)72 165.6 R -.165(Fo)6.405 G 3.655(re).165 G .905 +(xample, the primiti)196.892 165.6 R -.165(ve)-.275 G/F2 11/Times-Italic@0 SF +(dbm-open)3.819 E F0(sho)3.654 E .904(wn in Figure 6 abo)-.275 F 1.234 -.165 +(ve u)-.165 H .904(ses sym-).165 F 1.495 +(bols to represent the symbolic constants passed to)72 180.6 R F2(dbm_open\(\)) +4.245 E F0 6.995(.S)C(imilarly)374.786 180.6 Q 4.245(,aS)-.715 G 1.495 +(cheme primiti)431.148 180.6 R -.165(ve)-.275 G 1.124 +(corresponding to the UNIX system call)72 195.6 R F2(open\(\))3.874 E F0 1.124 +(could recei)3.874 F 1.454 -.165(ve a l)-.275 H 1.124 +(ist of symbols represending the).165 F(logical OR of the usual)72 209.6 Q F2 +(open\(\))2.75 E F0(\215ags, so that one can write Scheme code such as:)2.75 E +/F3 10/Courier@0 SF(\(let \(\(tty-fd \(unix-open "/dev/ttya")100.346 232.103 Q +('\(read write exclusive\)\)\))340.346 232.103 Q +(\(tmp-fd \(unix-open "/tmp/somefile '\(write create\)\)\)\))136.346 246.103 Q +(...)127.846 260.103 Q F0 2.711 -.88(To f)97 286.203 T .952(acilitate con).77 F +-.165(ve)-.44 G .952(rsion of symbols to C inte).165 F .952 +(gers or enumeration constants and vice v)-.165 F(ersa,)-.165 E(these tw)72 +300.203 Q 2.75(of)-.11 G(unctions are pro)120.158 300.203 Q(vided:)-.165 E F3 +(unsigned long Symbols_To_Bits\(Object syms, int mask_flag,)100.346 322.706 Q +(SYMDESCR *table\);)124.346 336.706 Q +(Object Bits_To_Symbols\(unsigned long bits, int mask_flag,)100.346 350.706 Q +(SYMDESCR *table\);)124.346 364.706 Q F0(The type)72 386.206 Q F2(SYMDESCR)2.75 +E F0(is de\214ned as:)2.75 E F3(typedef struct {)100.346 408.709 Q(char *name;) +127.846 422.709 Q(unsigned long val;)127.846 436.709 Q 6(}S)100.346 450.709 S +(YMDESCR;)118.346 450.709 Q F2(Symbols_T)97 476.809 Q(o_Bits\(\))-1.012 E F0 +(con)3.494 E -.165(ve)-.44 G .743(rts a symbol or a list of symbols to an inte) +.165 F(ger;)-.165 E F2(Bits_T)3.493 E(o_Symbols\(\))-1.012 E F0 .097(is the re) +72 491.809 R -.165(ve)-.275 G .097 +(rse operation and is usually applied to the return v).165 F .097 +(alue of a C/C++ function to con)-.275 F -.165(ve)-.44 G .097(rt it).165 F .964 +(to a Scheme representation.)72 506.809 R .964(Both functions recei)6.464 F +1.294 -.165(ve a)-.275 H 3.714(st).165 G .964(he third ar)323.67 506.809 R .964 +(gument a table specifying the)-.198 F 1.66(correspondence between symbols and\ + C constants; each table entry is a pair consisting of the)72 521.809 R F2 +(name)72 536.809 Q F0 .316(of a symbol as a C string and an inte)3.066 F(ger) +-.165 E F2(val)3.066 E F0 .315(\(typically an enumeration constant or a)3.066 F +F2(#de\214ne)3.065 E F0 2.75(constant\). Each)72 550.809 R F2(SYMDESCR)2.75 E +F0(array is terminated by an entry with a zero)2.75 E F2(name)2.75 E F0 +(component:)2.75 E F3(SYMDESCR lseek_syms[] = {)100.346 573.312 Q 6({")127.846 +587.312 S 30(set", SEEK_SET)145.846 587.312 R(},)6 E 6({")127.846 601.312 S 6 +(current", SEEK_CUR)145.846 601.312 R(},)6 E 6({")127.846 615.312 S 30 +(end", SEEK_END)145.846 615.312 R(},)6 E 6({0)127.846 629.312 S 6(,0})145.846 +629.312 S(};)100.346 643.312 Q F0 .794(The second ar)97 669.412 R .794 +(gument to the con)-.198 F -.165(ve)-.44 G .795 +(rsion functions controls whether a single symbol is con-).165 F -.165(ve)72 +684.412 S .392(rted to an inte).165 F .392(ger or vice v)-.165 F .392(ersa \() +-.165 F F2(mask_\215a)A(g)-.11 E F0 .391 +(is zero\), or whether a list of symbols is con)3.142 F -.165(ve)-.44 G .391 +(rted to).165 F 3.44(the logical OR of a set of matching v)72 699.412 R 3.441 +(alues or vice v)-.275 F 3.441(ersa \()-.165 F F2(mask_\215a)A(g)-.11 E F0 +3.441(is non-zero\).)6.191 F F2(Sym-)8.941 E(bols_T)72 714.412 Q(o_Bits\(\)) +-1.012 E F0 .652(signals an error if the symbol does not match an)3.402 F 3.401 +(yo)-.165 G 3.401(ft)370.998 714.412 S .651(he names in the gi)381.12 714.412 R +-.165(ve)-.275 G 3.401(nt).165 G(able)485.674 714.412 Q(or)72 729.412 Q 5.325 +(,i)-.44 G(f)91.856 729.412 Q F2(mask_\215a)5.325 E(g)-.11 E F0 2.575 +(is non-zero, if an)5.325 F 5.325(yo)-.165 G 5.325(ft)249.085 729.412 S 2.575 +(he list elements does not match.)261.131 729.412 R 2.576(The empty list is) +8.075 F EP +%%Page: 38 38 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(8-)288 51 S(con)72 87 Q -.165 +(ve)-.44 G 1.02(rted to zero.).165 F(If)6.52 E/F1 11/Times-Italic@0 SF(Bits_T) +3.77 E(o_Symbols\(\))-1.012 E F0 1.02(is called with a non-zero)3.77 F F1 +(mask_\215a)3.769 E(g)-.11 E F0 3.769(,i)C 3.769(tm)426.704 87 S 1.019 +(atches the)442.089 87 R F1(val)3.769 E F0 6.198(components ag)72 102 R 6.198 +(ainst the)-.055 F F1(bits)8.948 E F0(ar)8.948 E 6.198 +(gument using logical AND.)-.198 F(Re)381.646 102 Q -.055(ga)-.165 G 6.199 +(rdless of).055 F F1(mask_\215a)8.949 E(g)-.11 E F0(,)A F1(Bits_T)72 117 Q +(o_Symbols)-1.012 E F0 .606(returns the empty list if no match occurs.)3.356 F +.605(Figure 7 sho)6.105 F .605(ws an impro)-.275 F -.165(ve)-.165 G 3.355(dv) +.165 G(ersion)477.116 117 Q(of)72 132 Q F1(p_dbm_open\(\))2.75 E F0(using)2.75 +E F1(Symbols_T)2.75 E(o_Bits\(\))-1.012 E F0(in place of nested if-statements.) +2.75 E(_______________________________________________________________________\ +_______)75 159.5 Q/F2 10/Courier@0 SF(static SYMDESCR flag_syms[] = {)72 179 Q +6({")99.5 193 S(reader", O_RDONLY },)117.5 193 Q 6({")99.5 207 S +(writer", O_RDWR },)117.5 207 Q 6({")99.5 221 S(create", O_RDWR|O_CREAT },) +117.5 221 Q 6({0)99.5 235 S 6(,0})117.5 235 S(};)72 249 Q +(Object p_dbm_open\(int argc, Object *argv\) {)72 271.4 Q(DBM *dp;)99.5 285.4 Q +(Object d;)99.5 299.4 Q(dp = dbm_open\(Get_String\(argv[0]\),)99.5 321.8 Q +(Symbols_To_Bits\(argv[1], 0, flag_syms\),)123.5 335.8 Q +(argc == 3 ? Get_Integer\(argv[2]\) : 0666\);)123.5 349.8 Q(if \(dp == 0\))99.5 +363.8 Q(return False;)127 377.8 Q 6(d=A)99.5 391.8 S +(lloc_Object\(sizeof\(struct s_dbm\), t_dbm, 0\);)129.5 391.8 Q +(DBMF\(d\)->dbm = dp;)99.5 405.8 Q(DBMF\(d\)->alive = 1;)99.5 419.8 Q +(return d;)99.5 433.8 Q(})72 447.8 Q/F3 10/Times-Bold@0 SF(Figur)153.235 465.6 +Q 2.5(e7)-.18 G(:)188.885 465.6 Q/F4 10/Times-Roman@0 SF(Impro)5 E -.15(ve)-.15 +G 2.5(dv).15 G(ersion of)243.145 465.6 Q/F5 10/Times-Italic@0 SF(dbm-open)2.5 E +F4(using)2.5 E F5(Symbols_T)2.5 E(o_Bits\(\))-.92 E F0(_______________________\ +_______________________________________________________)75 484.2 Q 4.47(AS)97 +517.8 S 1.72(cheme primiti)115.528 517.8 R 2.05 -.165(ve c)-.275 H 1.72 +(alling the UNIX system call).165 F F1(access\(\))4.47 E F0 1.72(could use)4.47 +F F1(Symbols_T)4.47 E(o_Bits\(\))-1.012 E F0(with a non-zero)72 531.8 Q F1 +(mask_\215a)2.75 E(g)-.11 E F0(to construct a bitmask:)2.75 E F2 +(Object p_access\(Object fn, Object mode\) {)100.346 554.303 Q +(access\(Get_String\(fn\), \(int\)Symbols_To_Bits\(mode, 1, access_syms\)\);) +127.846 568.303 Q(...)127.846 582.303 Q F0(where)72 603.803 Q F1(access_syms) +2.75 E F0(is de\214ned as:)2.75 E F2(static SYMDESCR access_syms[] = {)100.346 +626.306 Q 6({")127.846 640.306 S 36(read", R_OK)145.846 640.306 R(},)6 E 6({") +127.846 654.306 S 30(write", W_OK)145.846 654.306 R(},)6 E 6({")127.846 668.306 +S 18(execute", X_OK)145.846 668.306 R(},)6 E 6({0)127.846 682.306 S 6(,0}) +145.846 682.306 S(};)100.346 696.306 Q F0 .471(Note that in this e)72 718.806 R +.471(xample the empty list can be passed as the)-.165 F F1(mode)3.221 E F0(ar) +3.221 E .471(gument to test for e)-.198 F(xistence)-.165 E +(of the \214le, because in this case)72 733.806 Q F1(Symbols_T)2.75 E +(o_Bits\(\))-1.012 E F0(returns zero \(the v)2.75 E(alue of)-.275 E F1(F_OK) +2.75 E F0(\).)A EP +%%Page: 39 39 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(9-)288 51 S/F1 11 +/Times-Bold@0 SF 2.75(12.2. Calling)72 87 R(Scheme Pr)2.75 E(ocedur)-.198 E +(es, Ev)-.198 E(aluating Scheme Code)-.11 E F0 2.75(AS)97 104.6 S +(cheme procedure can be called from within C or C++ code using the function) +113.808 104.6 Q/F2 10/Courier@0 SF +(Object Funcall\(Object fun, Object argl, int eval_flag\);)100.346 127.103 Q F0 +2.092(The \214rst ar)72 149.603 R 2.092 +(gument is the Scheme procedure\212either a primiti)-.198 F 2.423 -.165(ve p) +-.275 H 2.093(rocedure \().165 F/F3 11/Times-Italic@0 SF(T_Primitive)A F0 4.843 +(\)o)C 4.843(ra)490.61 149.603 S .525(compound procedure \()72 164.603 R F3 +(T_Compound)A F0 3.275(\). The)B .525(second ar)3.275 F .524 +(gument is the list of ar)-.198 F .524(guments to be passed)-.198 F .679 +(to the procedure, as a Scheme list.)72 179.603 R .68(The third ar)6.18 F .68 +(gument, if non-zero, speci\214es that the ar)-.198 F(guments)-.198 E .315 +(need to be e)72 194.603 R -.275(va)-.275 G .315 +(luated before calling the Scheme procedure.).275 F .314 +(This is usually not the case \(e)5.815 F .314(xcept in)-.165 F +(some special forms\).)72 209.603 Q(The return v)5.5 E(alue of)-.275 E F3 +(Funcall\(\))2.75 E F0(is the result of the Scheme procedure.)2.75 E F3 +(Funcall\(\))97 228.203 Q F0 .339 +(is frequently used from within C callback functions that can be re)3.089 F .34 +(gistered for cer)-.165 F(-)-.22 E .862(tain e)72 243.203 R -.165(ve)-.275 G +.862(nts, such as the user).165 F .862(-supplied X11 error handlers, X11 e)-.22 +F -.165(ve)-.275 G .862(nt handlers, timeout handlers,).165 F .34(the C++)72 +258.203 R F3(ne)3.09 E(w)-.165 E F0(handler)3.09 E 3.09(,e)-.44 G 3.09 +(tc. Here,)175.286 258.203 R .34(use of)3.09 F F3(Funcall\(\))3.09 E F0(allo) +3.09 E .34(ws to re)-.275 F .34(gister a user)-.165 F .34 +(-de\214ned Scheme proce-)-.22 F .916(dure for this e)72 273.203 R -.165(ve) +-.275 G .916(nt from within a Scheme program.).165 F .915(As an e)6.416 F .915 +(xample, Figure 8 sho)-.165 F .915(ws the generic)-.275 F +(signal handler that is associated with v)72 288.203 Q +(arious UNIX signals by the UNIX e)-.275 E(xtension.)-.165 E(_________________\ +_____________________________________________________________)75 315.703 Q F2 +(void scheme_signal_handler\(int sig\) {)72 335.203 Q(Object fun, args;)99.5 +349.203 Q(Set_Error_Tag\("signal-handler"\);)99.5 371.603 Q(Reset_IO\(1\);)99.5 +385.603 Q(args = Bits_To_Symbols\(\(unsigned long\)sig, 0, signal_syms\);)99.5 +399.603 Q(args = Cons\(args, Null\);)99.5 413.603 Q +(fun = VECTOR\(handlers\)->data[sig];)99.5 427.603 Q +(if \(TYPE\(fun\) != T_Compound\))99.5 441.603 Q +(Fatal_Error\("no handler for signal %d", sig\);)127 455.603 Q +(\(void\)Funcall\(fun, args, 0\);)99.5 469.603 Q +(Printf\(Curr_Output_Port, "\\n\\7Signal!\\n"\);)99.5 483.603 Q +(\(void\)P_Reset\(\);)99.5 497.603 Q(/*NOTREACHED*/)99.5 511.603 Q(})72 525.603 +Q/F4 10/Times-Bold@0 SF(Figur)178.53 543.403 Q 2.5(e8)-.18 G(:)214.18 543.403 Q +/F5 10/Times-Roman@0 SF(Using)5 E/F6 10/Times-Italic@0 SF(Funcall\(\))2.5 E F5 +(to call a Scheme procedure)2.5 E F0(_________________________________________\ +_____________________________________)75 562.003 Q 1.669 +(The signal handler sho)97 595.603 R 1.67 +(wn in Figure 8 uses the signal number supplied by the system to)-.275 F(inde) +72 610.603 Q 5.904(xav)-.165 G 3.154(ector of user)118.304 610.603 R 3.154 +(-de\214ned Scheme procedures \(that is,)-.22 F F3(Objects)5.904 E F0 3.154 +(of type)5.904 F F3(T_Compound)5.904 E F0(\).)A F3(Reset_IO\(\))72 625.603 Q F0 +.559(is used here to ensure that the current input and output port are in de\ +\214ned state when)3.308 F .343(the Scheme signal handler starts e)72 640.603 R +-.165(xe)-.165 G 3.092(cuting. The).165 F(ar)3.092 E .342 +(gument list is constructed by calling)-.198 F F3(Cons\(\))3.092 E F0 3.092(;i) +C(t)500.942 640.603 Q .427 +(consists of a single element\212the signal number as a Scheme symbol.)72 +655.603 R F3(signal_syms)5.928 E F0 .428(is an array of)3.178 F F3(SYMDESCR)72 +670.603 Q F0 1.68(records that maps the UNIX signal names \()4.43 F F3(sighup)A +F0(,)A F3(sigint)4.43 E F0 4.43(,e)C 4.43(tc.\) to)406.546 670.603 R +(corresponding)4.43 E .184(Scheme symbols of the same names.)72 685.603 R .185 +(The Scheme procedure called from the signal handler is not)5.684 F .296 +(supposed to return \(it usually in)72 700.603 R -.22(vo)-.44 G -.11(ke).22 G +3.045(sac).11 G .295(ontinuation\); therefore the result of)253.863 700.603 R +F3(Funcall\(\))3.045 E F0 .295(is ignored.)3.045 F .541 +(In case the Scheme handler \(and thus the call to)72 715.603 R F3(Funcall\(\)) +3.291 E F0 3.292(\)d)C .542(oes return, a message is printed and)344.031 +715.603 R(the primiti)72 730.603 Q -.165(ve)-.275 G F3 -.407(re)2.915 G(set) +.407 E F0(is called to return to the application')2.75 E 2.75(st)-.605 G(ople) +323.526 730.603 Q -.165(ve)-.275 G 2.75(lo).165 G 2.75(rs)363.72 730.603 S +(tandard Scheme tople)374.412 730.603 Q -.165(ve)-.275 G(l.).165 E EP +%%Page: 40 40 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 51 S 2.75(0-)288 51 S(An S-e)97 86 Q +(xpression can be e)-.165 E -.275(va)-.275 G(luated by calling the function) +.275 E/F1 10/Courier@0 SF(Object Eval\(Object expr\);)100.346 108.503 Q F0 .692 +(which is identical to the primiti)72 131.003 R -.165(ve)-.275 G/F2 11 +/Times-Italic@0 SF -.165(ev)3.606 G(al).165 E F0(\()3.441 E F2(P_Eval\(\))A F0 +.691(in C\), e)3.441 F .691(xcept that no optional en)-.165 F .691 +(vironment can)-.44 F .447(be supplied.)72 146.003 R F2(Eval\(\))5.947 E F0 +.447(is v)3.197 F .447(ery rarely used by e)-.165 F .448 +(xtensions or applications, mainly by implementations)-.165 F .797(of ne)72 +161.003 R 3.547(ws)-.275 G .797(pecial forms.)110.587 161.003 R(Both)6.297 E F2 +(Eval\(\))3.547 E F0(and)3.547 E F2(Funcall\(\))3.547 E F0 .797 +(can trigger a g)3.547 F .797(arbage collection; all local v)-.055 F(ari-)-.275 +E 1.216(ables holding Scheme)72 176.003 R F2(Objects)3.966 E F0 1.217 +(with heap pointers must be properly re)3.966 F 1.217(gistered with the g)-.165 +F(arbage)-.055 E(collector to survi)72 191.003 Q .33 -.165(ve c)-.275 H +(alls to these functions.).165 E 1.084(Occasionally an S-e)97 209.603 R 1.084 +(xpression needs to be e)-.165 F -.275(va)-.275 G 1.084(luated that e).275 F +1.083(xists as a C string, for e)-.165 F(xample,)-.165 E .02(when a Scheme e)72 +224.603 R .02(xpression has been entered through a `)-.165 F(`te)-.814 E .02 +(xt widget')-.165 F 2.771('i)-.814 G 2.771(nag)382.157 224.603 S .021 +(raphical user interf)403.583 224.603 R(ace.)-.11 E .719(Here, e)72 239.603 R +-.275(va)-.275 G .718 +(luation requires calling the Scheme reader to parse the e).275 F .718 +(xpression; therefore a straight-)-.165 F(forw)72 254.603 Q .659 +(ard solution is to create a string port holding the string and then just `) +-.11 F(`load')-.814 E 3.41('t)-.814 G .66(he contents of)440.97 254.603 R +(the port:)72 268.603 Q F1(void eval_string\(char *expr\) {)100.346 291.106 Q +(Object port; GC_Node;)127.846 305.106 Q +(port = P_Open_Input_String\(Make_String\(expr, strlen\(expr\)\)\);)127.846 +327.506 Q(GC_Link\(port\);)127.846 341.506 Q(Load_Source_Port\(port\);)127.846 +355.506 Q(GC_Unlink;)127.846 369.506 Q(\(void\)P_Close_Input_Port\(port\);) +127.846 383.506 Q(})100.346 397.506 Q F0 .192 +(If a more sophisticated function is required, the)72 420.006 R F2 -.165(ev) +2.941 G(al-string).165 E F0 -.165(ex)2.941 G .191 +(tension included in the Elk distrib).165 F(u-)-.22 E(tion can be used \(`)72 +434.006 Q(`lib/misc/elk-e)-.814 E -.275(va)-.275 G(l.c').275 E 2.75('\). This) +-.814 F -.165(ex)2.75 G(tension pro).165 E(vides a function)-.165 E F1 +(char *Elk_Eval\(char *expr\);)100.346 456.509 Q F0 .005(that con)72 479.009 R +-.165(ve)-.44 G .006(rts the result of e).165 F -.275(va)-.275 G .006 +(luating the stringized e).275 F .006 +(xpression back to a C string and returns it as a)-.165 F 2.75(result. A)72 +494.009 R(null pointer is returned if an error occurs during e)2.75 E -.275(va) +-.275 G(luation.).275 E .166 +(Applications should not use this function as the primary interf)97 512.609 R +.166(ace to the e)-.11 F .165(xtension language.)-.165 F .327(In contrast to l\ +anguages such as Tcl, the semantic concepts and data structures of Scheme are \ +not)72 527.609 R 3.38(centered around strings, and strings are not a practicab\ +le representation for S-e)72 542.609 R(xpressions.)-.165 E .345 +(Instead, applications should pass control to the e)72 557.609 R .346 +(xtension language by calling Scheme procedures)-.165 F(\(using)72 572.609 Q F2 +(Funcall\(\))3.257 E F0 3.257(\)o)C 3.257(rb)156.724 572.609 S 3.257(yl)169.144 +572.609 S .507(oading \214les containing Scheme code.)180.959 572.609 R .506 +(The e)6.006 F .506(xtension language then calls)-.165 F .718 +(back into the application')72 587.609 R 3.469(sC)-.605 G .719 +(/C++ layer by in)200.757 587.609 R -.22(vo)-.44 G .719 +(king application-supplied Scheme primiti).22 F -.165(ve)-.275 G 3.469(sa).165 +G(nd)493 587.609 Q(other forms of callbacks as e)72 602.609 Q +(xplained in section 6.3.)-.165 E/F3 11/Times-Bold@0 SF 2.75(12.3. GC-Pr)72 +632.609 R(otecting Global Objects)-.198 E F0 .043(Section 9.1 e)97 651.209 R +.043(xplained when\212and ho)-.165 F .043(w\212to re)-.275 F .043 +(gister with the g)-.165 F .043(arbage collector function-local)-.055 F F2 +(Object)72 666.209 Q F0 -.275(va)3.551 G .801(riables holding heap pointers.) +.275 F(Similarly)6.301 E 3.551(,g)-.715 G .801(lobal v)305.881 666.209 R .801 +(ariables must usually be added to the)-.275 F 1.048 +(set of reachable objects as well if the)72 681.209 R 3.798(ya)-.165 G 1.048 +(re to survi)255.559 681.209 R 1.377 -.165(ve g)-.275 H 1.047 +(arbage collections \(a useful e).11 F 1.047(xception to)-.165 F 1.239 +(this rule will be introduced in section 12.4\).)72 696.209 R 1.239 +(In contrast to local v)6.739 F 1.239(ariables, global v)-.275 F 1.24 +(ariables are)-.275 F .99(only made kno)72 711.209 R .99(wn to the g)-.275 F +.99 +(arbage collector once\212after initialization\212as their lifetime is that of) +-.055 F(the entire program.)72 725.209 Q 1.76 -.88(To a)5.5 H(dd a global v).88 +E(ariable to the g)-.275 E(arbage collector')-.055 E 2.75(sr)-.605 G +(oot set, the macro)387.271 725.209 Q EP +%%Page: 41 41 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 50 S 2.75(1-)288 50 S/F1 10/Courier@0 +SF(Global_GC_Link\(obj\))100.346 86 Q F0 .455 +(must be called with the properly initialized v)72 108.5 R .455 +(ariable of type)-.275 F/F2 11/Times-Italic@0 SF(Object)3.205 E F0 5.955(.T)C +.455(he macro tak)384.378 108.5 R .456(es the address)-.11 F +(of the speci\214ed object.)72 122.5 Q(If that is a problem, an equi)5.5 E +-.275(va)-.275 G(lent functional interf).275 E(ace can be used:)-.11 E F1 +(void Func_Global_GC_Link\(Object *obj_ptr\);)100.346 145.003 Q F0 .07 +(This function must be supplied the address of the global v)72 167.503 R .07 +(ariable to be re)-.275 F .07(gistered with the g)-.165 F(arbage)-.055 E +(collector)72 182.503 Q(.)-.605 E 3.04(When writing e)97 201.103 R 3.041 +(xtensions that maintain global)-.165 F F2(Object)5.791 E F0 -.275(va)5.791 G +(riables,).275 E F2(Global_GC_Link\(\))5.791 E F0(\(or)5.791 E F2 +(Func_Global_GC_Link\(\))72 216.103 Q F0 3.313(\)i)C 3.313(su)193.86 216.103 S +.563(sually called from within the e)206.952 216.103 R .563 +(xtension initialization function right)-.165 F .483(after each v)72 231.103 R +.483(ariable is assigned a v)-.275 F 3.233(alue. F)-.275 F .483 +(or instance, the global Scheme v)-.165 F(ector)-.165 E F2(handler)3.233 E(s) +-.11 E F0 .484(that w)3.233 F(as)-.11 E .102(used in Figure 8 to associate pro\ +cedures with UNIX signals is initialized and GC-protected as fol-)72 246.103 R +(lo)72 260.103 Q(ws:)-.275 E F1(void elk_init_unix_signal\(void\) {)100.346 +282.606 Q(handlers = Make_Vector\(NSIG, False\);)127.846 296.606 Q +(Global_GC_Link\(handlers\);)127.846 310.606 Q(...)127.846 324.606 Q(})100.346 +338.606 Q F2(NSIG)72 361.106 Q F0 .521 +(is the number of UNIX signal types as de\214ned by the system include \214le.) +3.27 F .521(The signal han-)6.021 F 1.43 +(dling Scheme procedures that are inserted into the v)72 376.106 R 1.43 +(ector later need not be re)-.165 F 1.429(gistered with the)-.165 F -.055(ga)72 +391.106 S 1.159(rbage collector).055 F 3.909(,b)-.44 G 1.159(ecause the)160.877 +391.106 R 3.909(ya)-.165 G 1.159(re no)221.671 391.106 R 3.909(wr)-.275 G 1.159 +(eachable through another object which itself is reach-)260.366 391.106 R +(able.)72 406.106 Q/F3 11/Times-Bold@0 SF 2.75(12.3.1. Dynamic)72 436.106 R +2.75(CD)2.75 G(ata Structur)171.297 436.106 Q(es)-.198 E F0 .318 +(Dynamic data structures, such as the nodes of a link)97 454.706 R .318 +(ed list containing Scheme)-.11 F F2(Objects)3.068 E F0 3.068(,c)C(an-)489.953 +454.706 Q 1.189(not be easily re)72 469.706 R 1.189(gistered with the g)-.165 F +1.189(arbage collector)-.055 F 6.689(.T)-.605 G 1.189 +(he simplest solution is to b)314.69 469.706 R 1.19(uild these data)-.22 F +1.626(structures in Scheme rather than in C or C++ in the \214rst place.)72 +484.706 R -.165(Fo)7.126 G 4.376(re).165 G 1.626(xample, a link)396.472 484.706 +R 1.626(ed list of)-.11 F 1.132(Scheme objects can be b)72 499.706 R 1.132 +(uilt from Scheme pairs much more naturally and more straightforw)-.22 F(ard) +-.11 E .425(than from C structures or the lik)72 514.706 R .424 +(e, in particular if the list will be tra)-.11 F -.165(ve)-.22 G .424 +(rsed and manipulated using).165 F 1.13(Scheme primiti)72 529.706 R -.165(ve) +-.275 G 3.88(sa).165 G -.165(ny)163.646 529.706 S -.11(wa).165 G 5.31 -.715 +(y. B).11 H 1.131 +(esides, data structures programmed in Scheme bene\214t from auto-).715 F 1.497 +(matic memory management, whereas use of)72 544.706 R F2(malloc\(\))4.247 E F0 +(and)4.247 E F2(fr)4.247 E(ee\(\))-.407 E F0 1.496 +(in C frequently is a source of)4.246 F(memory leaks and related errors.)72 +559.706 Q 2.288(If for some reason a dynamic data structure must be b)97 +578.306 R 2.288(uilt in C or C++ rather than in)-.22 F 3.113 +(Scheme, reachability problems can be a)72 593.306 R -.22(vo)-.22 G 3.113 +(ided by inserting all).22 F F2(Objects)5.863 E F0 3.112(into a global, GC-) +5.863 F 1.497(protected v)72 608.306 R 1.497(ector \(such as)-.165 F F2 +(handler)4.247 E(s)-.11 E F0 1.497 +(in Figure 8\) and then use the corresponding v)4.247 F 1.498(ector inde)-.165 +F -.165(xe)-.165 G(s).165 E .339(rather than the actual)72 623.306 R F2 +(Objects)3.089 E F0 5.839(.T)C .339(his sounds more dif)217.575 623.306 R .339 +(\214cult than it really is; Appendix B sho)-.275 F .338(ws the)-.275 F 1.632 +(complete source code of a small module to re)72 638.306 R(gister)-.165 E F2 +(Objects)4.382 E F0 1.632(in a Scheme v)4.382 F(ector)-.165 E 7.133(.T)-.605 G +1.633(he module)456.233 638.306 R -.165(ex)72 653.306 S .185 +(ports three functions:).165 F F2 -.407(re)2.935 G(gister_object\(\))-.033 E F0 +.185(inserts an)2.935 F F2(Object)2.935 E F0 .184(into the v)2.934 F .184 +(ector and returns the inde)-.165 F 2.934(xa)-.165 G(s)499.721 653.306 Q(an)72 +668.306 Q F2(int)2.855 E F0(;)A F2(der)2.855 E -.44(eg)-.407 G +(ister_object\(\)).44 E F0(remo)2.855 E -.165(ve)-.165 G 2.855(sa).165 G(n) +233.768 668.306 Q F2(Object)2.855 E F0 .105(with a gi)2.855 F -.165(ve)-.275 G +2.855(ni).165 G(nde)334.371 668.306 Q 2.855(xf)-.165 G .105(rom the v)362.108 +668.306 R .105(ector; and)-.165 F F2 -.11(ge)2.856 G(t_object\(\)).11 E F0 .688 +(returns the)72 683.306 R F2(Object)3.438 E F0 .688(stored under a gi)3.438 F +-.165(ve)-.275 G 3.438(ni).165 G(nde)253.256 683.306 Q(x.)-.165 E F2 -.407(re) +6.188 G(gister_object\(\))-.033 E F0 .687(dynamically gro)3.438 F .687 +(ws the v)-.275 F .687(ector to)-.165 F -.22(avo)72 698.306 S +(id arti\214cial limits.).22 E 4.45(Ad)97 716.906 S 1.7 +(ynamic data structure \(e.)114.892 716.906 R 1.701(g. link)1.833 F 1.701 +(ed list\) implementation using this module w)-.11 F 1.701(ould call)-.11 F F2 +-.407(re)72 731.906 S(gister_object\(\))-.033 E F0 .29(when inserting a ne)3.04 +F(w)-.275 E F2(Object)3.039 E F0 .289(into the list and then use the inte)3.039 +F .289(ger return v)-.165 F .289(alue in)-.275 F EP +%%Page: 42 42 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 51 S 2.75(2-)288 51 S .066 +(place of the)72 87 R/F1 11/Times-Italic@0 SF(Object)2.816 E F0 2.816 +(itself. Similarly)2.816 F 2.816(,i)-.715 G 2.817(tw)237.583 87 S .067 +(ould call)251.29 87 R F1(der)2.817 E -.44(eg)-.407 G(ister_object\(\)).44 E F0 +(whene)2.817 E -.165(ve)-.275 G 2.817(ran).165 G .067(ode is remo)436.986 87 R +-.165(ve)-.165 G(d).165 E .948(from the list.)72 102 R F1 -.11(ge)6.448 G +(t_object\(\)).11 E F0 -.11(wo)3.698 G .948(uld be used to retrie).11 F 1.278 +-.165(ve t)-.275 H(he).165 E F1(Object)3.698 E F0 .948(associated with a gi) +3.698 F -.165(ve)-.275 G 3.697(nl).165 G .947(ist ele-)473.419 102 R 3.026 +(ment. Note)72 117 R .276(that with these functions the same)3.026 F F1(Object) +3.026 E F0 .276(can be re)3.026 F .277(gistered multiple times \(each time) +-.165 F .971(under a ne)72 132 R 3.72(wi)-.275 G(nde)134.202 132 Q .97 +(x\) without ha)-.165 F .97(ving to maintain reference counts: the g)-.22 F .97 +(arbage collector does not)-.055 F 1.479(care ho)72 147 R 4.229(wo)-.275 G +1.479(ften a particular)122.94 147 R F1(Object)4.229 E F0 1.479(is tra)4.229 F +-.165(ve)-.22 G 1.479(rsed during g).165 F 1.48 +(arbage collection, as long as it will be)-.055 F(reached at least once.)72 162 +Q/F2 11/Times-Bold@0 SF 2.75(12.4. W)72 192 R(eak P)-.715 E +(ointers and Object T)-.22 E(ermination)-1.012 E F0 4.753(Ad)97 210.6 S 2.003 +(ata structure implementation may deliberately use)115.195 210.6 R F1(Objects) +4.753 E F0 2.003(that are not added to the)4.753 F .313 +(global set of reachable pointers \(as described in the pre)72 225.6 R .314 +(vious section\) and are thus in)-.275 F .314(visible to the)-.44 F -.055(ga)72 +240.6 S .862(rbage collector).055 F 6.362(.I)-.605 G 3.612(nt)161.031 240.6 S +.862(his case, it becomes possible to determine whether or not g)173.201 240.6 +R .861(arbage collec-)-.055 F .516(tion has found an)72 255.6 R(y)-.165 E F1 +(other)3.267 E F0 .517(pointers to the same Scheme objects.)3.267 F .517 +(This property can be e)6.017 F .517(xploited in)-.165 F(se)72 270.6 Q -.165 +(ve)-.275 G(ral w).165 E(ays by e)-.11 E(xtensions or applications using Elk.) +-.165 E .099(Pointers that are not included in the g)97 289.2 R .099 +(arbage collector')-.055 F 2.849(sr)-.605 G .099 +(eachability search are called `)346.821 289.2 R(`weak)-.814 E(pointers')72 +304.2 Q 3.858('. The)-.814 F 1.108 +(memory occupied by a Scheme object that is only referenced by weak pointers) +3.858 F 1.08(will be reclaimed.)72 319.2 R 1.079(The term)6.58 F F1(weak)3.829 +E F0 -.165(ex)3.829 G 1.079 +(presses the notion that the pointer is not strong enough to).165 F(pre)72 +334.2 Q -.165(ve)-.275 G .665(nt the object it points to from being g).165 F +.666(arbage collected.)-.055 F .666(Code using weak pointers can scan)6.166 F +1.317(the pointers immediately after each g)72 349.2 R 1.316 +(arbage collection and check whether the tar)-.055 F 1.316(get object has)-.198 +F .166(been visited by the just-\214nished g)72 364.2 R .166 +(arbage collection.)-.055 F .166 +(If this is the case, normal \(strong\) pointers to)5.666 F .234 +(the object must e)72 379.2 R .234(xist \(which can therefore be considered `) +-.165 F(`li)-.814 E -.165(ve)-.275 G -.814('').165 G .233 +(\), and the weak pointer is updated).814 F .472 +(manually to point to the object')72 394.2 R 3.223(sn)-.605 G 1.023 -.275(ew l) +225.172 394.2 T 3.223(ocation. On).275 F .473 +(the other hand, if the object has not been vis-)3.223 F +(ited, no more \(normal\) references to it e)72 409.2 Q +(xist and the memory occupied by it has been reclaimed.)-.165 E -.88(We)97 +427.8 S 1.508(ak pointers are useful in implementing certain types of data str\ +uctures where the sole).88 F -.165(ex)72 442.8 S 1.622(istence of a \(weak\) p\ +ointer to an object from within this data structure should not k).165 F 1.623 +(eep the)-.11 F .093(object ali)72 457.8 R .423 -.165(ve \()-.275 H F1 .093 +(weak sets).165 F F0(,)A F1(populations)2.842 E F0 2.842(,c)C .092 +(ertain kinds of hash tables, etc.\).)239.146 457.8 R .092 +(Objects that are not reach-)5.592 F .556 +(able through strong pointers are then remo)72 472.8 R -.165(ve)-.165 G 3.306 +(df).165 G .556(rom the weak data structure after g)284.826 472.8 R .557 +(arbage collec-)-.055 F 3.207(tion. In)72 487.8 R .456 +(this case, it is frequently useful to in)3.207 F -.22(vo)-.44 G .676 -.11 +(ke a `).22 H .456(`termination function')-.704 F 3.206('f)-.814 G .456 +(or each such object,)415.27 487.8 R -.917(e. g.)72 502.8 R .853 +(for objects that contain resources of which only a \214nite amount is a)3.603 +F -.275(va)-.22 G .854(ilable, such as UNIX).275 F .844 +(\214le descriptors \(or FILE structures\), X displays and windo)72 517.8 R +.844(ws, etc.)-.275 F .844(The termination function for)6.344 F .848(Scheme po\ +rts closes the \214le pointer encapsulated in a port object if it is still ope\ +n; lik)72 532.8 R -.275(ew)-.11 G .849(ise, the).275 F .703 +(termination function for X windo)72 547.8 R .703(ws closes the windo)-.275 F +3.453(wa)-.275 G .703(nd thereby remo)327.599 547.8 R -.165(ve)-.165 G 3.453 +(si).165 G 3.453(tf)421.943 547.8 S .703(rom the display)432.117 547.8 R(,) +-.715 E 1.019(and so on.)72 562.8 R 1.019(Thus, should an object holding some \ +kind of resource go inaccessible before it w)6.519 F(as)-.11 E .146 +(terminated `)72 577.8 R(`properly')-.814 E 2.895('b)-.814 G 2.895(yc)180.63 +577.8 S .145(alling the respecti)193.909 577.8 R .475 -.165(ve S)-.275 H .145 +(cheme primiti).165 F .475 -.165(ve \()-.275 H F1(close-input-port).165 E F0(,) +A F1(close-output-)2.895 E(port)72 592.8 Q F0(,)A F1(destr)2.75 E(oy-window) +-.495 E F0 2.75(,e)C(tc.\), then resource will be reclaimed after the ne) +176.005 592.8 Q(xt g)-.165 E(arbage collection run.)-.055 E F2 2.75 +(12.4.1. Using)72 622.8 R -.715(We)2.75 G(ak P).715 E(ointers)-.22 E F0 .189 +(Code using weak pointers must scan the pointers immediately after each g)97 +641.4 R .189(arbage collection,)-.055 F -.22(bu)72 656.4 S(t).22 E F1(befor) +3.133 E(e)-.407 E F0 .382(the interpreter resumes normal operation, because th\ +e memory referenced by the weak)3.133 F .29(pointers can be reused the ne)72 +671.4 R .291(xt time heap space is requested.)-.165 F .291 +(This can be accomplished by re)5.791 F(gis-)-.165 E 2.165 +(tering a so-called `)72 686.4 R(`after)-.814 E 2.165(-GC function.)-.22 F +(Elk')7.665 E 4.915(sg)-.605 G 2.165(arbage collector in)287.357 686.4 R -.22 +(vo)-.44 G -.11(ke).22 G 4.914(sa).11 G 2.164(ll after)408.24 686.4 R 2.164 +(-GC functions)-.22 F(\(without ar)72 700.4 Q(guments\) upon completion.)-.198 +E 1.76 -.88(To r)5.5 H -.165(eg).88 G(ister an after).165 E +(-GC functions, the function)-.22 E EP +%%Page: 43 43 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 51 S 2.75(3-)288 51 S/F1 10/Courier@0 +SF(void Register_After_GC\(\(void \(*func\)\(void\)\)\);)100.346 86 Q F0 1.32 +(is used, typically in an e)72 108.5 R 1.321(xtension initializer)-.165 F 6.821 +(.S)-.605 G(imilarly)283.357 108.5 Q 4.071(,e)-.715 G 1.321 +(xtensions and applications can re)329.019 108.5 R(gister)-.165 E -.814(``)72 +122.5 S(before-GC functions').814 E 2.75('u)-.814 G(sing)184.002 122.5 Q F1 +(void Register_Before_GC\(\(void \(*func\)\(void\)\)\);)100.346 145.003 Q F0 +2.077(These functions are called immediately before each g)72 167.503 R 2.077 +(arbage collection and may be used, for)-.055 F 1.64 +(instance, to change the application')72 182.503 R 4.39(sc)-.605 G 1.641 +(ursor to an hour)247.004 182.503 R 1.641(glass symbol.)-.198 F(After)7.141 E +1.641(-GC and before-GC)-.22 F(functions must not trigger another g)72 197.503 +Q(arbage collection.)-.055 E 2.606(An after)97 216.103 R 2.606 +(-GC function scanning a set of weak pointers mak)-.22 F 2.605 +(es use of the three macros)-.11 F/F2 11/Times-Italic@0 SF(IS_ALIVE\(\))72 +231.103 Q F0(,)A F2 -.66(WA)4.908 G(S_FOR).66 E -.66(WA)-.198 G(RDED\(\)).66 E +F0 4.908(,a)C(nd)243.417 231.103 Q F2(UPD)4.908 E -.407(AT)-.385 G(E_OBJ\(\)) +.407 E F0 7.658(.F)C 2.158(or e)349.428 231.103 R 2.159(xample, an after)-.165 +F 2.159(-GC function)-.22 F 1.302(scanning a table of elements holding)72 +246.103 R F2(Objects)4.052 E F0 1.301 +(with weak pointers could be written as sho)4.052 F 1.301(wn in)-.275 F +(Figure 9.)72 261.103 Q(______________________________________________________\ +________________________)75 288.603 Q F1(void scan_weak_table\(void\) {)72 +308.103 Q(int i;)99.5 322.103 Q(for \(i = 0; i < table_size; i++\) {)99.5 +344.503 Q(Object obj = table[i].obj;)127 358.503 Q(if \(IS_ALIVE\(obj\)\) {)127 +372.503 Q(/* object is still reachable */)319 372.503 Q +(if \(WAS_FORWARDED\(obj\)\))154.5 386.503 Q(UPDATE_OBJ\(obj\);)182 400.503 Q 6 +(}e)127 414.503 S(lse {)145 414.503 Q 6(terminate_object\(obj\); /*)154.5 +428.503 R(object is dead; finalize... */)6 E(table[i] = 0;)154.5 442.503 Q +(/* and remove it from the table */)298.5 442.503 Q(})127 456.503 Q(})99.5 +470.503 Q(})72 484.503 Q/F3 10/Times-Bold@0 SF(Figur)142.245 502.303 Q 2.5(e9) +-.18 G(:)177.895 502.303 Q/F4 10/Times-Roman@0 SF(After)5 E +(-GC function that scans a table containing weak pointers)-.2 E F0(___________\ +___________________________________________________________________)75 520.903 +Q 1.303(The function)97 554.503 R F2(scan_weak_table\(\))4.053 E F0(sho)4.053 E +1.303(wn in Figure 9 can then be re)-.275 F 1.303(gistered as an after)-.165 F +(-GC)-.22 E(function by in)72 568.503 Q -.22(vo)-.44 G(king).22 E F1 +(Register_After_GC\(scan_weak_table\);)100.346 591.006 Q F0 2.534 +(The then-part of the if-statement in)97 617.106 R F2(scan_weak_table\(\))5.284 +E F0 2.534(is entered if the just-completed)5.284 F -.055(ga)72 632.106 S 1.012 +(rbage collection has encountered an).055 F 3.762(yp)-.165 G 1.013 +(ointers to the Scheme object pointed to by)258.593 632.106 R F2(obj)3.763 E F0 +3.763(;i)C 3.763(nt)478.842 632.106 S(his)491.163 632.106 Q .069 +(case the pointer con)72 647.106 R -.165(vey)-.44 G .069(ed in).165 F F2(obj) +2.819 E F0 .069(is updated manually using)2.819 F F2(UPD)2.819 E -.407(AT)-.385 +G(E_OBJ\(\)).407 E F0 .069(\(when using the gen-)2.819 F .993(erational g)72 +662.106 R .993(arbage collector included in Elk, reachability of an object doe\ +s not necessarily imply)-.055 F .481(that it w)72 677.106 R .48(as forw)-.11 F +.48(arded, hence the additional call to)-.11 F F2 -.66(WA)3.23 G(S_FOR).66 E +-.66(WA)-.198 G(RDED\(\)).66 E F0 3.23(\). If)B F2(IS_ALIVE\(\))3.23 E F0 +(returns)3.23 E -.11(fa)72 692.106 S .719 +(lse, no more strong pointers to the object e).11 F .72 +(xist and it can be terminated and remo)-.165 F -.165(ve)-.165 G 3.47(df).165 G +.72(rom the)469.367 692.106 R .539(weak data structure.)72 707.106 R F2 +(terminate_object\(\))6.039 E F0 .539(typically w)3.289 F .539(ould release an) +-.11 F 3.288(ye)-.165 G .538(xternal resources contained)382.573 707.106 R .322 +(in the Scheme object, b)72 722.106 R .322(ut it must neither create an)-.22 F +3.072(yn)-.165 G .872 -.275(ew o)308.552 722.106 T .322 +(bjects nor attempt to `).275 F(`re)-.814 E(vi)-.275 E -.165(ve)-.275 G 1.95 +-.814('' t).165 H .323(he dead).814 F EP +%%Page: 44 44 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 51 S 2.75(4-)288 51 S(object in an)72 +87 Q 2.75(yw)-.165 G(ay \(e.)139.243 87 Q(g. create a ne)1.833 E 2.75(ws)-.275 +G(trong pointer to it by inserting it into another)238.228 87 Q 2.75(,l)-.44 G +-2.365 -.275(iv e)443.125 87 T(object\).)3.025 E/F1 11/Times-Bold@0 SF 2.75 +(12.4.2. Functions)72 117 R -.275(fo)2.75 G 2.75(rA).275 G(utomatic Object T) +180.867 117 Q(ermination)-1.012 E F0 1.614 +(As automatic termination of Scheme objects using user)97 135.6 R 1.613 +(-supplied termination functions is)-.22 F .171 +(the most frequent use of weak pointers, Elk of)72 150.6 R .172 +(fers a set of con)-.275 F -.165(ve)-.44 G .172 +(nience functions for this purpose.).165 F 1.464 +(Extensions and applications can insert)72 165.6 R/F2 11/Times-Italic@0 SF +(Objects)4.214 E F0 1.463(into a weak list maintained by Elk and remo)4.214 F +-.165(ve)-.165 G(them from the list using the tw)72 179.6 Q 2.75(of)-.11 G +(unctions)218.861 179.6 Q/F3 10/Courier@0 SF +(void Register_Object\(Object obj, char *group,)100.346 202.103 Q +(\(Object \(*term\)\(Object\)\), int leader_flag\);)226.346 216.103 Q +(void Deregister_Object\(Object obj\);)100.346 230.103 Q F2(term)97 256.203 Q +F0 2.705(is the termination function that is called automatically with)5.455 F +F2(obj)5.455 E F0 2.706(when the object)5.455 F .001 +(becomes unreachable \(its result is not used\);)72 271.203 R F2(gr)2.751 E +(oup)-.495 E F0(is an opaque `)2.751 E(`cookie')-.814 E 2.75('a)-.814 G +(ssociated with)405.924 271.203 Q F2(obj)2.75 E F0(and)2.75 E 3.098 +(can be used to e)72 286.203 R 3.098 +(xplicitly terminate all objects with the same v)-.165 F 3.098(alue for)-.275 F +F2(gr)5.848 E(oup)-.495 E F0 5.849(;an)C(on-zero)470.406 286.203 Q F2 +(leader_\215a)72 301.203 Q(g)-.11 E F0 .82(indicates that)3.57 F F2(obj)3.57 E +F0 .82(is the `)3.57 F(`leader')-.814 E 3.57('o)-.814 G 3.57(ft)282.824 301.203 +S .82(he speci\214ed)293.115 301.203 R F2(gr)3.569 E(oup)-.495 E F0 6.319(.E)C +.819(lk automatically re)391.317 301.203 R(gisters)-.165 E .433(an after)72 +316.203 R .433(-GC function to scan the weak list maintained by these tw)-.22 F +3.184(of)-.11 G .434(unctions and to call the)376.87 316.203 R F2(term)3.184 E +F0 .791(function for all objects that could be pro)72 331.203 R -.165(ve)-.165 +G 3.54(nu).165 G .79(nreachable by the g)279.02 331.203 R .79(arbage collector) +-.055 F 3.54(,s)-.44 G .79(imilar to the)448.641 331.203 R(function sho)72 +346.203 Q(wn in Figure 9.)-.275 E 3.254(Object termination tak)97 364.803 R +3.254(es place in tw)-.11 F 6.004(op)-.11 G 3.254 +(hases: \214rst all objects re)289.224 364.803 R 3.255(gistered with a zero) +-.165 F F2(leader_\215a)72 379.803 Q(g)-.11 E F0 1.104 +(are terminated, after that the termination functions of the leaders are in) +3.854 F -.22(vo)-.44 G -.11(ke).22 G 3.854(d. This).11 F 1.201 +(group and leader notion is used, for e)72 394.803 R 1.202 +(xample, by the Xlib e)-.165 F 1.202(xtension to associate windo)-.165 F 1.202 +(ws \(and)-.275 F .898 +(other resources\) with an X display: the ID of the display to which a windo)72 +409.803 R 3.648(wb)-.275 G .898(elongs is used as)427.672 409.803 R .978 +(the windo)72 424.803 R(w')-.275 E 3.728(sg)-.605 G .979 +(roup, and the display is mark)140.902 424.803 R .979(ed as the group leader) +-.11 F 6.479(.T)-.605 G .979(hus, if a display becomes)389.182 424.803 R .916 +(unreachable or is closed by the program, all its windo)72 439.803 R .915 +(ws are closed before the display is \214nally)-.275 F(destro)72 454.803 Q(yed) +-.11 E/F4 9/Times-Roman@0 SF(5)-3.6 I F0(.)3.6 I -1.1 -.88(Tw o)72 472.403 T +(additional functions are pro)3.63 E(vided for e)-.165 E +(xplicitly calling the termination functions:)-.165 E F3 +(void Terminate_Type\(int type\);)100.346 494.906 Q +(void Terminate_Group\(char *group\);)100.346 508.906 Q F2 -1.012(Te)72 531.406 +S(rminate_T)1.012 E(ype\(\))-.814 E F0(in)4.464 E -.22(vo)-.44 G -.11(ke).22 G +4.464(st).11 G 1.714(he termination function \(if an)195.042 531.406 R 1.713 +(y\) for all objects of a gi)-.165 F -.165(ve)-.275 G 4.463(nt).165 G 1.713 +(ype and)467.769 531.406 R .63(deletes them from the weak list.)72 546.406 R +-.165(Fo)6.131 G 3.381(re).165 G .631 +(xample, to close all ports currently held open by Elk \(and)245.031 546.406 R +(thus apply)72 560.406 Q F2(fclose\(\))2.75 E F0 +(to the FILE pointers embedded in them\), one w)2.75 E(ould call)-.11 E F3 +(Terminate_Type\(T_Port\))100.346 582.909 Q F2 -1.012(Te)72 605.409 S +(rminate_Gr)1.012 E(oup\(\))-.495 E F0 .075(calls the termination functions of\ + all non-leader objects belonging to the spec-)2.825 F(i\214ed)72 620.409 Q F2 +(gr)2.75 E(oup)-.495 E F0(.)A(Finally)72 638.009 Q 2.75(,a)-.715 G +(nother function,)112.843 638.009 Q F2 -.495(Fi)2.75 G(nd_Object\(\)).495 E F0 +2.75(,l)C(ocates an object in the weak list:)256.855 638.009 Q .36 LW 76.5 +681.2 72 681.2 DL 81 681.2 76.5 681.2 DL 85.5 681.2 81 681.2 DL 90 681.2 85.5 +681.2 DL 94.5 681.2 90 681.2 DL 99 681.2 94.5 681.2 DL 103.5 681.2 99 681.2 DL +108 681.2 103.5 681.2 DL 112.5 681.2 108 681.2 DL 117 681.2 112.5 681.2 DL +121.5 681.2 117 681.2 DL 126 681.2 121.5 681.2 DL 130.5 681.2 126 681.2 DL 135 +681.2 130.5 681.2 DL 139.5 681.2 135 681.2 DL 144 681.2 139.5 681.2 DL/F5 7 +/Times-Roman@0 SF(5)82 691.2 Q F4 .437(This interf)4.5 2.8 N .437(ace has e) +-.09 F -.18(vo)-.225 G(lv).18 E .437(ed in a slightly)-.135 F/F6 9 +/Times-Italic@0 SF .438(ad hoc)2.688 F F4 -.09(wa)2.688 G .438(y; the tw).09 F +.438(o-stage relationship e)-.09 F .438(xpressed by groups and)-.135 F +(group leaders may not be suf)72 705 Q(\214cient for more comple)-.225 E 2.25 +(xh)-.135 G(ierarchies than those used in X.)271.854 705 Q EP +%%Page: 45 45 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 51 S 2.75(5-)288 51 S/F1 10/Courier@0 +SF(Object Find_Object\(int type, char *group,)100.346 86 Q +(\(int \(*match_func\)\(Object, ...\)\), ...\);)173.346 100 Q F0(Ar)72 122.5 Q +.895(guments are a Scheme type, a group, and a match function called once for \ +each object in the)-.198 F .558 +(weak list that has the speci\214ed type and group.)72 137.5 R .557 +(The match function is passed the)6.058 F/F2 11/Times-Italic@0 SF(Object)3.307 +E F0 .557(and the)3.307 F 1.249(remaining ar)72 152.5 R 1.249(guments to)-.198 +F F2 -.495(Fi)3.999 G(nd_Object\(\)).495 E F0 3.999(,i)C 3.999(fa)255.031 152.5 +S -.165(ny)267.577 152.5 S 6.749(.I)-.55 G 3.999(ft)290.859 152.5 S 1.249 +(he match function returns true for an object,)301.579 152.5 R +(this object becomes the return v)72 167.5 Q(alue of)-.275 E F2 -.495(Fi)2.75 G +(nd_Object\(\)).495 E F0 2.75(;o)C(therwise it returns)318.686 167.5 Q F2(Null) +2.75 E F0(.)A .087(Complicated as it may seem,)97 186.1 R F2 -.495(Fi)2.836 G +(nd_Object\(\)).495 E F0 .086(is quite useful\212e)2.836 F .086 +(xtensions can check whether a)-.165 F .096 +(Scheme object with certain properties has already been re)72 201.1 R .096 +(gistered with the weak list earlier and, if)-.165 F 1.923 +(this is the case, return)72 216.1 R F2(this)4.672 E F0 1.922 +(object instead of creating a ne)4.672 F 4.672(wo)-.275 G 4.672(ne. This) +359.662 216.1 R 1.922(is critical for Scheme)4.672 F 2.033 +(objects encapsulating some kind of e)72 231.1 R 2.033 +(xternal resource, such as \214le descriptors or X windo)-.165 F(ws.)-.275 E +(Consider)72 246.1 Q 3.049(,f)-.44 G .299(or e)120.743 246.1 R .299 +(xample, a Scheme primiti)-.165 F .629 -.165(ve t)-.275 H .299 +(hat obtains the topmost windo).165 F 3.049(wo)-.275 G 3.049(nag)417.697 246.1 +S -2.365 -.275(iv e)439.679 246.1 T 3.049(nXd).275 G(isplay)477.721 246.1 Q +1.784(and returns it as a Scheme)72 261.1 R F2(window)4.534 E F0 4.534 +(object. If)4.534 F 1.784(the primiti)4.534 F 2.114 -.165(ve j)-.275 H 1.784 +(ust were to instantiate a Scheme).165 F .488 +(object encapsulating the corresponding X windo)72 276.1 R 3.238(wI)-.275 G +3.238(Df)301.946 276.1 S .488(or each call, it w)316.789 276.1 R .487 +(ould become possible for)-.11 F(tw)72 291.1 Q 3.773(oo)-.11 G 3.773(rm)97.663 +291.1 S 1.023(ore distinct Scheme)113.657 291.1 R F2(window)3.773 E F0 1.024 +(objects to reference the same real X windo)3.773 F 5.204 -.715(w. T)-.275 H +1.024(his is not).715 F .643(acceptable, because tw)72 306.1 R 3.393(oS)-.11 G +.642(cheme objects pointing to the same X object should certainly be equal) +188.67 306.1 R .7(in the sense of)72 321.1 R F2(eq?)3.45 E F0 3.451(,n)C .701 +(ot to mention the problems that w)168.374 321.1 R .701 +(ould ensue if one of the Scheme)-.11 F F2(window)3.451 E F0 .597 +(objects were closed \(thereby destro)72 336.1 R .597 +(ying the underlying X windo)-.11 F .597(w\) and the second one were still) +-.275 F 1.279(be operated on afterw)72 351.1 R 4.029(ards. Example)-.11 F 1.28 +(uses of)4.03 F F2 -.495(Fi)4.03 G(nd_Object\(\)).495 E F0 1.28 +(can be found in the Xlib e)4.03 F(xtension)-.165 E(and in the Xt e)72 366.1 Q +(xtension that are included in the Elk distrib)-.165 E(ution.)-.22 E/F3 11 +/Times-Bold@0 SF 2.75(12.5. Err)72 396.1 R(ors)-.198 E F0(User)97 414.7 Q .131 +(-supplied code can signal an error by calling)-.22 F F2(Primitive_Err)2.881 E +(or\(\))-.495 E F0 .131(with a format string and)2.881 F(as man)72 428.7 Q 2.75 +(ya)-.165 G(dditional ar)115.824 428.7 Q(guments \()-.198 E F2(Objects)A F0 +2.75(\)a)C 2.75(st)254.633 428.7 S +(here are format speci\214ers in the format string:)264.72 428.7 Q F1 +(void Primitive_Error\(char *fmt, ...\);)100.346 451.203 Q F2(Primitive_Err)72 +473.703 Q(or\(\))-.495 E F0 .232(calls the def)2.982 F .232(ault or user)-.11 F +.233(-de\214ned error handler as described in the Elk Reference)-.22 F 1.106 +(Manual, passing it an `)72 488.703 R 1.106(`error tag')-.814 F 3.855('i)-.814 +G 1.105(dentifying the source of the error)231.887 488.703 R 3.855(,t)-.44 G +1.105(he format string, and the)391.736 488.703 R 1.53(remaining ar)72 503.703 +R 4.28(guments. A)-.198 F 1.53(special format speci\214er `)4.28 F(`~E')-.814 E +4.28('c)-.814 G 1.531(an be used to interpolate the standard)331.068 503.703 R +1.18(error message te)72 518.703 R 1.179 +(xt corresponding to the UNIX error number)-.165 F F2(errno)3.929 E F0 3.929 +(;t)C 1.179(his is useful for primiti)384.224 518.703 R -.165(ve)-.275 G(s).165 +E .143(that in)72 533.703 R -.22(vo)-.44 G .363 -.11(ke U).22 H .143 +(NIX system calls or certain C library functions \(if `).11 F(`~e')-.814 E +2.894('i)-.814 G 2.894(su)382.313 533.703 S .144(sed, the \214rst character of) +394.986 533.703 R 1.357(the te)72 548.703 R 1.357(xt is con)-.165 F -.165(ve) +-.44 G 1.357(rted to lo).165 F 1.357(wer case\).)-.275 F 1.357 +(If this format speci\214er is used, the current)6.857 F F2(errno)4.106 E F0 +1.356(must be)4.106 F 1.573(assigned to a v)72 563.703 R(ariable)-.275 E F2 +(Saved_Errno)4.323 E F0 1.574(prior to calling)4.323 F F2(Primitive_Err)4.324 E +(or\(\))-.495 E F0 1.574(to pre)4.324 F -.165(ve)-.275 G 1.574 +(nt it from being).165 F -.165(ove)72 578.703 S(rwritten by the ne).165 E +(xt system call or C library function.)-.165 E F2(Primitive_Err)5.5 E(or\(\)) +-.495 E F0(does not return.)2.75 E .138 +(Applications that need to supply their o)97 597.303 R .137 +(wn error handler by rede\214ning)-.275 F F2(err)2.887 E(or)-.495 E(-handler) +-.22 E F0(usually)2.887 E(do so in Scheme, typically at the be)72 612.303 Q +(ginning of the initial Scheme \214le loaded in)-.165 E F2(main\(\))2.75 E F0 +(.)A(If)97 630.903 Q F2(Primitive_Err)3.012 E(or\(\))-.495 E F0 .262 +(is called from within a C function that implements a Scheme primiti)3.012 F +-.165(ve)-.275 G(,).165 E 1.231 +(an error tag is supplied by Elk \(the name of the primiti)72 645.903 R -.165 +(ve)-.275 G 3.98(\). Applications).165 F 1.23(may set the error tag)3.98 F +-.165(ex)72 660.903 S .578(plicitly at the be).165 F .578 +(ginning of sections of C/C++ code that reside outside of primiti)-.165 F -.165 +(ve)-.275 G .579(s, for e).165 F(xam-)-.165 E .41 +(ple, before loading an initial Scheme \214le in the application')72 675.903 R +(s)-.605 E F2(main\(\))3.16 E F0 5.91(.T)C .63 -.11(wo f)387.876 675.903 T .41 +(unctions are pro).11 F(vided)-.165 E(to set and query the current error tag:) +72 689.903 Q EP +%%Page: 46 46 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 51 S 2.75(6-)288 51 S/F1 10/Courier@0 +SF(void Set_Error_Tag\(const char *tag\);)100.346 86 Q +(char *Get_Error_Tag\(void\);)100.346 100 Q F0 .924(The follo)72 122.5 R .924 +(wing three functions can be used by primiti)-.275 F -.165(ve)-.275 G 3.675(st) +.165 G 3.675(os)331.658 122.5 S .925(ignal errors with standardized mes-) +345.112 122.5 R(sages in certain situations:)72 136.5 Q F1 +(void Range_Error\(Object offending_obj\);)100.346 159.003 Q +(void Wrong_Type\(Object offending_obj, int expected_type\);)100.346 173.003 Q +(void Wrong_Type_Combination\(Object offending_obj, char *expected_type\);) +100.346 187.003 Q/F2 11/Times-Italic@0 SF(Rang)72 209.503 Q(e_Err)-.11 E +(or\(\))-.495 E F0 .499(can be used when an ar)3.249 F .498 +(gument to a primiti)-.198 F .828 -.165(ve i)-.275 H 3.248(so).165 G .498 +(ut of range \(typically some kind)360.666 209.503 R .292(of inde)72 224.503 R +(x\).)-.165 E F2(Wr)5.792 E(ong_T)-.495 E(ype\(\))-.814 E F0 .292(signals a f) +3.042 F .292(ailed type-check for the gi)-.11 F -.165(ve)-.275 G(n).165 E F2 +(Object)3.042 E F0 3.042(;t)C .292(he second ar)405.256 224.503 R .293 +(gument is)-.198 F 4.15(the e)72 239.503 R 4.15(xpected type of the)-.165 F F2 +(Object)6.899 E F0 9.649(.T)C 4.149(his function is used, for e)248.863 239.503 +R 4.149(xample, by)-.165 F F2(Chec)6.899 E(k_T)-.22 E(ype\(\))-.814 E F0(.)A F2 +(Wr)72 254.503 Q(ong_T)-.495 E(ype_Combination\(\))-.814 E F0 .103 +(is similar to)2.853 F F2(Wr)2.853 E(ong_T)-.495 E(ype\(\))-.814 E F0 2.853(;t) +C .103(he e)327.473 254.503 R .104(xpected type is speci\214ed as a string.) +-.165 F .937(This is useful if an)72 269.503 R F2(Object)3.687 E F0 .937 +(can be a member of one out of tw)3.687 F 3.686(oo)-.11 G 3.686(rm)364.253 +269.503 S .936(ore types, e.)380.16 269.503 R .936(g. a string or a)1.833 F +(symbol.)72 284.503 Q -.165(Fa)72 302.103 S +(tal errors can be signaled using the functions).165 E F1 +(void Fatal_Error\(char *fmt, ...\);)100.346 324.606 Q +(void Panic\(char *msg\);)100.346 338.606 Q F2 -.825(Fa)72 361.106 S(tal_Err) +.825 E(or\(\))-.495 E F0 .257(passes its ar)3.007 F .257(guments to)-.198 F F2 +(printf\(\))3.007 E F0 .258(and then terminates the program.)3.007 F F2 -.88 +(Pa)5.758 G(nic\(\)).88 E F0 .258(is used in)3.008 F .134(situations that `)72 +376.106 R .134(`cannot happen')-.814 F 2.884('\()-.814 G -.11(fa)219.991 +376.106 S .134(iled consistenc).11 F 2.884(yc)-.165 G .133(hecks or f)306.741 +376.106 R .133(ailed assertions\); it prints the spec-)-.11 F +(i\214ed message and terminates the program with a core dump.)72 391.106 Q/F3 +11/Times-Bold@0 SF 2.75(12.6. Exceptions)72 421.106 R F0 .132(As e)97 439.706 R +.132(xplained in the Elk Reference Manual, a user)-.165 F .132 +(-supplied Scheme procedure is called each)-.22 F .653(time an)72 454.706 R F2 +-.22(ex)3.403 G(ception).22 E F0 .653(is raised.)3.403 F(Currently)6.152 E +3.402(,t)-.715 G .652 +(he set of UNIX signals that are caught by the interpreter)250.651 454.706 R +1.754(or an e)72 469.706 R 1.754(xtension \(at least)-.165 F F2(interrupt)4.504 +E F0(and)4.505 E F2(alarm)4.505 E F0 4.505(\)a)C 1.755(re used as e)291.174 +469.706 R 4.505(xceptions. As)-.165 F 1.755(signals occur asyn-)4.505 F +(chronously)72 484.706 Q 2.901(,e)-.715 G .151(xtensions and applications must\ + be able to protect non-reentrant or otherwise critical)130.539 484.706 R .113 +(code sections from the deli)72 499.706 R -.165(ve)-.275 G .113(ry of signals.) +.165 F .113(In particular)5.613 F 2.864(,c)-.44 G .114(alls to e)328.141 +499.706 R .114(xternal library functions are fre-)-.165 F +(quently not reentrant)72 514.706 Q/F4 9/Times-Roman@0 SF(6)-3.6 I F0 +(and need to be protected from being disrupted.)2.75 3.6 M 1.486 +(Extensions may call the macros)97 533.306 R F2(Disable_Interrupts)4.236 E F0 +(and)4.236 E F2(Enable_Interrupts)4.236 E F0 1.487(\(without ar)4.237 F(gu-) +-.198 E .624(ments\) to enclose code fragments that must be protected from e)72 +548.306 R 3.373(xceptions. Calls)-.165 F .623(to these macros)3.373 F 1.247 +(can be nested, and the)72 563.306 R 3.997(ya)-.165 G 1.247(re also a)188.037 +563.306 R -.275(va)-.22 G 1.248(ilable as Scheme primiti).275 F -.165(ve)-.275 +G 3.998(so).165 G 3.998(nt)371.171 563.306 S 1.248(he Scheme-language le) +383.727 563.306 R -.165(ve)-.275 G(l.).165 E .037(As all modern UNIX v)72 +578.306 R .036(ersions pro)-.165 F .036(vide a f)-.165 F .036 +(acility to temporarily block the deli)-.11 F -.165(ve)-.275 G .036 +(ry of signals, a sig-).165 F 1.527(nal that occurs after a call to)72 593.306 +R F2(Disable_Interrupts)4.277 E F0 1.527 +(will be delayed until the outermost matching)4.277 F F2(Enable_Interrupts)72 +608.306 Q F0 7.569(is e)162.983 608.306 R -.165(xe)-.165 G 10.319(cuted. T).165 +F 7.789 -.11(wo a)-.88 H 7.569(dditional macros,).11 F F2 -1.155(Fo)363.87 +608.306 S -.407(rc)1.155 G(e_Disable_Interrupts).407 E F0(and)488.116 608.306 Q +F2 -1.155(Fo)72 623.306 S -.407(rc)1.155 G(e_Enable_Interrupts).407 E F0 .056 +(can be used to enable and disable signal deli)2.806 F -.165(ve)-.275 G .057 +(ry re).165 F -.055(ga)-.165 G .057(rless of the current).055 F .129 +(nesting le)72 638.306 R -.165(ve)-.275 G 2.879(l. Extensions).165 F .129 +(that use additional signals \(such as the)2.879 F F2(alarm)2.878 E F0 .128 +(signal\) must re)2.878 F .128(gister these)-.165 F .574 +(with the interpreter core to mak)72 653.306 R 3.324(es)-.11 G .574(ure the) +226.243 653.306 R 3.324(ya)-.165 G .574(re included in the)270.599 653.306 R F2 +(mask)3.325 E F0 .575(of signals that is maintained)3.325 F(by)72 668.306 Q F2 +(Disable_Interrupts)4.246 E F0(and)4.246 E F2(Enable_Interrupts)4.246 E F0 +1.496(\(the interf)4.246 F 1.496(ace for re)-.11 F 1.495 +(gistering signals is still being)-.165 F(re)72 683.306 Q +(vised; refer to the source code of the UNIX e)-.275 E(xtension for an e)-.165 +E(xample\).)-.165 E .36 LW 76.5 694.306 72 694.306 DL 81 694.306 76.5 694.306 +DL 85.5 694.306 81 694.306 DL 90 694.306 85.5 694.306 DL 94.5 694.306 90 +694.306 DL 99 694.306 94.5 694.306 DL 103.5 694.306 99 694.306 DL 108 694.306 +103.5 694.306 DL 112.5 694.306 108 694.306 DL 117 694.306 112.5 694.306 DL +121.5 694.306 117 694.306 DL 126 694.306 121.5 694.306 DL 130.5 694.306 126 +694.306 DL 135 694.306 130.5 694.306 DL 139.5 694.306 135 694.306 DL 144 +694.306 139.5 694.306 DL/F5 7/Times-Roman@0 SF(6)82 704.306 Q F4 -.135(Fo)4.5 +2.8 O(rtunately).135 E 2.667(,w)-.585 G .417(ith the adv)142.194 707.106 R .417 +(ent of multithreading, v)-.135 F .417(endors are no)-.135 F 2.667(wb)-.225 G +-.135(eg)329.76 707.106 S .417(inning to pro).135 F .416(vide reentrant v)-.135 +F(ersions)-.135 E(of their system libraries.)72 718.106 Q EP +%%Page: 47 47 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 51 S 2.75(7-)288 51 S 1.484 +(The ability to protect code from e)97 87 R 1.484 +(xceptions is particularly useful for primiti)-.165 F -.165(ve)-.275 G 4.235 +(st).165 G 1.485(hat tem-)466.16 87 R 1.244(porarily open a \214le or allocate\ + some other kind of resource that must subsequently be released)72 102 R(ag)72 +117 Q 5.642(ain. If)-.055 F 2.892(the rele)5.642 F -.275(va)-.275 G 2.893 +(nt code fragment were not enclosed by calls to).275 F/F1 11/Times-Italic@0 SF +(Disable_Interrupts)5.643 E F0(and)5.643 E F1(Enable_Interrupts)72 132 Q F0 +2.931(,a)C 2.931(ne)163.228 132 S .181(xception handler could abandon e)176.378 +132 R -.165(xe)-.165 G .181(cution of the code section by calling a).165 F .687 +(continuation, thus causing the \214le to remain open fore)72 147 R -.165(ve) +-.275 G 4.648 -.605(r. W).165 H .688(hile situations lik).605 F 3.438(et)-.11 G +.688(his can be han-)435.65 147 R .248(dled by)72 162 R F1(dynamic-wind)2.998 E +F0 .248(on the Scheme le)2.998 F -.165(ve)-.275 G .247(l, some form of).165 F +F1(try/catc)2.997 E(h)-.165 E F0 -.11(fa)2.997 G .247(cility is not a).11 F +-.275(va)-.22 G .247(ilable on the).275 F 1.073(C-language le)72 177 R -.165 +(ve)-.275 G 1.073(l, and using the C function implementing the).165 F F1 +(dynamic-wind)3.823 E F0(primiti)3.823 E 1.404 -.165(ve w)-.275 H 1.074 +(ould be).055 F(cumbersome.)72 192 Q(The function)72 209.6 Q/F2 10/Courier@0 SF +(void Signal_Exit\(int signal_number\);)100.346 232.103 Q F0 .162(may be used \ +as the handler for signals that must terminate the application; it ensures tha\ +t the tem-)72 254.603 R 1.126(porary \214les maintained by Elk are remo)72 +269.603 R -.165(ve)-.165 G 3.876(da).165 G 1.127(nd calls the e)277.816 269.603 +R 1.127(xtension \214nalization functions in the)-.165 F(normal w)72 284.603 Q +(ay)-.11 E(.)-.715 E/F3 11/Times-Bold@0 SF 2.75(12.7. De\214ning)72 314.603 R +(Scheme V)2.75 E(ariables)-1.012 E F0(User)97 333.203 Q .288 +(-supplied C/C++ code can de\214ne global Scheme v)-.22 F .288 +(ariables that are maintained as corre-)-.275 F(sponding)72 348.203 Q F1 +(Object)4.439 E F0 4.439(Cv)4.439 G 4.439(ariables. The)167.542 348.203 R 1.689 +(Scheme interpreter itself de\214nes se)4.439 F -.165(ve)-.275 G 1.689 +(ral such v).165 F 1.69(ariables, for)-.275 F -.165(ex)72 363.203 S 2.631 +(ample, the v).165 F(ariable)-.275 E F1(load-path)5.381 E F0 2.63 +(\(see section 5\) which can be modi\214ed and read both from)5.381 F 1.592 +(Scheme and from C.)72 378.203 R 1.592(The function)7.092 F F1(De\214ne_V)4.342 +E(ariable\(\))-1.221 E F0 1.593(is used to de\214ne a Scheme v)4.342 F 1.593 +(ariable and)-.275 F(bind an initial v)72 392.203 Q(alue to it:)-.275 E F2 +(void Define_Variable\(Object *var, const char *name, Object init\);)100.346 +414.706 Q F1(var)72 437.206 Q F0 .425(is the address of the C v)3.175 F .424 +(ariable corresponding to the ne)-.275 F .424(wly-created Scheme v)-.275 F +(ariable,)-.275 E F1(name)3.174 E F0(is)3.174 E .892(the name of the Scheme v) +72 452.206 R .892(ariable, and)-.275 F F1(init)3.642 E F0 .892 +(is its initial v)3.642 F(alue.)-.275 E F1(De\214ne_V)6.393 E(ariable\(\)) +-1.221 E F0(calls)3.643 E F1(Intern\(\))3.643 E F0(to)3.643 E 1.27 +(create the v)72 467.206 R 1.269(ariable name included in the ne)-.275 F 4.019 +(wb)-.275 G 1.269(inding and)286.272 467.206 R F1(Func_Global_GC_Link\(\))4.019 +E F0 1.269(to properly)4.019 F(re)72 482.206 Q(gister the C v)-.165 E +(ariable with the g)-.275 E(arbage collector)-.055 E(.)-.605 E +(The C side of a Scheme v)72 499.806 Q +(ariable cannot be accessed directly; the functions)-.275 E F2 +(Var_Set\(Object variable, Object value\);)100.346 522.309 Q +(Var_Get\(Object variable\))100.346 536.309 Q(Var_Is_True\(Object variable\)) +100.346 550.309 Q F0 .521(must be used instead to assign a v)72 572.809 R .521 +(alue to the v)-.275 F .521(ariable and to read its current v)-.275 F .521 +(alue; the \214rst ar)-.275 F(gu-)-.198 E 5.332(ment to each function is the)72 +587.809 R F1(Object)8.082 E F0 5.332(whose address w)8.082 F 5.332 +(as passed to)-.11 F F1(De\214ne_V)8.082 E(ariable\(\))-1.221 E F0(.)A F1 +-1.221(Va)72 602.809 S(r_Is_T)1.221 E(rue\(\))-.605 E F0 .258(is con)3.008 F +-.165(ve)-.44 G .258(nient for boolean v).165 F .258 +(ariables and tests whether the contents of the v)-.275 F .259(ariable is)-.275 +F 1.418(true in the sense of)72 617.809 R F1 -.605(Tr)4.168 G(uep\(\)).605 E F0 +6.918(.A)C 4.168(sa)215.544 617.809 S 4.168(ne)228.875 617.809 S 1.417 +(xample, Figure 10 sho)243.262 617.809 R 1.417(ws ho)-.275 F 4.167(wt)-.275 G +1.417(he Xt e)387.903 617.809 R 1.417(xtension de\214nes a)-.165 F 2.031 +(Scheme v)72 632.809 R 2.031(ariable that is associated with the user)-.275 F +2.031(-de\214ned `)-.22 F(`w)-.814 E 2.032(arning handler')-.11 F 4.782('c) +-.814 G 2.032(alled by the Xt)432.828 632.809 R(library to output w)72 647.809 +Q(arning messages.)-.11 E 1.498(In the e)97 666.409 R 1.498 +(xample in Figure 10, the function)-.165 F F1(Xt_W)4.248 E(arning\(\))-1.012 E +F0 1.497(is re)4.247 F 1.497(gistered as the Xt `)-.165 F(`w)-.814 E(arning) +-.11 E(handler')72 681.409 Q 3.75('b)-.814 G 3.75(yp)120.751 681.409 S 1 +(assing it to)135.501 681.409 R F1(XtSetW)3.75 E(arningHandler\(\))-1.012 E F0 +6.5(.I)C 3.75(ti)306.536 681.409 S 3.75(si)316.402 681.409 S -2.09 -.44(nv o) +327.489 681.409 T -.11(ke).44 G 3.75(db).11 G 3.75(yX)368.353 681.409 S 3.75 +(tw)385.545 681.409 S 1(ith a w)400.295 681.409 R 1(arning message.)-.11 F .239 +(The message is con)72 696.409 R -.165(ve)-.44 G .239 +(rted to a Scheme string, and, if the Scheme v).165 F(ariable)-.275 E F1 +(xt-warning-handler)2.988 E F0(has)2.988 E .154 +(been assigned a procedure, this procedure is called with the string using)72 +711.409 R F1(Funcall\(\))2.905 E F0 5.655(.O)C .155(therwise the)450.385 +711.409 R 2.393(string is just sent to the current output port.)72 726.409 R +2.393(The call to)7.893 F F1(De\214ne_V)5.142 E(ariable\(\))-1.221 E F0 2.392 +(in the e)5.142 F(xtension)-.165 E EP +%%Page: 48 48 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 51 S 2.75(8-)288 51 S(________________\ +______________________________________________________________)75 99.5 Q/F1 10 +/Courier@0 SF(Object V_Xt_Warning_Handler;)72 119 Q +(void Xt_Warning\(char *msg\) {)72 141.4 Q(Object args, fun;)99.5 155.4 Q +(args = Cons\(Make_String\(msg, strlen\(msg\)\), Null\);)99.5 177.8 Q +(fun = Var_Get\(V_Xt_Warning_Handler\);)99.5 191.8 Q +(if \(TYPE\(fun\) == T_Compound\))99.5 205.8 Q +(\(void\)Funcall\(fun, args, 0\);)127 219.8 Q(else)99.5 233.8 Q +(Printf\(Curr_Output_Port, "%s\\n", msg\);)127 247.8 Q(})72 261.8 Q +(void elk_init_xt_error\(void\) {)72 284.2 Q +(Define_Variable\(&V_Xt_Warning_Handler, "xt-warning-handler", Null\);)99.5 +298.2 Q(XtSetWarningHandler\(Xt_Warning\);)99.5 312.2 Q(})72 326.2 Q/F2 10 +/Times-Bold@0 SF(Figur)116.2 344 Q 2.5(e1)-.18 G(0:)151.85 344 Q/F3 10 +/Times-Roman@0 SF(The Xt e)5 E(xtension de\214nes a Scheme v)-.15 E +(ariable holding a `)-.25 E(`w)-.74 E(arning handler')-.1 E(')-.74 E F0(______\ +________________________________________________________________________)75 +362.6 Q 2.315(initialization function associates the Scheme v)72 392.6 R +(ariable)-.275 E/F4 11/Times-Italic@0 SF(xt-warning-handler)5.065 E F0 2.316 +(with the C v)5.065 F(ariable)-.275 E F4(V_Xt_W)72 407.6 Q(arning_Handler) +-1.012 E F0(\(as a con)2.75 E -.165(ve)-.44 G(ntion, Elk uses the pre\214x `) +.165 E(`V_')-.814 E 2.75('f)-.814 G(or v)376.095 407.6 Q +(ariables of this kind\).)-.275 E/F5 11/Times-Bold@0 SF 2.75(12.8. De\214ning) +72 437.6 R(Readers)2.75 E F0 .449(In addition or as an alternati)97 456.2 R +.779 -.165(ve t)-.275 H 3.199(ot).165 G .449(he constructor primiti)250.931 +456.2 R .779 -.165(ve f)-.275 H .449(or a ne).165 F 3.198(wS)-.275 G .448 +(cheme type, applica-)411.771 456.2 R .271(tions and e)72 471.2 R .272 +(xtensions may de\214ne a)-.165 F F4 -.407(re)3.022 G(ader).407 E F0 .272 +(function for each ne)3.022 F 3.022(wt)-.275 G 3.022(ype. The)359.175 471.2 R +.272(bitstring e)3.022 F .272(xtension, for)-.165 F -.165(ex)72 486.2 S .751 +(ample, de\214nes a reader to allo).165 F 3.501(wi)-.275 G .751 +(nput of bitstring literals using the)232.167 486.2 R F4(#*10110001)3.501 E F0 +3.5(syntax. Each)3.501 F(user)72 501.2 Q .571 +(-de\214ned read syntax is introduced by the `#' symbol follo)-.22 F .571 +(wed by one more character)-.275 F 3.321(,i)-.44 G(denti-)478.337 501.2 Q .922 +(fying the type of the object.)72 516.2 R 2.682 -.88(To d)6.422 H .922 +(e\214ne a reader).88 F 3.672(,t)-.44 G .922(he follo)295.269 516.2 R .921 +(wing function is called \(typically from)-.275 F(within an e)72 530.2 Q +(xtension initialization function\):)-.165 E F1(void Define_Reader\(int c,) +100.346 552.703 Q +(\(Object \(*func\)\(Object port, int c, int const_flag\)\)\);)124.346 566.703 +Q F0 .282(The ar)97 592.803 R .282(guments to)-.198 F F4(De\214ne_Reader\(\)) +3.032 E F0 .282(are the as yet unused character identifying the type \(e.)3.032 +F(g.)1.833 E .735(`*' for bitstrings\) and a pointer to a)72 607.803 R F4 -.407 +(re)3.485 G .735(ader function).407 F F0 .735(that is in)3.485 F -.22(vo)-.44 G +-.11(ke).22 G 3.485(db).11 G 3.485(yt)381.932 607.803 S .734 +(he Scheme parser when-)393.975 607.803 R -2.365 -.275(ev e)72 622.803 T 3.023 +(rt).275 G .273(he ne)96.572 622.803 R .273 +(wly de\214ned syntax is encountered.)-.275 F .274 +(This reader function is passed a Scheme input port)5.773 F .52 +(from which it reads the ne)72 637.803 R .52(xt tok)-.165 F .52 +(en, the character follo)-.11 F .519(wing the `#' symbol \(to f)-.275 F .519 +(acilitate using the)-.11 F 3.055(same reader for dif)72 652.803 R 3.055 +(ferent types\), and a \215ag indicating whether the ne)-.275 F 3.056 +(wly-created object is)-.275 F -.165(ex)72 667.803 S .521 +(pected to be made read-only \(this is true when e).165 F .521 +(xpressions are loaded from a \214le\).)-.165 F .52(The reader)6.021 F +(function must return a ne)72 682.803 Q 2.75(wo)-.275 G(bject of the gi)198.511 +682.803 Q -.165(ve)-.275 G 2.75(nt).165 G(ype.)280.56 682.803 Q -1.21(Yo)97 +701.403 S 4.678(um)1.21 G 1.928(ay w)127.968 701.403 R 1.928 +(ant to refer to the bitstring e)-.11 F 1.929 +(xtension included in the Elk distrib)-.165 F 1.929(ution for an)-.22 F -.165 +(ex)72 716.403 S 1.292(ample de\214nition of a reader function \(`).165 F +(`lib/misc/bitstring.c')-.814 E 1.292('\), and for the macros that can be)-.814 +F(used by reader functions to ef)72 731.403 Q +(\214ciently read characters from a port.)-.275 E EP +%%Page: 49 49 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4)276.087 51 S 2.75(9-)288 51 S/F1 11 +/Times-Bold@0 SF 2.75(12.9. F)72 87 R(ork Handlers)-.275 E F0 .711 +(Extensions may need to be noti\214ed when a cop)97 105.6 R 3.461(yo)-.11 G +3.461(ft)324.18 105.6 S .711(he running interpreter \(or application\))334.362 +105.6 R 1.624(is created by means of the)72 120.6 R/F2 11/Times-Italic@0 SF +(fork\(\))4.374 E F0 1.623(UNIX system call.)4.373 F -.165(Fo)7.123 G 4.373(re) +.165 G 1.623(xample, consider an e)345.224 120.6 R 1.623(xtension that)-.165 F +1.549(stores information in a temporary \214le and remo)72 135.6 R -.165(ve) +-.165 G 4.299(st).165 G 1.55(his \214le on termination of the program.)312.587 +135.6 R(If)7.05 E 1.485(another e)72 150.6 R 1.485(xtension created a cop)-.165 +F 4.235(yo)-.11 G 4.235(ft)231.577 150.6 S 1.485 +(he running interpreter by calling)242.533 150.6 R F2(fork\(\))4.235 E F0 4.234 +(,t)C 1.484(he child process)430.159 150.6 R -.11(wo)72 165.6 S .589(uld remo) +.11 F .919 -.165(ve t)-.165 H .589(he temporary \214le on e).165 F .589 +(xit\212the \214le w)-.165 F .59(ould not be a)-.11 F -.275(va)-.22 G .59 +(ilable to the original instance).275 F .906(of the interpreter \(i.)72 180.6 R +.906(e. the parent process\) an)1.833 F 3.656(yl)-.165 G(onger)284.966 180.6 Q +6.406(.T)-.605 G 3.656(op)324.405 180.6 S(re)339.061 180.6 Q -.165(ve)-.275 G +.906(nt premature remo).165 F -.275(va)-.165 G 3.655(lo).275 G 3.655(ft)462.777 +180.6 S .905(he \214le,)473.153 180.6 R .168(the e)72 195.6 R .169 +(xtension that o)-.165 F .169(wns it can de\214ne a)-.275 F F2 .169 +(fork handler)2.919 F F0 .169(by calling)2.919 F F2(Re)2.919 E +(gister_Onfork\(\))-.44 E F0 .169(with a pointer to)2.919 F 2.75(aCf)72 209.6 S +(unction:)93.384 209.6 Q/F3 10/Courier@0 SF +(void Register_Onfork\(\(void \(*func\)\(void\)\)\);)100.346 232.103 Q F0 .493 +(The function could create an additional link to the \214le, so that a child p\ +rocess w)72 254.603 R .492(ould just remo)-.11 F -.165(ve)-.165 G +(this link on e)72 269.603 Q(xit, lea)-.165 E(ving the original link intact.) +-.22 E 1.138(Extensions that use)97 288.203 R F2(fork\(\))3.888 E F0 1.139 +(without e)3.889 F -.165(xe)-.165 G 1.139(cuting a ne).165 F 3.889(wp)-.275 G +1.139(rogram in the child process \(e.)337.087 288.203 R 1.139(g. the)1.833 F +4.839(UNIX e)72 303.203 R 4.839(xtension which de\214nes a)-.165 F F2 +(unix-fork)7.589 E F0(primiti)7.589 E -.165(ve)-.275 G 7.589(\)a).165 G 4.839 +(re required to call the function)346.311 303.203 R F2(Call_Onfork\(\))72 +317.203 Q F0(in the ne)2.75 E(wly created child process to in)-.275 E -.22(vo) +-.44 G .22 -.11(ke a).22 H(ll currently de\214ned fork handlers:).11 E F3 +(void Call_Onfork\(void\);)100.346 339.706 Q F1 -.275(Ap)72 377.206 S +(pendix A: Functions that can T).275 E(rigger a Garbage Collection)-.814 E F0 +1.854(This appendix lists the functions e)97 395.806 R 1.854 +(xported by Elk that may trigger a g)-.165 F 1.854(arbage collection.)-.055 F +-.44(Wi)72 410.806 S .262 +(thin C/C++ code, local Scheme objects must be protected as sho).44 F .261 +(wn in section 9.1 when one of)-.275 F +(these functions is called during the objects' lifetime.)72 425.806 Q .229 +(The C functions corresponding to the follo)97 444.406 R .229 +(wing Scheme primiti)-.275 F -.165(ve)-.275 G 2.979(sc).165 G .23(an cause a g) +400.516 444.406 R .23(arbage col-)-.055 F(lection:)72 458.406 Q EP +%%Page: 50 50 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 51 S 2.75(0-)288 51 S/F1 10/Courier@0 +SF 102(append load)100.346 86 R(read-string)388.346 86 Q 108(apply macro-body) +100.346 100 R(require)388.346 100 Q 90(autoload macro-expand)100.346 114 R +(reverse)388.346 114 Q 54(backtrace-list make-list)100.346 128 R(string)388.346 +128 Q 18(call-with-input-file make-string)100.346 142 R(string->list)388.346 +142 Q 12(call-with-output-file make-vector)100.346 156 R(string->number)388.346 +156 Q 96(call/cc map)100.346 170 R(string->symbol)388.346 170 Q 36 +(command-line-args oblist)100.346 184 R(string-append)388.346 184 Q 114 +(cons open-input-file)100.346 198 R(string-copy)388.346 198 Q 114 +(dump open-input-output-file)100.346 212 R(substring)388.346 212 Q 66 +(dynamic-wind open-input-string)100.346 226 R(symbol-plist)388.346 226 Q 114 +(eval open-output-file)100.346 240 R(tilde-expand)388.346 240 Q 90 +(for-each open-output-string)100.346 254 R(type)388.346 254 Q 108 +(force port-line-number)100.346 268 R(vector)388.346 268 Q 36 +(get-output-string procedure-lambda)100.346 282 R(vector->list)388.346 282 Q +114(list provide)100.346 296 R(vector-copy)388.346 296 Q 66(list->string put) +100.346 310 R(with-input-from-file)388.346 310 Q 66(list->vector read)100.346 +324 R(with-output-to-file)388.346 324 Q/F2 10/Times-Italic@0 SF +(all special forms)100.346 346.4 Q(all mathematical primitives e)100.346 360.4 +Q(xcept pr)-.2 E(edicates)-.37 E +(all output primitives if output is sent to a string port)100.346 374.4 Q F0 +.444(In practice, most of these functions, in particular the special forms, ar\ +e rarely or ne)97 400.5 R -.165(ve)-.275 G 3.193(ru).165 G(sed)489.337 400.5 Q +.158(in e)72 415.5 R .159(xtensions or Elk-based applications.)-.165 F .159 +(In addition to these primiti)5.659 F -.165(ve)-.275 G .159(s, the follo).165 F +.159(wing C functions)-.275 F(can trigger a g)72 429.5 Q(arbage collection:) +-.055 E F1 54(Alloc_Object\(\) Make_Reduced_Flonum\(\))100.346 452.003 R +(Make_String\(\))388.346 452.003 Q 72(Make_Port\(\) Make_Flonum\(\))100.346 +466.003 R(Make_Const_String\(\))388.346 466.003 Q 30 +(Load_Source_Port\(\) Define_Primitive\(\) Intern\(\))100.346 480.003 R 72 +(Load_File\(\) Printf\(\))100.346 494.003 R(CI_Intern\(\))388.346 494.003 Q 72 +(Copy_List\(\) Print_Object\(\))100.346 508.003 R(Define_Variable\(\))388.346 +508.003 Q 66(Const_Cons\(\) General_Print_Object\(\))100.346 522.003 R +(Define_Symbol\(\))388.346 522.003 Q 54(Make_Integer\(\) Format\(\))100.346 +536.003 R(Bits_To_Symbols\(\))388.346 536.003 Q 48(Make_Unsigned\(\) Eval\(\)) +100.346 550.003 R(Make_Vector\(\))388.346 550.003 Q 72 +(Make_Long\(\) Funcall\(\))100.346 564.003 R(Make_Const_Vector\(\))388.346 +564.003 Q(Make_Unsigned_Long\(\))100.346 578.003 Q F0(Note:)72 604.103 Q/F3 11 +/Times-Italic@0 SF(Mak)4.82 E(e_Inte)-.11 E -.11(ge)-.44 G(r\(\)).11 E F0(,)A +F3(Mak)4.819 E(e_Unsigned\(\))-.11 E F0(,)A F3(Mak)4.819 E(e_Long\(\))-.11 E F0 +4.819(,a)C(nd)336.291 604.103 Q F3(Mak)4.819 E(e_Unsigned_Long\(\))-.11 E F0 +2.069(can only)4.819 F .33(trigger a g)72 619.103 R .331(arbage collection if) +-.055 F F3(FIXNUM_FITS\(\))3.081 E F0(\(or)3.081 E F3(UFIXNUM_FITS\(\))3.081 E +F0 3.081(,r)C(especti)395.648 619.103 Q -.165(ve)-.275 G .331 +(ly\) returns zero).165 F(for the gi)72 634.103 Q -.165(ve)-.275 G 2.75(na).165 +G -.198(rg)135.404 634.103 S(ument.).198 E/F4 11/Times-Bold@0 SF -.275(Ap)72 +664.103 S(pendix B: Con).275 E -.11(ve)-.44 G(nience Functions f).11 E +(or GC-Safe Data Structur)-.275 E(es)-.198 E F0 .12(Figure 11 sho)97 682.703 R +.12 +(ws the source code for a set of functions to insert Scheme objects into a v) +-.275 F(ector)-.165 E 2.144(that has been re)72 697.703 R 2.144 +(gistered with the g)-.165 F 2.144(arbage collector)-.055 F 4.894(,t)-.44 G +4.894(od)317.908 697.703 S 2.144(elete objects from the v)333.802 697.703 R +(ector)-.165 E 4.894(,a)-.44 G 2.145(nd to)479.547 697.703 R(retrie)72 712.703 +Q .565 -.165(ve t)-.275 H .235(he object stored under a gi).165 F -.165(ve) +-.275 G 2.985(nv).165 G .235(ector inde)252.527 712.703 R 2.985(x. These)-.165 +F .234(functions help b)2.985 F .234(uilding dynamic data)-.22 F 2.475 +(structures \(such as link)72 727.703 R 2.476 +(ed lists or hash tables\) containing Scheme objects.)-.11 F 2.476 +(There is nothing)7.976 F EP +%%Page: 51 51 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 51 S 2.75(1-)288 51 S .117(application\ +-speci\214c in the code; if you \214nd it useful, you can directly include it \ +in your Elk e)72 87 R(xten-)-.165 E(sion or Elk-based application without an)72 +102 Q 2.75(yc)-.165 G 2.75(hanges. See)263.092 102 R +(section 12.3 for a detailed description.)2.75 E EP +%%Page: 52 52 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 51 S 2.75(2-)288 51 S(________________\ +______________________________________________________________)75 99.5 Q/F1 10 +/Courier@0 SF(static int max_objects = 32;)72 119 Q(/* initial size */)270 119 +Q(static int num_objects;)72 133 Q(static Object objects;)72 147 Q +(static int inx;)72 161 Q(int register_object\(Object x\) {)72 183.4 Q +(Object v;)99.5 197.4 Q(int n;)99.5 211.4 Q(GC_Node;)99.5 225.4 Q +(if \(num_objects == max_objects\) {)99.5 247.8 Q(max_objects *= 2;)127 261.8 Q +(GC_Link\(x\);)127 275.8 Q 6(v=M)127 289.8 S(ake_Vector\(max_objects, Null\);) +157 289.8 Q(GC_Unlink;)127 303.8 Q +(memcpy\(VECTOR\(v\)->data, VECTOR\(objects\)->data,)127 317.8 Q +(num_objects * sizeof\(Object\)\);)154.5 331.8 Q(objects = v;)127 345.8 Q +(inx = num_objects;)127 359.8 Q(})99.5 373.8 Q +(for \(n = 0; !Nullp\(VECTOR\(objects\)->data[inx]\);)99.5 387.8 Q +(inx++, inx %= max_objects\) {)154.5 401.8 Q(n++;)127 415.8 Q +(assert\(n < max_objects\);)127 429.8 Q(})99.5 443.8 Q +(VECTOR\(objects\)->data[inx] = x;)99.5 457.8 Q(num_objects++;)99.5 471.8 Q +(return inx;)99.5 485.8 Q(})72 499.8 Q(void deregister_object\(int i\) {)72 +522.2 Q(VECTOR\(objects\)->data[i] = Null;)99.5 536.2 Q(--num_objects;)99.5 +550.2 Q(assert\(num_objects >= 0\);)99.5 564.2 Q(})72 578.2 Q +(Object get_object\(int i\) {)72 600.6 Q(return VECTOR\(objects\)->data[i];) +99.5 614.6 Q(})72 628.6 Q(void elk_init_gcroot\(void\) {)72 651 Q +(objects = Make_Vector\(max_objects, Null\);)99.5 665 Q +(Global_GC_Link\(objects\);)99.5 679 Q(})72 693 Q/F2 10/Times-Bold@0 SF(Figur) +130.695 710.8 Q 2.5(e1)-.18 G(1:)166.345 710.8 Q/F3 10/Times-Roman@0 SF +(Functions to map Scheme objects to inde)5 E -.15(xe)-.15 G 2.5(si).15 G +(nto a GC-safe v)362.425 710.8 Q(ector)-.15 E F0(_____________________________\ +_________________________________________________)75 729.4 Q EP +%%Page: 53 53 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 51 S 2.75(3-)288 51 S/F1 11 +/Times-Bold@0 SF -.275(Ap)72 87 S(pendix C: Summary of Functions, Macr).275 E +(os, T)-.198 E(ypes, and V)-.814 E(ariables)-1.012 E F0 .475(This appendix pro) +97 105.6 R .475(vides a quick o)-.165 F -.165(ve)-.165 G(rvie).165 E 3.225(wo) +-.275 G 3.226(ft)289.105 105.6 S .476(he functions and other de\214nitions e) +299.052 105.6 R .476(xported by)-.165 F .859(the Elk k)72 120.6 R 3.609 +(ernel. The)-.11 F .859(list is di)3.609 F .858 +(vided in groups of de\214nitions with related functionality; the entries)-.275 +F .491(are presented in roughly the same order in which the)72 135.6 R 3.241 +(ya)-.165 G .492(re introduced in the abo)321.132 135.6 R .822 -.165(ve c)-.165 +H 3.242(hapters. Full).165 F 1.071(function prototypes are gi)72 150.6 R -.165 +(ve)-.275 G 3.821(nf).165 G 1.071(or functions; in some prototypes, ar)211.485 +150.6 R 1.071(guments are gi)-.198 F -.165(ve)-.275 G 3.821(nn).165 G 1.071 +(ames for)464.748 150.6 R 3.851(clari\214cation. The)72 165.6 R 1.101 +(initial k)3.851 F -.165(ey)-.11 G -.11(wo).165 G(rds).11 E F1(function)3.851 E +F0(,)A F1(macr)3.851 E(o)-.198 E F0(,)A F1(typedef)3.852 E F0 3.852(,a)C(nd) +358.977 165.6 Q F1 -.11(va)3.852 G(riable).11 E F0 1.102(indicate the type of) +3.852 F .737(each entry \(function, preprocessor symbol with or without ar)72 +180.6 R .736(guments, type de\214nition, and e)-.198 F(xter)-.165 E(-)-.22 E +.479(nal v)72 195.6 R .479(ariable de\214ned by Elk, respecti)-.275 F -.165(ve) +-.275 G 3.229(ly\). The).165 F .479(functions corresponding to Scheme primiti) +3.229 F -.165(ve)-.275 G 3.23(s\().165 G(as)494.837 195.6 Q +(described in section 7.4\) ha)72 210.6 Q .33 -.165(ve b)-.22 H +(een omitted from the list.).165 E F1(Accessing the Scheme Object Repr)72 240.6 +Q(esentation)-.198 E/F2 10/Times-Bold@0 SF(typedef)100.346 266.703 Q/F3 10 +/Courier@0 SF(Object)6 E F2(macr)100.346 289.103 Q(o)-.18 E F3(TYPE\(obj\))6 E +F2(macr)100.346 303.103 Q(o)-.18 E F3(POINTER\(obj\))6 E F2(macr)100.346 +317.103 Q(o)-.18 E F3(ISCONST\(obj\))6 E F2(macr)100.346 331.103 Q(o)-.18 E F3 +(SETCONST\(obj\))6 E F2(macr)100.346 345.103 Q(o)-.18 E F3 +(SET\(obj, type, ptr\))6 E F2(macr)100.346 359.103 Q(o)-.18 E F3 +(EQ\(obj1, obj2\))6 E F1(De\214ning Scheme Primiti)72 389.103 Q -.11(ve)-.11 G +(s).11 E F2(function)100.346 415.206 Q F3 +(void Define_Primitive\(\(Object \(*func\)\(\)\), const char *name,)6 E +(int minargs, int maxargs, enum discipline disc\);)190.346 429.206 Q F1 +(Making Objects Kno)72 459.206 Q(wn to the Garbage Collector)-.11 E F2(macr) +100.346 485.309 Q(o)-.18 E F3(GC_Node, GC_Node2, ...)6 E F2(macr)100.346 +499.309 Q(o)-.18 E F3(GC_Link\(obj\), GC_Link2\(obj1, obj2\), ...)6 E F2(macr) +100.346 513.309 Q(o)-.18 E F3(GC_Unlink)6 E F2(macr)100.346 527.309 Q(o)-.18 E +F3(Global_GC_Link\(obj\))6 E F2(function)100.346 541.309 Q F3 +(void Func_Global_GC_Link\(obj_ptr\);)6 E F1(Booleans)72 571.309 Q F2(macr) +100.346 597.412 Q(o)-.18 E F3(T_Boolean)6 E F2(macr)100.346 611.412 Q(o)-.18 E +F3(Truep\(obj\))6 E F2 -.1(va)100.346 633.812 S(riable).1 E F3(Object True)6 E +F2 -.1(va)100.346 647.812 S(riable).1 E F3(Object False)6 E F2(function)100.346 +670.212 Q F3(int Eqv\(Object, Object\);)6 E F2(function)100.346 684.212 Q F3 +(int Equal\(Object, Object\);)6 E EP +%%Page: 54 54 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 51 S 2.75(4-)288 51 S/F1 11 +/Times-Bold@0 SF(Characters)72 87 Q/F2 10/Times-Bold@0 SF(macr)100.346 113.103 +Q(o)-.18 E/F3 10/Courier@0 SF(T_Character)6 E F2(macr)100.346 127.103 Q(o)-.18 +E F3(CHAR\(char_obj\))6 E F2(function)100.346 141.103 Q F3 +(Object Make_Char\(int\);)6 E F2 -.1(va)100.346 155.103 S(riable).1 E F3 +(Object Newline)6 E F1 -.11(Pa)72 185.103 S(irs and Lists).11 E F2(macr)100.346 +211.206 Q(o)-.18 E F3(T_Null)6 E F2(macr)100.346 225.206 Q(o)-.18 E F3 +(Nullp\(obj\))6 E F2 -.1(va)100.346 239.206 S(riable).1 E F3(Null)6 E F2(macr) +100.346 261.606 Q(o)-.18 E F3(T_Pair)6 E F2(macr)100.346 275.606 Q(o)-.18 E F3 +(PAIR\(pair_obj\))6 E F2(macr)100.346 289.606 Q(o)-.18 E F3(Car\(obj\))6 E F2 +(macr)100.346 303.606 Q(o)-.18 E F3(Cdr\(obj\))6 E F2(macr)100.346 317.606 Q(o) +-.18 E F3(Cons\(obj1, obj2\))6 E F2(macr)100.346 340.006 Q(o)-.18 E F3 +(Check_List\(obj\))6 E F2(function)100.346 354.006 Q F3 +(int Fast_Length\(Object\);)6 E F2(function)100.346 368.006 Q F3 +(Object Copy_List\(Object\);)6 E F1(Integers \(Fixnums and Bignums\))72 398.006 +Q F2(macr)100.346 424.109 Q(o)-.18 E F3(T_Fixnum)6 E F2(macr)100.346 438.109 Q +(o)-.18 E F3(T_Bignum)6 E F2(macr)100.346 452.109 Q(o)-.18 E F3 +(FIXNUM_FITS\(integer\))6 E F2(macr)100.346 466.109 Q(o)-.18 E F3 +(UFIXNUM_FITS\(unsigned_integer\))6 E F2(macr)100.346 480.109 Q(o)-.18 E F3 +(FIXNUM\(fixnum_obj\))6 E F2(macr)100.346 494.109 Q(o)-.18 E F3 +(BIGNUM\(bignum_obj\))6 E F2(macr)100.346 516.509 Q(o)-.18 E F3 +(Check_Integer\(obj\))6 E F2(macr)100.346 530.509 Q(o)-.18 E F3 +(Check_Number\(obj\))6 E F2(function)100.346 552.909 Q F3 +(Object Make_Integer\(int\);)6 E F2(function)100.346 566.909 Q F3 +(Object Make_Unsigned\(unsigned\);)6 E F2(function)100.346 580.909 Q F3 +(Object Make_Long\(long\);)6 E F2(function)100.346 594.909 Q F3 +(Object Make_Unsigned_Long\(unsigned long\);)6 E F2(function)100.346 617.309 Q +F3(int Get_Integer\(Object\);)6 E F2(function)100.346 631.309 Q F3 +(unsigned Get_Unsigned\(Object\);)6 E F2(function)100.346 645.309 Q F3 +(long Get_Long\(Object\);)6 E F2(function)100.346 659.309 Q F3 +(unsigned long Get_Unsigned_Long\(Object\);)6 E F2(function)100.346 681.709 Q +F3(int Get_Exact_Integer\(Object\);)6 E F2(function)100.346 695.709 Q F3 +(unsigned Get_Exact_Unsigned\(Object\);)6 E F2(function)100.346 709.709 Q F3 +(long Get_Exact_Long\(Object\);)6 E F2(function)100.346 723.709 Q F3 +(unsigned long Get_Exact_Unsigned_Long\(Object\);)6 E EP +%%Page: 55 55 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 50 S 2.75(5-)288 50 S/F1 11 +/Times-Bold@0 SF(Floating P)72 87 Q(oint Numbers \(Reals\))-.22 E/F2 10 +/Times-Bold@0 SF(macr)100.346 113.103 Q(o)-.18 E/F3 10/Courier@0 SF(T_Flonum)6 +E F2(macr)100.346 127.103 Q(o)-.18 E F3(FLONUM\(flonum_obj\))6 E F2(function) +100.346 141.103 Q F3(Object Make_Flonum\(double\);)6 E F2(function)100.346 +155.103 Q F3(Object Make_Reduced_Flonum\(double\);)6 E F2(function)100.346 +169.103 Q F3(double Get_Double\(Object\);)6 E F1(Symbols)72 199.103 Q F2(macr) +100.346 225.206 Q(o)-.18 E F3(T_Symbol)6 E F2(macr)100.346 239.206 Q(o)-.18 E +F3(SYMBOL\(symbol_obj\))6 E F2(function)100.346 253.206 Q F3 +(Object Intern\(const char *\);)6 E F2(function)100.346 267.206 Q F3 +(Object CI_Intern\(const char *\);)6 E F2(function)100.346 281.206 Q F3 +(void Define_Symbol\(Object *var, const char *name\);)6 E F2 -.1(va)100.346 +295.206 S(riable).1 E F3(Object Void)6 E F2(typedef)100.346 317.606 Q F3 +(SYMDESCR)6 E F2(function)100.346 331.606 Q F3 +(unsigned long Symbols_To_Bits\(Object syms, int mask_flag,)6 E +(SYMDESCR *table\);)190.346 345.606 Q F2(function)100.346 359.606 Q F3 +(Object Bits_To_Symbols\(unsigned long bits, int mask_flag,)6 E +(SYMDESCR *table\);)190.346 373.606 Q F1(Strings)72 403.606 Q F2(macr)100.346 +429.709 Q(o)-.18 E F3(T_String)6 E F2(macr)100.346 443.709 Q(o)-.18 E F3 +(STRING\(string_obj\))6 E F2(function)100.346 457.709 Q F3 +(Object Make_String\(const char *init, int size\);)6 E F2(function)100.346 +471.709 Q F3(char *Get_String\(Object\);)6 E F2(function)100.346 485.709 Q F3 +(char *Get_Strsym\(Object\);)6 E F2(macr)100.346 499.709 Q(o)-.18 E F3 +(Get_String_Stack\(obj, char_ptr\))6 E F2(macr)100.346 513.709 Q(o)-.18 E F3 +(Get_Strsym_Stack\(obj, char_ptr\))6 E F1 -1.1(Ve)72 543.709 S(ctors)1.1 E F2 +(macr)100.346 569.812 Q(o)-.18 E F3(T_Vector)6 E F2(macr)100.346 583.812 Q(o) +-.18 E F3(VECTOR\(vector_obj\))6 E F2(function)100.346 597.812 Q F3 +(Object Make_Vector\(int size, Object fill\);)6 E F1 -.22(Po)72 627.812 S(rts) +.22 E F2(macr)100.346 653.915 Q(o)-.18 E F3(T_Port)6 E F2(macr)100.346 667.915 +Q(o)-.18 E F3(PORT\(port_obj\))6 E F2(function)100.346 681.915 Q F3 +(Object Make_Port\(int flags, FILE *f, Object name\);)6 E F2(function)100.346 +695.915 Q F3(Object Terminate_File\(Object port\);)6 E F2(macr)100.346 709.915 +Q(o)-.18 E F3(Check_Input_Port\(obj\))6 E F2(macr)100.346 723.915 Q(o)-.18 E F3 +(Check_Output_Port\(obj\))6 E EP +%%Page: 56 56 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 50 S 2.75(6-)288 50 S/F1 10 +/Times-Bold@0 SF -.1(va)100.346 86 S(riable).1 E/F2 10/Courier@0 SF +(Object Curr_Input_Port, Curr_Output_Port)6 E F1 -.1(va)100.346 100 S(riable).1 +E F2(Object Standard_Input_Port, Standard_Output_Port)6 E F1(function)100.346 +114 Q F2(void Reset_IO\(int destructive_flag\);)6 E F1(function)100.346 128 Q +F2(void Printf\(Object port, char *fmt, ...\);)6 E F1(function)100.346 142 Q F2 +(void Print_Object\(Object obj, Object port, int raw_flag,)6 E +(int print_depth, int print_length\);)190.346 156 Q F1(macr)100.346 170 Q(o) +-.18 E F2(Print\(obj\))6 E F1(function)100.346 184 Q F2 +(void Load_Source_Port\(Object port\);)6 E F1(function)100.346 198 Q F2 +(void Load_File\(char *filename\);)6 E/F3 11/Times-Bold@0 SF(Miscellaneous T)72 +228 Q(ypes)-.814 E F1(macr)100.346 254.103 Q(o)-.18 E F2(T_End_Of_File)6 E F1 +-.1(va)100.346 268.103 S(riable).1 E F2(Object Eof)6 E F1(macr)100.346 290.503 +Q(o)-.18 E F2(T_Environment)6 E F1 -.1(va)100.346 304.503 S(riable).1 E F2 +(Object The_Environment, Global_Environment)6 E F1(macr)100.346 326.903 Q(o) +-.18 E F2(T_Primitive)6 E F1(macr)100.346 340.903 Q(o)-.18 E F2(T_Compound)6 E +F1(function)100.346 354.903 Q F2(void Check_Procedure\(Object\);)6 E F1(macr) +100.346 377.303 Q(o)-.18 E F2(T_Control_Point)6 E F1(macr)100.346 391.303 Q(o) +-.18 E F2(T_Promise)6 E F1(macr)100.346 405.303 Q(o)-.18 E F2(T_Macro)6 E F3 +(De\214ning Scheme T)72 435.303 Q(ypes and Allocating Objects)-.814 E F1 +(function)100.346 461.406 Q F2(int Define_Type\(int zero, const char *name,)6 E +(int \(*size\)\(Object\), int const_size,)190.346 475.406 Q +(int \(*eqv\)\(Object, Object\),)190.346 489.406 Q +(int \(*equal\)\(Object, Object\),)190.346 503.406 Q +(int \(*print\)\(Object, Object, int, int, int\),)190.346 517.406 Q +(int \(*visit\)\(Object*, int \(*\)\(Object*\)\)\);)190.346 531.406 Q F1 +(function)100.346 545.406 Q F2 +(Object Alloc_Object\(int size, int type, int const_flag\);)6 E F3 +(Calling Scheme Pr)72 575.406 Q(ocedur)-.198 E(es and Ev)-.198 E +(aluating Scheme Code)-.11 E F1(function)100.346 601.509 Q F2 +(Object Funcall\(Object fun, Object argl, int eval_flag\);)6 E F1(function) +100.346 615.509 Q F2(Object Eval\(Object expr\);)6 E F1(function)100.346 +629.509 Q F2(char *String_Eval\(char *expr\);)6 E F3 -.715(We)72 659.509 S +(ak P).715 E(ointers and Object T)-.22 E(ermination)-1.012 E F1(function) +100.346 685.612 Q F2(void Register_Before_GC\(\(void \(*func\)\(void\)\)\);)6 E +F1(function)100.346 699.612 Q F2 +(void Register_After_GC\(\(void \(*func\)\(void\)\)\);)6 E F1(macr)100.346 +722.012 Q(o)-.18 E F2(IS_ALIVE\(obj\))6 E EP +%%Page: 57 57 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 50 S 2.75(7-)288 50 S/F1 10 +/Times-Bold@0 SF(macr)100.346 86 Q(o)-.18 E/F2 10/Courier@0 SF +(WAS_FORWARDED\(obj\))6 E F1(macr)100.346 100 Q(o)-.18 E F2(UPDATE_OBJ\(obj\))6 +E F1(function)100.346 122.4 Q F2 +(void Register_Object\(Object obj, char *group,)6 E +(\(Object \(*term\)\(Object\)\), int leader_flag\);)190.346 136.4 Q F1 +(function)100.346 150.4 Q F2(void Deregister_Object\(Object obj\);)6 E F1 +(function)100.346 164.4 Q F2(void Terminate_Type\(int type\);)6 E F1(function) +100.346 178.4 Q F2(void Terminate_Group\(char *group\);)6 E F1(function)100.346 +192.4 Q F2(Object Find_Object\(int type, char *group,)6 E +(\(int \(*match_func\)\(Object, ...\)\), ...\);)190.346 206.4 Q/F3 11 +/Times-Bold@0 SF(Signaling Err)72 236.4 Q(ors)-.198 E F1(function)100.346 +262.503 Q F2(void Primitive_Error\(char *fmt, ...\);)6 E F1(function)100.346 +276.503 Q F2(void Set_Error_Tag\(const char *tag\);)6 E F1(function)100.346 +290.503 Q F2(char *Get_Error_Tag\(void\);)6 E F1(function)100.346 304.503 Q F2 +(void Set_App_Name\(char *name\);)6 E F1(function)100.346 318.503 Q F2 +(void Range_Error\(Object offending_obj\);)6 E F1(function)100.346 332.503 Q F2 +(void Wrong_Type\(Object offending_obj, int expected_type\);)6 E F1(function) +100.346 346.503 Q F2(void Wrong_Type_Combination\(Object offending_obj,)6 E +(char *expected_type\);)169.846 360.503 Q F1(function)100.346 374.503 Q F2 +(void Fatal_Error\(char *fmt, ...\);)6 E F1(function)100.346 388.503 Q F2 +(void Panic\(char *msg\);)6 E F1 -.1(va)100.346 402.503 S(riable).1 E F2 +(int Saved_Errno)6 E F3(Exceptions \(Signals\))72 432.503 Q F1(macr)100.346 +458.606 Q(o)-.18 E F2(Disable_Interrupts, Enable_Interrupts)6 E F1(macr)100.346 +472.606 Q(o)-.18 E F2(Force_Disable_Interrupts, Force_Enable_Interrupts)6 E F1 +(function)100.346 486.606 Q F2(void Signal_Exit\(int signal_number\);)6 E F3 +(De\214ning and Using Scheme V)72 516.606 Q(ariables)-1.012 E F1(function) +100.346 542.709 Q F2 +(void Define_Variable\(Object *var, const char *name, Object init\);)6 E F1 +(function)100.346 556.709 Q F2(void Var_Set\(Object var, Object val\);)6 E F1 +(function)100.346 570.709 Q F2(Object Var_Get\(Object var\);)6 E F1(function) +100.346 584.709 Q F2(int Var_Is_True\(Object var\);)6 E F3 +(De\214ning Reader Functions)72 614.709 Q F1(function)100.346 640.812 Q F2 +(void Define_Reader\(int c,)6 E +(\(Object \(*func\)\(Object port, int c, int const_flag\)\)\);)190.346 654.812 +Q F3 -.275(Fo)72 684.812 S(rk Handlers).275 E F1(function)100.346 710.915 Q F2 +(void Register_Onfork\(\(void \(*func\)\(void\)\)\);)6 E F1(function)100.346 +724.915 Q F2(void Call_Onfork\(void\);)6 E EP +%%Page: 58 58 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 50 S 2.75(8-)288 50 S/F1 11 +/Times-Bold@0 SF(Allocating Memory)72 87 Q/F2 10/Times-Bold@0 SF(function) +100.346 113.103 Q/F3 10/Courier@0 SF(char *Safe_Malloc\(unsigned size\);)6 E F2 +(function)100.346 127.103 Q F3 +(char *Safe_Realloc\(char *old_pointer, unsigned size\);)6 E F2(macr)100.346 +149.503 Q(o)-.18 E F3(Alloca_Begin, Alloca_End)6 E F2(macr)100.346 163.503 Q(o) +-.18 E F3(Alloca\(char_ptr, type, size\))6 E F1(Initializing Elk fr)72 193.503 +Q(om an A)-.198 E(pplication')-.275 E 2.75(sm)-.407 G(ain\(\))259.671 193.503 Q +F2(function)100.346 219.606 Q F3 +(void Elk_Init\(int argc, char **argv, int init_flag,)6 E(char *filename\);) +169.846 233.606 Q F1(Miscellaneous Macr)72 263.606 Q(os)-.198 E F2(macr)100.346 +289.709 Q(o)-.18 E F3(ELK_MAJOR, ELK_MINOR)6 E F2(macr)100.346 303.709 Q(o)-.18 +E F3(NO_PROTOTYPES, WANT_PROTOTYPES)6 E EP +%%Page: 59 59 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5)276.087 51 S 2.75(9-)288 51 S/F1 13 +/Times-Bold@0 SF(Index)272.108 123 Q(<)72 174 Q F0(, 12)72 204 Q +(, 12)72 219 Q F1(A)72 249 Q F0(after)72 279 Q(-GC function, 42, 44) +-.22 E(Alloca\(\), 14)72 294 Q(alloca\(\), 14)72 309 Q(Alloca\(\), 29)72 324 Q +(Alloca_Be)72 339 Q(gin, 14, 29)-.165 E(Alloca_End, 14, 29)72 354 Q +(Alloc_Object\(\), 33)72 369 Q(ANSI/ISO C, 12)72 384 Q(append!, 23)72 399 Q +(application architecture, 2)72 414 Q(ar)72 429 Q(gv[0], 9)-.198 E +(Athena widgets, 8)72 444 Q F1(B)72 474 Q F0(bcmp\(\), 15)72 504 Q(bcop)72 519 +Q(y\(\), 15)-.11 E(before-GC function, 43)72 534 Q(bignums, 25)72 549 Q +(bitmask, 37)72 564 Q(bitstring e)72 579 Q(xtension, 4, 48)-.165 E(Bits_T)72 +594 Q(o_Symbols\(\), 37)-.88 E(bzero\(\), 15)72 609 Q F1(C)72 639 Q F0 2.75(Cc) +72 669 S(ompiler)86.971 669 Q 2.75(,1)-.44 G(2)131.752 669 Q 2.75(Cl)72 684 S +(ibrary)85.145 684 Q 2.75(,6)-.715 G(C++ compiler)72 699 Q 2.75(,7)-.44 G 2.75 +(,1)144.16 699 S(2)155.16 699 Q(C++ static constructor)72 714 Q 2.75(,7)-.44 G +2.75(,9)180.515 714 S 2.75(,1)191.515 714 S(0)202.515 714 Q +(C++ static destructor)72 729 Q 2.75(,7)-.44 G 2.75(,9)175.015 729 S +(calling discipline, 17, 22)302.4 174 Q(Call_Onfork\(\), 49)302.4 189 Q(car) +302.4 204 Q 2.75(,2)-.44 G(1, 27)326.391 204 Q(Car\(\), 27)302.4 219 Q(cdr) +302.4 234 Q 2.75(,2)-.44 G(1, 27)327.007 234 Q(Cdr\(\), 27)302.4 249 Q +(CHAR\(\), 16, 24)302.4 264 Q(Check_Input_Port\(\), 30)302.4 279 Q(Check_Inte) +302.4 294 Q(ger\(\), 25)-.165 E(Check_List\(\), 27)302.4 309 Q +(Check_Mutable\(\), 19)302.4 324 Q(Check_Number\(\), 27)302.4 339 Q +(Check_Output_Port\(\), 30)302.4 354 Q(Check_Procedure\(\), 32)302.4 369 Q +(Check_T)302.4 384 Q(ype\(\), 18, 46)-.88 E(CI_Intern\(\), 28)302.4 399 Q +(collect, 20)302.4 414 Q(cons, 21)302.4 429 Q(Cons\(\), 27, 39)302.4 444 Q +(const bit, 15)302.4 459 Q(continuation, 14)302.4 474 Q(Cop)302.4 489 Q +(y_List\(\), 27)-.11 E(Curr_Input_Port, 31)302.4 504 Q(Curr_Output_Port, 31) +302.4 519 Q F1(D)302.4 549 Q F0(De\214ne_Primiti)302.4 579 Q -.165(ve)-.275 G +(\(\), 17, 22).165 E(De\214ne_Reader\(\), 48)302.4 594 Q +(De\214ne_Symbol\(\), 28)302.4 609 Q(De\214ne_T)302.4 624 Q(ype\(\), 32)-.88 E +(De\214ne_V)302.4 639 Q(ariable\(\), 47)-1.221 E(Dere)302.4 654 Q +(gister_Object\(\), 44)-.165 E(Disable_Interrupts, 46)302.4 669 Q EP +%%Page: 60 60 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6)276.087 51 S 2.75(0-)288 51 S +(dynamic loading, 5, 35)72 87 Q/F1 13/Times-Bold@0 SF(E)72 117 Q F0(Elk_Ev)72 +147 Q(al\(\), 40)-.275 E(elk_\214nit_, 7)72 162 Q(Elk_Init\(\), 9, 11, 13)72 +177 Q(elk_init_, 7, 9)72 192 Q(ELK_MAJOR, 15)72 207 Q(ELK_MINOR, 15)72 222 Q +(Enable_Interrupts, 46)72 237 Q(end-of-\214le object, 25)72 252 Q(Eof, 25)72 +267 Q(EQ\(\), 16)72 282 Q(eq?, 16)72 297 Q(Equal\(\), 24)72 312 Q(Eqv\(\), 24) +72 327 Q(errno, 45)72 342 Q(error handler)72 357 Q 2.75(,1)-.44 G(1, 45)139.672 +357 Q(error tag, 45)72 372 Q(EV)72 387 Q(AL, 18)-1.485 E(Ev)72 402 Q +(al\(\), 40)-.275 E -.165(ex)72 417 S(ception, 46).165 E -.165(ex)72 432 S +(tensible application, 2).165 E -.165(ex)72 447 S +(tension \214nalization function, 7).165 E -.165(ex)72 462 S +(tension \214nalization functions, 47).165 E(Extension \214nalizer)72 477 Q +2.75(,9)-.44 G -.165(ex)72 492 S 3.015 +(tension initialization function, 7, 17, 19,).165 F(35, 41, 48)72 507 Q -.165 +(ex)72 522 S(tension initializer).165 E 2.75(,7)-.44 G 2.75(,9)169.471 522 S +2.75(,4)180.471 522 S(3)191.471 522 Q -.165(ex)72 537 S(tension language, 2) +.165 E F1(F)72 567 Q F0 -.165(Fa)72 597 S(lse, 19).165 E -.165(Fa)72 612 S +(st_Length\(\), 27).165 E -.165(Fa)72 627 S(tal_Error\(\), 46).165 E +(Find_Object\(\), 44)72 642 Q(FIXNUM\(\), 25)72 657 Q(\214xnums, 25)72 672 Q +(FIXNUM_FITS\(\), 25)72 687 Q(FLONUM\(\), 26)72 702 Q(\215onums, 26)72 717 Q +(\215uid-let, 6)72 732 Q -.165(Fo)302.4 87 S(rce_Disable_Interrupts, 46).165 E +-.165(Fo)302.4 102 S(rce_Enable_Interrupts, 46).165 E(fork handler)302.4 117 Q +2.75(,4)-.44 G(9)367.025 117 Q(format speci\214er)302.4 132 Q 2.75(,4)-.44 G(5) +382.304 132 Q(format string, 35, 45)302.4 147 Q(Funcall\(\), 39, 40, 47)302.4 +162 Q(function prototypes, 12)302.4 177 Q(Func_Global_GC_Link\(\), 41, 47)302.4 +192 Q F1(G)302.4 222 Q F0 -.055(ga)302.4 252 S +(rbage collection, 20, 35, 40, 42, 49).055 E -.055(ga)302.4 267 S +(rbage collector).055 E 2.75(,1)-.44 G(9, 33, 40, 42)388.959 267 Q +(GC_Link\(\), 20)302.4 282 Q(GC_Link2\(\), 21)302.4 297 Q(GC_Link3\(\), 21) +302.4 312 Q(GC_Node, 20)302.4 327 Q(GC_Node2, 21)302.4 342 Q(GC_Node3, 21)302.4 +357 Q(GC_Unlink, 20)302.4 372 Q(Get_Double\(\), 26)302.4 387 Q(Get_Error_T) +302.4 402 Q(ag\(\), 45)-.88 E(Get_Exact_Inte)302.4 417 Q(ger\(\), 25)-.165 E +(Get_Exact_Long\(\), 25)302.4 432 Q(Get_Exact_Unsigned\(\), 25)302.4 447 Q +(Get_Exact_Unsigned_Long\(\), 25)302.4 462 Q(Get_Inte)302.4 477 Q(ger\(\), 25) +-.165 E(Get_Long\(\), 25)302.4 492 Q(Get_String\(\), 29)302.4 507 Q +(Get_String_Stack\(\), 29)302.4 522 Q(Get_Strsym\(\), 29)302.4 537 Q +(Get_Strsym_Stack\(\), 29)302.4 552 Q(Get_Unsigned\(\), 25)302.4 567 Q +(Get_Unsigned_Long\(\), 25)302.4 582 Q(global v)302.4 597 Q(ariable, 40)-.275 E +(Global_En)302.4 612 Q(vironment, 32)-.44 E(Global_GC_Link\(\), 41)302.4 627 Q +F1(H)302.4 657 Q F0(heap, 15, 20)302.4 687 Q(hooks, 4)302.4 702 Q -.055(hy) +302.4 717 S(brid application, 2).055 E EP +%%Page: 61 61 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6)276.087 51 S 2.75(1-)288 51 S -.055(hy)72 87 S +(brid e).055 E(xtension, 5, 6)-.165 E/F1 13/Times-Bold@0 SF(I)72 117 Q F0 +(implementation language, 2)72 147 Q(include \214les, 12)72 162 Q +(incremental loading, 6)72 177 Q(inde)72 192 Q(x\(\), 15)-.165 E(ine)72 207 Q +(xact number)-.165 E 2.75(,2)-.44 G(6)150.518 207 Q(Intern\(\), 28, 47)72 222 Q +(ISCONST\(\), 15)72 237 Q(IS_ALIVE\(\), 43)72 252 Q F1(L)72 282 Q F0 +(ld\215ags, 9)72 312 Q(linkscheme, 8, 11)72 327 Q(load libraries, 6)72 342 Q +(load primiti)72 357 Q -.165(ve)-.275 G 2.75(,5).165 G(load-path, 11, 47)72 372 +Q(Load_File\(\), 11)72 387 Q(Load_Source_Port\(\), 31)72 402 Q(local v)72 417 Q +(ariable, 20, 21, 40)-.275 E F1(M)72 447 Q F0(main\(\), 4, 8)72 477 Q(mak)72 +492 Q(edl script, 5)-.11 E(Mak)72 507 Q(e_Char\(\), 24)-.11 E(Mak)72 522 Q +(e_Flonum\(\), 27)-.11 E(Mak)72 537 Q(e_Inte)-.11 E(ger\(\), 25)-.165 E(Mak)72 +552 Q(e_Long\(\), 25)-.11 E(Mak)72 567 Q(e_Port\(\), 30)-.11 E(Mak)72 582 Q +(e_Reduced_Flonum\(\), 27)-.11 E(Mak)72 597 Q(e_String\(\), 22, 29)-.11 E(Mak) +72 612 Q(e_Unsigned\(\), 25)-.11 E(Mak)72 627 Q(e_Unsigned_Long\(\), 25)-.11 E +(Mak)72 642 Q(e_V)-.11 E(ector\(\), 19, 30)-1.221 E(MANY)72 657 Q 2.75(,2) +-1.419 G(2)115.186 657 Q(module.o, 8, 11)302.4 87 Q F1(N)302.4 117 Q F0(Ne) +302.4 147 Q(wline, 24)-.275 E(NOEV)302.4 162 Q(AL, 18)-1.485 E +(non-printing symbol, 28)302.4 177 Q(NO_PR)302.4 192 Q -2.068 -.44(OT OT)-.44 H +(YPES, 13).44 E(Null, 24)302.4 207 Q(Nullp\(\), 24)302.4 222 Q(NUMSTRB)302.4 +237 Q(UFS, 29)-.11 E F1(O)302.4 267 Q F0(Object, 15)302.4 297 Q F1(P)302.4 327 +Q F0(pair)302.4 357 Q 2.75(,1)-.44 G(7)330.065 357 Q -1.012(PA)302.4 372 S +(IR\(\), 27)1.012 E -.165(Pa)302.4 387 S(nic\(\), 46).165 E +(pointer \214eld, 15, 20)302.4 402 Q(POINTER\(\), 15)302.4 417 Q(Primiti)302.4 +432 Q -.165(ve)-.275 G(_Error\(\), 35, 45).165 E(Print\(\), 31)302.4 447 Q +(Printf\(\), 31)302.4 462 Q(Print_Object\(\), 31)302.4 477 Q +(P_Cons\(\), 22, 27)302.4 492 Q F1(R)302.4 522 Q F0(Range_Error\(\), 46)302.4 +552 Q(rapid prototyping, 4)302.4 567 Q(reader function, 48)302.4 582 Q +(real numbers, 26)302.4 597 Q(record e)302.4 612 Q(xtension, 4)-.165 E(Re)302.4 +627 Q(gister_After_GC\(\), 42)-.165 E(Re)302.4 642 Q(gister_Before_GC\(\), 43) +-.165 E(Re)302.4 657 Q(gister_Object\(\), 31, 44)-.165 E(Re)302.4 672 Q +(gister_Onfork\(\), 49)-.165 E(Reset_IO\(\), 31, 39)302.4 687 Q +(root set, 20, 28)302.4 702 Q EP +%%Page: 62 62 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6)276.087 51 S 2.75(2-)288 51 S(R)72 87 Q/F1 9 +/Times-Roman@0 SF(4)79.337 81.5 Q F0(RS, 1)83.837 87 Q/F2 13/Times-Bold@0 SF(S) +72 117 Q F0(Safe_Malloc\(\), 15)72 147 Q(Safe_Realloc\(\), 15)72 162 Q(Sa)72 +177 Q -.165(ve)-.22 G(d_Errno, 45).165 E(Scheme e)72 192 Q(xtensions, 4, 13) +-.165 E(Scheme primiti)72 207 Q -.165(ve)-.275 G(s, 13, 17).165 E(scheme.h, 12) +72 222 Q(SET\(\), 15)72 237 Q(SETCONST\(\), 15)72 252 Q(Set_App_Name\(\), 11)72 +267 Q(Set_Error_T)72 282 Q(ag\(\), 11, 45)-.88 E(signals, 46)72 297 Q +(Signal_Exit\(\), 47)72 312 Q(special forms, 17, 18)72 327 Q(standalone.o, 8)72 +342 Q(Standard_Input_Port, 31)72 357 Q(Standard_Output_Port, 31)72 372 Q +(static linking, 5, 8)72 387 Q(string port, 40)72 402 Q(strong pointers, 42)72 +417 Q(SYMBOL, 28)72 432 Q(Symbols_T)72 447 Q(o_Bits\(\), 37)-.88 E +(SYMDESCR, 37, 39)72 462 Q F2(T)72 492 Q F0(tag \214eld, 15)72 522 Q +(Tcl, 12, 40)72 537 Q -.77(Te)72 552 S(rminate_File\(\), 31).77 E -.77(Te)72 +567 S(rminate_Group\(\), 44).77 E -.77(Te)72 582 S(rminate_T).77 E(ype\(\), 44) +-.88 E(termination function, 42, 44)72 597 Q(The_En)72 612 Q(vironment, 32)-.44 +E -.385(Tr)72 627 S(uep\(\), 24).385 E(type \214eld, 15)72 642 Q +(type predicate, 35)72 657 Q(TYPE\(\), 15)72 672 Q(T_Bignum, 25)72 687 Q +(T_Boolean, 24)72 702 Q(T_Character)72 717 Q 2.75(,2)-.44 G(4)137.538 717 Q +(T_Compound, 32)72 732 Q(T_Control, 32)302.4 87 Q(T_End_Of_File, 25)302.4 102 Q +(T_En)302.4 117 Q(vironment, 32)-.44 E(T_Fixnum, 25)302.4 132 Q(T_Flonum, 26) +302.4 147 Q(T_Macro, 32)302.4 162 Q(T_Null, 24)302.4 177 Q(T_P)302.4 192 Q(air) +-.165 E 2.75(,2)-.44 G(7)342.737 192 Q(T_Port, 30, 44)302.4 207 Q(T_Primiti) +302.4 222 Q -.165(ve)-.275 G 2.75(,3).165 G(2)366.134 222 Q(T_Promise, 32)302.4 +237 Q(T_String, 28)302.4 252 Q(T_Symbol, 27)302.4 267 Q(T_V)302.4 282 Q(ector) +-1.221 E 2.75(,3)-.44 G(0)353.891 282 Q F2(U)302.4 312 Q F0 +(UFIXNUM_FITS\(\), 25)302.4 342 Q(UNIX e)302.4 357 Q(xtension, 6, 49)-.165 E +(unresolv)302.4 372 Q(ed reference, 6)-.165 E(unrof)302.4 387 Q(f, 1)-.275 E +(UPD)302.4 402 Q -1.221(AT)-.44 G(E_OBJ\(\), 43)1.221 E F2(V)302.4 432 Q F0 +-1.485(VA)302.4 462 S(RARGS, 18, 22)1.485 E -1.221(Va)302.4 477 S +(r_Get\(\), 47)1.221 E -1.221(Va)302.4 492 S(r_Set\(\), 47)1.221 E -.165(ve) +302.4 507 S(ctor).165 E 2.75(,1)-.44 G(6, 18)340.284 507 Q(VECT)302.4 522 Q +(OR\(\), 16)-.198 E -.165(ve)302.4 537 S(ctor).165 E(-re)-.22 E -.165(ve)-.275 +G(rse!, 18).165 E -.165(ve)302.4 552 S(ctor).165 E(-re)-.22 E -.165(ve)-.275 G +(rse, 19).165 E(visit function, 33, 35)302.4 567 Q -1.419(Vo)302.4 582 S +(id, 28)1.419 E F2(W)302.4 612 Q F0 -1.32(WA)302.4 642 S(NT_PR)1.32 E -2.068 +-.44(OT OT)-.44 H(YPES, 13).44 E -1.32(WA)302.4 657 S(S_FOR)1.32 E -1.32(WA) +-.605 G(RDED\(\), 43)1.32 E(weak data structure, 42)302.4 672 Q(weak list, 44) +302.4 687 Q(weak pointers, 42, 44)302.4 702 Q(Wrong_T)302.4 717 Q(ype\(\), 46) +-.88 E EP +%%Page: 63 63 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6)276.087 51 S 2.75(3-)288 51 S(Wrong_T)72 87 Q +(ype_Combination\(\), 46)-.88 E/F1 13/Times-Bold@0 SF(X)72 117 Q F0 2.75(Xw)72 +147 S(indo)90.634 147 Q 2.75(ws)-.275 G(ystem, 6)124.888 147 Q(X11 e)72 162 Q +(xtension, 4, 6, 8, 12)-.165 E(Xlib e)72 177 Q(xtension, 6, 8, 44, 45)-.165 E +(Xt e)72 192 Q(xtension, 45, 47)-.165 E F1(_)72 222 Q F0 .916(__)72 252 S +(cplusplus, 12)-.916 E .916(__)72 267 S -1.834(STDC_ _,)-.916 F(12)2.75 E EP +%%Page: 64 64 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 13/Times-Bold@0 SF -1.196(Ta)239.127 123 S(ble of Contents)1.196 E/F1 11 +/Times-Roman@0 SF(1. Additional Documentation)72 177.6 Q 19.25(...............\ +..............................................................................\ +...... 1)3.616 F(2. Introduction)72 196.2 Q 19.25(............................\ +..............................................................................\ +................ 2)3.616 F(3. The Architecture of Extensible Applications)72 +214.8 Q 19.25 +(....................................................................... 2) +3.341 F(3.1. Scheme Extensions)83 233.4 Q 19.25(..............................\ +......................................................................... 4) +5.145 F(3.2. Applications v)83 252 Q(ersus Extensions)-.165 E 19.25(..........\ +.......................................................................... 4) +5.31 F(4. Linking Applications and Extensions with Elk)72 270.6 Q 19.25 +(................................................................... 5)5.442 F +(5. Dynamic Loading)72 289.2 Q 19.25(.........................................\ +........................................................................ 5) +3.011 F(5.1. Load Libraries)83 307.8 Q 19.25(.................................\ +..............................................................................\ + 6)3.935 F(5.2. Extension Initializers and Finalizers)83 326.4 Q 19.25(.......\ +...................................................................... 7)3.935 +F(5.3. C++ Static Constructors and Destructors)83 345 Q 19.25 +(...................................................................... 7)3.132 +F(6. Static Linking)72 363.6 Q 19.25(.........................................\ +..............................................................................\ + 8)3.605 F(6.1. Linking the Scheme Interpreter with Extensions)83 382.2 Q 19.25 +(.......................................................... 8)3.638 F +(6.1.1. Automatic Extension Initialization)94 400.8 Q 19.25 +(........................................................................ 9) +4.837 F(6.2. Linking the Scheme Interpreter with an Application)83 419.4 Q +19.25(.................................................... 9)3.341 F +(6.2.1. An Example `)94 438 Q(`main\(\)')-.814 E 2.75('F)-.814 G .987(unction \ +............................................................................) +230.763 438 R(10)493 438 Q(6.3. Who is in Control?)83 456.6 Q 13.75(..........\ +..............................................................................\ +............... 11)6.971 F(7. Notes for Writing C/C++ Code Using Elk)72 475.2 Q +13.75(........................................................................\ +... 12)3.121 F(7.1. Elk Include Files)83 493.8 Q 13.75(.......................\ +..............................................................................\ +...... 12)4.837 F(7.2. Standard C and Function Prototypes)83 512.4 Q 13.75(...\ +.......................................................................... 12)3 +F(7.3. External Symbols De\214ned by Elk)83 531 Q 13.75(......................\ +........................................................... 13)3.616 F +(7.4. Calling Scheme Primiti)83 549.6 Q -.165(ve)-.275 G 3.737(s.).165 G 13.75 +(.............................................................................\ +.............. 13)226.25 549.6 R(7.5. Portable alloca\(\))83 568.2 Q 13.75(...\ +..............................................................................\ +........................... 14)4.243 F(7.6. Other Useful Macros and Functions) +83 586.8 Q 13.75(.............................................................\ +................ 15)4.859 F(8. The Anatomy of Scheme Objects)72 605.4 Q 13.75(\ +..............................................................................\ +.......... 15)4.859 F(8.1. T)83 624 Q(ype-speci\214c Macros)-.88 E 13.75(.....\ +..............................................................................\ +................. 16)4.518 F(9. De\214ning Ne)72 642.6 Q 2.75(wS)-.275 G +(cheme Primiti)153.609 642.6 Q -.165(ve)-.275 G 4.639(s.).165 G 13.75(........\ +..............................................................................\ +. 17)237.25 642.6 R(9.1. Making Objects Kno)83 661.2 Q +(wn to the Garbage Collector)-.275 E 13.75 +(........................................................ 19)3.616 F +(9.2. Primiti)83 679.8 Q -.165(ve)-.275 G 2.75(sw).165 G(ith V)157.734 679.8 Q +(ariable-Length Ar)-1.221 E(gument Lists)-.198 E 13.75 +(......................................................... 22)4.87 F +(10. Prede\214ned Scheme T)72 698.4 Q 2.373(ypes .............................\ +.....................................................................)-.88 F +(23)493 698.4 Q(10.1. Booleans \(T_Boolean\))83 717 Q 13.75(..................\ +..............................................................................\ + 24)4.848 F EP +%%Page: 65 65 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF(10.2. Characters \(T_Character\))83 87 Q 13.75(.......\ +..............................................................................\ +....... 24)3.66 F(10.3. Empty List \(T_Null\))83 105.6 Q 13.75(...............\ +..............................................................................\ +...... 24)5.442 F(10.4. End of File \(T_End_Of_File\))83 124.2 Q 13.75(.......\ +..............................................................................\ +. 25)3.011 F(10.5. Inte)83 142.8 Q(gers \(T_Fixnum and T_Bignum\))-.165 E 13.75 +(.......................................................................... 25) +4.397 F(10.6. Floating Point Numbers \(T_Flonum\))83 161.4 Q 13.75 +(.......................................................................... 26) +2.989 F(10.7. P)83 180 Q(airs \(T_P)-.165 E 1.812(air\) ......................\ +..............................................................................\ +..........)-.165 F(27)493 180 Q(10.8. Symbols \(T_Symbol\))83 198.6 Q 13.75(..\ +..............................................................................\ +.................. 27)4.21 F(10.8.1. The Non-Printing Symbol)94 217.2 Q 13.75(\ +..............................................................................\ +...... 28)3.605 F(10.9. Strings \(T_String\))83 235.8 Q 13.75(................\ +..............................................................................\ +......... 28)5.134 F(10.10. V)83 254.4 Q(ectors \(T_V)-1.221 E 1.504(ector\) .\ +..............................................................................\ +.....................)-1.221 F(30)493 254.4 Q(10.11. Ports \(T_Port\))83 273 Q +13.75(........................................................................\ +.................................... 30)3 F(10.12. Miscellaneous T)83 291.6 Q +1.449(ypes ...................................................................\ +..............................)-.88 F(32)493 291.6 Q(11. De\214ning Ne)72 310.2 +Q 2.75(wS)-.275 G(cheme T)159.109 310.2 Q 1.427(ypes .........................\ +....................................................................)-.88 F(32) +493 310.2 Q(11.1. Example for a User)83 328.8 Q(-De\214ned Scheme T)-.22 E +1.097(ype .................................................................) +-.88 F(34)493 328.8 Q(12. Adv)72 347.4 Q(anced T)-.275 E 1.119(opics .........\ +..............................................................................\ +.........................)-.88 F(37)493 347.4 Q(12.1. Con)83 366 Q -.165(ve) +-.44 G(rting between Symbols, Inte).165 E(gers, and Bitmasks)-.165 E 13.75 +(............................................... 37)4.089 F +(12.2. Calling Scheme Procedures, Ev)83 384.6 Q(aluating Scheme Code)-.275 E +13.75(.............................................. 39)4.221 F +(12.3. GC-Protecting Global Objects)83 403.2 Q 13.75(.........................\ +........................................................... 40)4.54 F +(12.3.1. Dynamic C Data Structures)94 421.8 Q 13.75(..........................\ +....................................................... 41)5.464 F(12.4. W)83 +440.4 Q(eak Pointers and Object T)-.88 E .096(ermination .....................\ +..................................................)-.77 F(42)493 440.4 Q +(12.4.1. Using W)94 459 Q(eak Pointers)-.88 E 13.75(..........................\ +.................................................................. 42)3.891 F +(12.4.2. Functions for Automatic Object T)94 477.6 Q 1.647 +(ermination ......................................................)-.77 F(44) +493 477.6 Q(12.5. Errors)83 496.2 Q 13.75(....................................\ +..............................................................................\ +......... 45)3.011 F(12.6. Exceptions)83 514.8 Q 13.75(.......................\ +..............................................................................\ +.............. 46)3.616 F(12.7. De\214ning Scheme V)83 533.4 Q 1.493(ariables \ +..............................................................................\ +...........)-1.221 F(47)493 533.4 Q(12.8. De\214ning Readers)83 552 Q 13.75(..\ +..............................................................................\ +......................... 48)3.319 F(12.9. F)83 570.6 Q(ork Handlers)-.165 E +13.75(........................................................................\ +...................................... 49)3.176 F +(Appendix A: Functions that can T)72 589.2 Q(rigger a Garbage Collection)-.385 +E 13.75(............................................... 49)3.121 F +(Appendix B: Con)72 607.8 Q -.165(ve)-.44 G +(nience Functions for GC-Safe Data Structures).165 E 13.75 +(........................................ 50)4.562 F +(Appendix C: Summary of Functions, Macros, T)72 626.4 Q(ypes, and V)-.88 E +2.076(ariables ......................................)-1.221 F(53)493 626.4 Q +(Inde)72 645 Q 2.868(x.)-.165 G 13.75(........................................\ +..............................................................................\ +.................. 59)102.5 645 R EP +%%Trailer +end +%%EOF diff --git a/doc/kernel/Makefile b/doc/kernel/Makefile new file mode 100644 index 0000000..218474b --- /dev/null +++ b/doc/kernel/Makefile @@ -0,0 +1,24 @@ +MANUAL= kernel +TROFF= groff -ms -t +UNROFF= unroff -ms + +$(MANUAL).ps: $(MANUAL).ms index.ms + (cat $(MANUAL).ms ../util/tmac.index index.ms; echo ".Tc")\ + | $(TROFF) 2> /dev/null > $(MANUAL).ps + +$(MANUAL).html: $(MANUAL).ms + (cat $?; echo ".Tc") | $(UNROFF) document=$(MANUAL) + +index.ms: $(MANUAL).ms index.raw + sort -f -t# +1 -3 +0n index.raw | awk -f ../util/fixindex.awk\ + | awk -f ../util/block.awk >index.ms + +index.raw: $(MANUAL).ms + $(TROFF) $(MANUAL).ms 2> index.raw >/dev/null + +check: + checknr -c.Ul.Pr.Sy.Va.Sh.Ix.Id.Ch -a.Ss.Se.[[.]] $(MANUAL).ms |\ + grep -v "Empty command" + +clean: + rm -f index.raw index.ms $(MANUAL).ps $(MANUAL).html diff --git a/doc/kernel/kernel.ms b/doc/kernel/kernel.ms new file mode 100644 index 0000000..2087f9b --- /dev/null +++ b/doc/kernel/kernel.ms @@ -0,0 +1,1880 @@ +.so ../util/tmac.scheme +.Ul +.ds R "R\*(^4RS +.TL +Elk \*- The Extension Language Kit +.sp .5 +Scheme Reference +.AU +Oliver Laumann +. +.Ch "Introduction" +. +.PP +This reference manual lists the primitive procedures, special forms, +and other facilities implemented by the Scheme interpreter included +in Elk. +This \f2kernel\fP functionality can be augmented by applications +using Elk as their extension language implementation or by +reusable Elk extensions (such as the UNIX or X11 extensions included +in the distribution). +The predefined Elk extensions and the C/C++ programmer's interface +to Elk are described in separate documents. +.PP +Only the procedures and special forms that are not defined by the +official Scheme language specification ``\*R'' (William Clinger and +Jonathan Rees (editors), \f2Revised\*(^4 Report on the Algorithmic +Language Scheme\fP, 1991) are described in detail. +The language features that are part of the official language are only +mentioned without a description or examples. +. +.Ch "Lambda Expressions, Procedures" +. +.Sy lambda formals body +.LP +See \*R. +. +.Pr procedure-lambda procedure +.LP +Returns a copy of the \f2lambda\fP expression which has been +evaluated to create the given procedure. +.br +Example: +.Ss +(define (square x) (* x x)) +(procedure-lambda square) ==> (lambda (x) (* x x)) +.Se +. +.Pr procedure? obj +.LP +See \*R. +. +.Pr primitive? obj +.LP +Returns #t if \f2obj\fP is a primitive procedure, #f otherwise. +. +.Pr compound? obj +.LP +Returns #t if \f2obj\fP is a compound procedure (a procedure that +has been created by evaluating a lambda expression), #f otherwise. +. +.Ch "Local Bindings" +. +.[[ +.Sy let bindings body +.Sy let* bindings body +.Sy letrec bindings body +.]] +.LP +See \*R. +. +.Ch "Fluid Binding" +. +.Sy fluid-let bindings body +.LP +\f2bindings\fP is of the form ((\f2variable\*1\fP \f2init1\fP) ...). +The \f2init\fPs are temporarily assigned to the \f2variable\fPs +and the \f2body\fP is executed. +The variables must be bound in an enclosing scope. +When the body is exited normally or by invoking a control point, +the old values of the variables are restored. +In the latter case, when the control returns back to the body +of the fluid-let by invocation of a control point created within +the body, the bindings are changed again to the values they had +when the body exited. +.br +Examples: +.Ss +((lambda (x) + (+ x (fluid-let ((x 3)) x))) 1) ==> 4 +.Se +.Ss +(fluid-let ((print-length 2)) + (write '(a b c d))) ==> '(a b ...) +.Se +.Ss +(define (errset thunk) + (call-with-current-continuation + (lambda (catch) + (fluid-let + ((error-handler + (lambda msg (catch #f)))) + (list (thunk)))))) +.sp +(errset (lambda () (+ 1 2))) ==> (3) +(errset (lambda () (/ 1 0))) ==> #f +.Se +. +.Ch "Definitions" +. +.[[ +.Sy define variable expression +.Sy define (variable formals) body +.Sy define (variable . formal) body +.]] +.LP +See \*R. +.br +Returns a symbol, the identifier that has been bound. +Definitions may appear anywhere within a local body (e.\|g.\& a lambda +body or a \f2let\fP). +If the \f2expression\fP is omitted, \f2void\fP (the non-printing +object) is used. +.br +Examples: +.Ss +(define nil #f) +.Se +.Ss +(define ((f x) y) (cons x y)) +(define (g x) ((f x) 5)) +(g 'a) ==> (a . 5) +.Se +. +.Ch "Assignment" +. +.Sy set! variable expression +.LP +See \*R. +.br +Returns the previous value of \f2variable\fP. +.br +Examples: +.Ss +(define-macro (swap x y) + `(set! ,x (set! ,y ,x))) +.Se +. +.Ch "Procedure Application" +. +.Sy operator operand\*1 ... +.LP +See \*R. +\f2operator\fP can be a macro (see below). +. +.Pr apply arg\*1 ... args +.LP +See \*R. +. +.Ch "Quotation, Quasiquotation" +. +.[[ +.Sy quote datum +.br +.ie \n(.U \f3'\fP\f2datum\fP +.el .tl ,\f3'\fP\f2datum\fP,,\f3syntax\fP, +.br +.ie \n(.U \f2constant\fP +.el .tl ,\f2constant\fP,,\f3syntax\fP +.]] +.Id constant +.LP +See \*R. +. +.[[ +.Sy quasiquote expression +.Sy unquote expression +.Sy unquote-splicing expression +.]] +.LP +See \*R. +. +.Ch "Sequencing" +. +.Sy begin expression\*1 expression\*2 ... +.LP +See \*R. +. +.Sy begin1 expression\*1 expression\*2 ... +.LP +Identical to \f2begin\fP, except that the result of the first +\f2expression\fP is returned. +. +.Ch "Conditionals" +. +.[[ +.Sy if test consequent alternate +.Sy if test consequent +.]] +.LP +See \*R. +.br +In the first form, \f2alternate\fP can be a sequence of expressions +(implicit \f2begin\fP). +. +.Sy case key clause\*1 clause\*2 ... +.LP +See \*R. +.br +Each \f2clause\fP not beginning with \f2else\fP can be of the form +.DS +((\f2datum\*1\fP ...) \f2expression\*1\fP \f2expression\*2\fP ...) +.DE +or +.DS +(\f2datum\fP \f2expression\*1\fP \f2expression\*2\fP ...) +.DE +In the latter case, the \f2key\fP is matched against the \f2datum\fP. +. +.Sy cond clause\*1 clause\*2 ... +.LP +See \*R. +. +.[[ +.Sy and test\*1 ... +.Sy or test\*1 ... +.]] +.LP +See \*R. +. +.Ch "Booleans" +. +.Pr not obj +.LP +See \*R. +. +.Pr boolean? obj +.LP +See \*R. +. +.Ch "Iteration" +. +.Sy let variable bindings body +.LP +``Named \f2let\fP''. +See \*R. +. +.[[ +.Pr map procedure list\*1 list\*2 ... +.Pr for-each procedure list\*1 list\*2 ... +.]] +.LP +See \*R. +\f2for-each\fP returns the empty list. +. +.Sy do initializations test body +.LP +See \*R. +. +.Ch "Continuations" +. +.Pr call-with-current-continuation procedure +.LP +See \*R. +. +.Pr control-point? obj +.LP +Returns #t if \f2obj\fP is a control point (a continuation), +#f otherwise. +. +.Pr dynamic-wind thunk thunk thunk +.LP +\f2dynamic-wind\fP is a generalization of the +.Ix unwind-protect +\f2unwind-protect\fP facility provided by many Lisp systems. +.br +All three arguments are procedures of no arguments. +In the normal case, all three thunks are applied in order. +The first thunk is also applied when the body (the second thunk) +is entered by the application of a control point created within +the body (by means of +.Ix call-with-current-continuation +\f2call-with-current-continuation\fP). +Similarly, the third thunk is also applied whenever the body is +exited by invocation of a control point created outside the body. +.br +Examples: +.Ss +(define-macro (unwind-protect body . unwind-forms) + `(dynamic-wind + (lambda () #f) + (lambda () ,body) + (lambda () ,@unwind-forms))) +.Se +.Ss +(let ((f (open-input-file "foo"))) + (dynamic-wind + (lambda () #f) + (lambda () \f2do something with\fP f) + (lambda () (close-input-port f)))) +.Se +. +.Ch "Delayed Evaluation" +. +.[[ +.Sy delay expression +.Pr force promise +.]] +.LP +See \*R. +. +.Pr promise? obj +.LP +Returns #t if \f2obj\fP is a promise, an object returned by the +application of \f2delay\fP. +Otherwise #f is returned. +. +.Ch "Equivalence Predicates" +. +.[[ +.Pr eq? obj\*1 obj\*2 +.Pr eqv? obj\*1 obj\*2 +.Pr equal? obj\*1 obj\*2 +.]] +.LP +See \*R. +. +.Ch "Pairs and Lists" +. +.Pr cons obj\*1 obj\*2 +.LP +See \*R. +. +.[[ +.Pr car pair +.Pr cdr pair +.]] +.LP +See \*R. +. +.Pr cxr pair pattern +.LP +\f2pattern\fP is either a symbol or a string consisting of a combination +of the characters `a' and `d'. +It encodes a sequence of \f2car\fP and \f2cdr\fP operations; +each `a' denotes the application of \f2car\fP, and each `d' denotes +the application of \f2cdr\fP. +For example, \f2(cxr p "ada")\fP is equivalent to \f2(cadar p)\fP. +. +.Pr caar pair +.br + ... +.br +.Pr cddddr pair +.LP +See \*R. +. +.[[ +.Pr set-car! pair obj +.Pr set-cdr! pair obj +.]] +.LP +See \*R. +.br +Both procedures return \f2obj\fP. +. +.Pr make-list k obj +.LP +Returns a list of length \f2k\fP initialized with \f2obj\fP. +.br +Examples: +.Ss +(make-list 0 'a) ==> () +(make-list 2 (make-list 2 1)) ==> ((1 1) (1 1)) +.Se +. +.Pr list obj ... +.LP +See \*R. +. +.Pr length list +.LP +See \*R. +. +.Pr list-ref list k +.LP +See \*R. +. +.Pr list-tail list k +.LP +See \*R. +. +.Pr last-pair list +.LP +See \*R. +. +.Pr append list ... +.LP +See \*R. +. +.Pr append! list ... +.LP +Like \f2append\fP, except that the original +arguments are modified (destructive \f2append\fP). +The cdr of each argument is changed to point to the next argument. +.br +Examples: +.Ss +(define x '(a b)) +(append x '(c d)) ==> (a b c d) +x ==> (a b) +(append! x '(c d)) ==> (a b c d) +x ==> (a b c d) +.Se +. +.Pr reverse list +.LP +See \*R. +. +.Pr reverse! list +.LP +Destructive \f2reverse\fP. +. +.[[ +.Pr memq obj list +.Pr memv obj list +.Pr member obj list +.]] +.LP +See \*R. +. +.[[ +.Pr assq obj alist +.Pr assv obj alist +.Pr assoc obj alist +.]] +.LP +See \*R. +. +.[[ +.Pr null? obj +.Pr pair? obj +.]] +.LP +See \*R. +. +.Pr list? obj +.LP +See \*R. +. +.Ch "Numbers" +. +.[[ +.Pr = z\*1 z\*2 ... +.Pr < z\*1 z\*2 ... +.Pr > z\*1 z\*2 ... +.Pr <= z\*1 z\*2 ... +.Pr >= z\*1 z\*2 ... +.]] +.LP +See \*R. +. +.[[ +.Pr 1+ z +.Pr -1+ z +.]] +.LP +Returns \f2z\fP plus 1 or \f2z\fP minus 1, respectively. +. +.Pr 1- z +.LP +A synonym for \f2-1+\fP (for backwards compatibility). +. +.[[ +.Pr + z\*1 ... +.Pr * z\*1 ... +.]] +.LP +See \*R. +. +.[[ +.Pr - z\*1 z\*2 ... +.Pr / z\*1 z\*2 ... +.]] +.LP +See \*R. +. +.[[ +.Pr zero? z +.Pr positive? z +.Pr negative? z +.Pr odd? z +.Pr even? z +.Pr exact? z +.Pr inexact? z +.]] +.LP +See \*R. +. +.Pr abs z +.LP +See \*R. +. +.[[ +.Pr quotient n\*1 n\*2 +.Pr remainder n\*1 n\*2 +.Pr modulo n\*1 n\*2 +.]] +.LP +See \*R. +. +.[[ +.Pr gcd n\*1 ... +.Pr lcm n\*1 ... +.]] +.LP +See \*R. +. +.[[ +.Pr floor x +.Pr ceiling x +.Pr truncate x +.Pr round x +.]] +.LP +See \*R. +. +.Pr sqrt z +.LP +See \*R. +. +.Pr expt z\*1 z\*2 +.LP +See \*R. +. +.[[ +.Pr exp z +.Pr log z +.Pr sin z +.Pr cos z +.Pr tan z +.Pr asin z +.Pr acos z +.Pr atan z +.Pr atan y x +.]] +.LP +See \*R. +. +.[[ +.Pr min x\*1 x\*2 ... +.Pr max x\*1 x\*2 ... +.]] +.LP +See \*R. +. +.Pr random +.LP +Returns an integer pseudo-random number in the range from 0 to +.ie \n(.U 2^31-1. +.el 2\v'-.3m'\s-131\s0\v'.3m'-1. +. +.Pr srandom n +.LP +Sets the random number generator to the starting point \f2n\fP. +\f2srandom\fP returns \f2n\fP. +. +.[[ +.Pr number? obj +.Pr complex? obj +.Pr real? obj +.Pr rational? obj +.Pr integer? obj +.]] +.LP +See \*R. +. +.[[ +.Pr exact\(mi>inexact z +.Pr inexact\(mi>exact z +.]] +.LP +See \*R. +. +.[[ +.Pr number\(mi>string number +.Pr number\(mi>string number radix +.]] +.LP +See \*R. +. +.[[ +.Pr string\(mi>number string +.Pr string\(mi>number string radix +.]] +.LP +See \*R. +. +.Ch "Characters" +. +.[[ +.Pr char\(mi>integer char +.Pr integer\(mi>char n +.]] +.LP +See \*R. +. +.[[ +.Pr char-upper-case? char +.Pr char-lower-case? char +.]] +.LP +See \*R. +. +.[[ +.Pr char-alphabetic? char +.Pr char-numeric? char +.Pr char-whitespace? char +.]] +.LP +See \*R. +. +.[[ +.Pr char-upcase char +.Pr char-downcase char +.]] +.LP +See \*R. +. +.[[ +.Pr char=? char\*1 char\*2 +.Pr char? char\*1 char\*2 +.Pr char<=? char\*1 char\*2 +.Pr char>=? char\*1 char\*2 +.]] +.LP +See \*R. +. +.[[ +.Pr char-ci=? char\*1 char\*2 +.Pr char-ci? char\*1 char\*2 +.Pr char-ci<=? char\*1 char\*2 +.Pr char-ci>=? char\*1 char\*2 +.]] +.LP +See \*R. +. +.Pr char? obj +.LP +See \*R. +. +.Ch "Strings" +. +.Pr string char ... +.LP +Returns a string containing the specified characters. +.br +Examples: +.Ss +(string) ==> "" +(string #\ea #\espace #\eb) ==> "a b" +.Se +. +.Pr string? obj +.LP +See \*R. +. +.Pr make-string k char +.LP +See \*R. +. +.Pr string-length string +.LP +See \*R. +. +.Pr string-ref string k +.LP +See \*R. +. +.Pr string-set! string k char +.LP +See \*R. +.br +Returns the previous value of element \f2k\fP of the given string. +. +.Pr substring string start end +.LP +See \*R. +. +.Pr string-copy string +.LP +See \*R. +. +.Pr string-append string ... +.LP +See \*R. +. +.[[ +.Pr list\(mi>string chars +.Pr string\(mi>list string +.]] +.LP +See \*R. +. +.Pr string-fill! string char +.LP +See \*R. +.br +Returns \f2string\fP. +. +.Pr substring-fill! string start end char +.LP +Stores \f2char\fP in every element of \f2string\fP from \f2start\fP +(inclusive) to \f2end\fP (exclusive). +Returns \f2string\fP. +. +.[[ +.Pr string=? string\*1 string\*2 +.Pr string? string\*1 string\*2 +.Pr string<=? string\*1 string\*2 +.Pr string>=? string\*1 string\*2 +.]] +.LP +See \*R. +. +.[[ +.Pr string-ci=? string\*1 string\*2 +.Pr string-ci? string\*1 string\*2 +.Pr string-ci<=? string\*1 string\*2 +.Pr string-ci>=? string\*1 string\*2 +.]] +.LP +See \*R. +. +.[[ +.Pr substring? string\*1 string\*2 +.Pr substring-ci? string\*1 string\*2 +.]] +.LP +If \f2string\*1\fP is a substring of \f2string\*2\fP, these +procedures return the starting position of the first occurrence of the +substring within \f2string\*2\fP. +Otherwise #f is returned. +\f2substring-ci?\fP is the case insensitive version of \f2substring?\fP. +.br +Examples: +.Ss +(define s "Hello world") +(substring? "foo" x) ==> #f +(substring? "hello" x) ==> #f +(substring-ci? "hello" x) ==> 0 +(substring? "!" x) ==> 11 +.Se +. +.Ch "Vectors" +. +.Pr vector? obj +.LP +See \*R. +. +.[[ +.Pr make-vector k +.Pr make-vector k fill +.]] +.LP +See \*R. +. +.Pr vector obj ... +.LP +See \*R. +. +.Pr vector-length vector +.LP +See \*R. +. +.Pr vector-ref vector k +.LP +See \*R. +. +.Pr vector-set! vector k obj +.LP +See \*R. +.br +Returns the previous value of element \f2k\fP of the vector. +. +.[[ +.Pr vector\(mi>list vector +.Pr list\(mi>vector list +.]] +.LP +See \*R. +. +.Pr vector-fill! vector fill +.LP +See \*R. +.br +Returns \f2vector\fP. +. +.Pr vector-copy vector +.LP +Returns a copy of \f2vector\fP. +. +.Ch "Symbols" +. +.[[ +.Pr string\(mi>symbol string +.Pr symbol\(mi>string symbol +.]] +.LP +See \*R. +. +.[[ +.Pr put symbol key value +.Pr put symbol key +.]] +.LP +Associates \f2value\fP with \f2key\fP in the +.Ix "property list" +property list of the given symbol. +\f2key\fP must be a symbol. +Returns \f2key\fP. +.br +If \f2value\fP is omitted, the property is removed from the symbol's +property list. +. +.Pr get symbol key +.LP +Returns the value associated with \f2key\fP in the +.Ix "property list" +property list of \f2symbol\fP. +\f2key\fP must be a symbol. +If no value is associated with \f2key\fP in the symbol's property +list, #f is returned. +.br +Examples: +.Ss +(put 'norway 'capital "Oslo") +(put 'norway 'continent "Europe") +(get 'norway 'capital) ==> "Oslo" +.Se +. +.Pr symbol-plist symbol +.LP +Returns a copy of the +.Ix "property list" +property list of \f2symbol\fP as an \f2alist\fP. +.br +Examples: +.Ss +(put 'norway 'capital "Oslo") +(put 'norway 'continent "Europe") +(symbol-plist 'norway) + ==> ((capital . "Oslo") (continent . "Europe")) +(symbol-plist 'foo) ==> () +.Se +. +.Pr symbol? obj +.LP +See \*R. +. +.Pr oblist +.LP +Returns a list of lists containing all currently interned symbols. +Each sublist represents a bucket of the interpreters internal +hash array. +.br +Examples: +.Ss +(define (apropos what) + (let ((ret ())) + (do ((tail (oblist) (cdr tail))) ((null? tail)) + (do ((l (car tail) (cdr l))) ((null? l)) + (if (substring? what (symbol->string (car l))) + (set! ret (cons (car l) ret))))) + ret)) +.Se +.Ss +(apropos "let") ==> (let* let letrec fluid-let) +(apropos "make") ==> (make-list make-vector make-string) +(apropos "foo") ==> () +.Se +. +.Ch "Environments" +. +.Pr the-environment +.LP +Returns the current environment. +. +.Pr global-environment +.LP +Returns the global environment (the ``root'' environment in which +all predefined procedures are bound). +. +.Pr environment\(mi>list environment +.LP +Returns a list representing the specified environment. +The list is a list of \f2frames\fP, each frame is a list of bindings +(an \f2alist\fP). +The car of the list represents the most recently established environment. +The list returned by \f2environment\(mi>list\fP can contain cycles. +.br +Examples: +.Ss +(let ((x 1) (y 2)) + (car (environment->list + (the-environment)))) ==> ((y . 2) (x . 1)) +.Se +.Ss +((lambda (foo) + (caar (environment->list + (the-environment)))) "abc") ==> (foo . "abc") +.Se +.Ss +(eq? + (car (last-pair (environment->list + (the-environment)))) + (car (environment->list + (global-environment)))) ==> #t +.Se +. +.[[ +.Pr procedure-environment procedure +.Pr promise-environment promise +.Pr control-point-environment control-point +.]] +.LP +Returns the environment in which the the body of the \f2procedure\fP +is evaluated, the environment in which a value for the \f2promise\fP +is computed when \f2force\fP is applied to it, or the environment in +which the \f2control-point\fP has been created, respectively. +. +.Pr environment? obj +.LP +Returns #t if \f2obj\fP is an environment, #f otherwise. +. +.Ch "Ports and Files" +.LP +Generally, a +.Ix "file name" +file name can either be a string or a symbol. +If a symbol is given, it is converted into a string by applying +.Ix symbol\(mi>string +\f2symbol\(mi>string\fP. +A +.Ix tilde +tilde at the beginning of a file name is expanded according +to the rules employed by the C-Shell (see \f2csh\fP(1)). +.LP +Elk adds a third type of ports, \f2input-output\fP (bidirectional) ports. +Both \f2input-port?\fP and \f2output-port?\fP return #t when applied +to an input-output port, and both input primitives and output +primitives may be applied to input-output ports. +An input-output port (in fact, \f2any\fP port) may be closed with any of +the primitives \f2close-input-port\fP and \f2close-output-port\fP. +.LP +The only way to create an input-output-port is by means of the procedure +.Ix open-input-output-file +\f2open-input-output-file\fP. +Extensions may provide additional means to create bidirectional ports. +. +.[[ +.Pr call-with-input-file file procedure +.Pr call-with-output-file file procedure +.]] +.LP +See \*R. +. +.[[ +.Pr input-port? obj +.Pr output-port? obj +.]] +.LP +See \*R. +. +.[[ +.Pr current-input-port +.Pr current-output-port +.]] +.LP +See \*R. +. +.[[ +.Pr with-input-from-file file thunk +.Pr with-output-to-file file thunk +.]] +.LP +See \*R. +.br +\f2file\fP can be a string as well as a symbol. +. +.[[ +.Pr open-input-file file +.Pr open-output-file file +.Pr open-input-output-file file +.]] +.LP +See \*R. +.br +\f2file\fP can be a string as well as a symbol. +\f2open-input-output-file\fP opens the file for reading and writing +and returns an input-output port; the file must exist and is not +truncated. +. +.[[ +.Pr close-input-port port +.Pr close-output-port port +.]] +.LP +See \*R. +.br +Calls to \f2close-input-port\fP and \f2close-output-port\fP are ignored +when applied to string ports or to ports connected with the standard +input or standard output of the process. +. +.[[ +.Pr clear-output-port +.Pr clear-output-port output-port +.]] +.LP +If the argument is omitted, it defaults to the current output port. +.br +In case of ``buffered'' output, this procedure is used to discard +all characters that have been +output to the port but have not yet been sent to the file associated +with the port. +. +.[[ +.Pr flush-output-port +.Pr flush-output-port output-port +.]] +.LP +If the argument is omitted, it defaults to the current output port. +.br +In case of ``buffered'' output, this procedure is used to force +all characters that have been output to the port to be printed +immediately. +This may be necessary to force output that is not terminated with a newline +to appear on the terminal. +An output port is flushed automatically when it is closed. +. +.[[ +.Pr clear-input-port +.Pr clear-input-port input-port +.]] +.LP +If the argument is omitted, it defaults to the current input port. +.br +In case of ``buffered'' input, +this procedure discards all characters that have already been read +from the file associated with the port but have not been processed +using \f2read\fP or similar procedures. +. +.Pr port-file-name port +.LP +Returns the name of the file associated with \f2port\fP if it is +a file port, #f otherwise. +. +.Pr port-line-number +.LP +Returns the current line number of a file input port or string input +port, i.\|e.\& the number of newline characters that have been read from +this port plus one. +``Unreading'' a newline character decrements the line number, but it +never drops below one. +The result of applying \f2port-line-number\fP to an output port is +undefined. +. +.Pr tilde-expand file +.LP +If \f2file\fP starts with a tilde, performs tilde expansion as +described above and returns the result of the expansion +(a string); returns \f2file\fP otherwise. +\f2file\fP is a string or a symbol. +. +.Pr file-exists? file +.LP +Returns #t if \f2file\fP is accessible, #f otherwise. +\f2file\fP is a string or a symbol; tilde expansion is not performed. +. +.Ch "Input" +. +.[[ +.Pr read +.Pr read input-port +.]] +.LP +See \*R. +. +.[[ +.Pr read-char +.Pr read-char input-port +.]] +.LP +See \*R. +. +.[[ +.Pr read-string +.Pr read-string input-port +.]] +.LP +If the argument is omitted, it defaults to the current input port. +.br +Returns the rest of the current input line as a string (not +including the terminating newline). +. +.[[ +.Pr unread-char char +.Pr unread-char char input-port +.]] +.LP +If the second argument is omitted, it defaults to the current input port. +.br +Pushes \f2char\fP back on the stream of input characters. +It is \f2not\fP an error for \f2char\fP not to be the last character +read from the port. +It is undefined whether more than one character can be pushed back without +an intermittent read operation, and whether a character can be pushed +back before something has been read from the port. +The procedure returns \f2char\fP. +. +.[[ +.Pr peek-char +.Pr peek-char input-port +.]] +.LP +See \*R. +.LP +\f2peek-char\fP uses \f2unread-char\fP to push back the character. +. +.Pr eof-object? obj +.LP +See \*R. +. +.Pr char-ready? input-port +.LP +See \*R. +.LP +\f2char-ready\fP cannot be implemented correctly based on C FILE pointers. +In the current version, \f2char-ready\fP can return #f although +a call to \f2read-char\fP would not block. +. +.Ch "Output" +. +.[[ +.Va print-length +.Va print-depth +.]] +.LP +These variables are defined in the global environment. +They control the maximum length and maximum depth, respectively, of +a list or vector that is printed. +If one of the variables is not bound to an integer, or if its value +exceeds a certain, large maximum value (which is at least 2^20), +a default value is taken. +The default value for \f2print-length\fP is 1000, and the default +value for \f2print-depth\fP is 20. +Negative values of \f2print-length\fP and \f2print-depth\fP are +treated as ``unlimited'', i.\|e.\& output is not truncated. +. +.[[ +.Pr write obj +.Pr write obj output-port +.]] +.LP +See \*R. +. +.[[ +.Pr display obj +.Pr display obj output-port +.]] +.LP +See \*R. +. +.[[ +.Pr write-char char +.Pr write-char char output-port +.]] +.LP +See \*R. +. +.[[ +.Pr newline +.Pr newline output-port +.]] +.LP +See \*R. +. +.[[ +.Pr print obj +.Pr print obj output-port +.]] +.LP +If the second argument is omitted, it defaults to the current output port. +.br +Prints \f2obj\fP using \f2write\fP and then prints a newline. +\f2print\fP returns \f2void\fP. +. +.Pr format destination format-string obj ... +.LP +Prints the third and the following arguments according to the +specifications in the string \f2format-string\fP. +Characters from the format string are copied to the output. +When a tilde is encountered in the format string, the tilde and +the immediately following character are replaced in the output +as follows: +.IP "~s" +is replaced by the printed representation of the next \f2obj\fP +in the sense of \f2write\fP. +.IP "~a" +is replaced by the printed representation of the next \f2obj\fP +in the sense of \f2display\fP. +.IP "~~" +is replaced by a single tilde. +.IP "~%" +is replaced by a newline. +.LP +An error is signaled if fewer \f2obj\fPs are provided than +required by the given format string. +If the format string ends in a tilde, the tilde is ignored. +.LP +If \f2destination\fP is #t, the output is sent to the current +output port; if #f is given, the output is returned as a string; +otherwise, \f2destination\fP must be an output or input-output port. +.br +Examples: +.Ss +(format #f "Hello world!") ==> "Hello world" +(format #f "~s world!" "Hello") ==> "\e"Hello\e" world" +(format #f "~a world!" "Hello") ==> "Hello world" +(format #f "Hello~a") ==> "Hello!" +.Se +.Ss +(define (flat-size s) + (fluid-let ((print-length 1000) (print-depth 100)) + (string-length (format #f "~a" s)))) +.Se +.Ss +(flat-size 1.5) ==> 3 +(flat-size '(a b c)) ==> 7 +.Se +. +.Ch "String Ports" +.LP +.Ix "string ports" +String ports are similar to file ports, except that characters are +appended to a string instead of being sent to a file, or taken +from a string instead of being read from a file. +It is not necessary to close string ports. +When an string input port has reached the end of the input string, +successive read operations return end-of-file. +. +.Pr open-input-string string +.LP +Returns a new string input port initialized with \f2string\fP. +.br +Examples: +.Ss +(define p (open-input-string "Hello world!")) +(read-char p) ==> #\eH +(read p) ==> ello +(read p) ==> world! +(read p) ==> \f2end of file\fP +.Se +.Ss +(define p (open-input-string "(cons 'a 'b)")) +(eval (read p)) ==> (a . b) +.Se +. +.Pr open-output-string +.LP +Returns a new string output port. +. +.Pr get-output-string string-output-port +.LP +Returns the string currently associated with the specified string +output port. +As a side-effect, the string is reset to zero length. +.br +Examples: +.Ss +(define p (open-output-string)) +(display '(a b c) p) +(get-output-string p) ==> "(a b c)" +(get-output-string p) ==> "" +.Se +.Ss +(define (flat-size s) + (let ((p (open-output-string))) + (display s p) + (string-length (get-output-string p)))) +.Se +. +.Ch "Loading" +. +.[[ +.Pr load file +.Pr load file environment +.]] +.LP +Loads a source file or one or more object files. +If the file contains source code, the expressions in the file are +read and evaluated. +If a file contains +.Ix "object code" +object code, the contents of the file is linked +together with the running interpreter and with additional libraries +that are specified by the variable +.Ix load-libraries +\f2load-libraries\fP (see below). +Names of +.Ix "object files" +object files must have the +.Ix suffix +suffix ``.o''. +\f2load\fP returns \f2void\fP. +.LP +\f2file\fP must be either a string or a symbol or a list of strings +or symbols. +If it is a list, all elements of the list must be the names of object files. +In this case, all object files are linked by a single run of the +.Ix linker +linker. +.br +If an optional \f2environment\fP is specified, the contents of the file +is evaluated in this environment instead of the current environment. +.LP +Loading of object files is not supported on some platforms. +On the platforms where it is supported, the feature +.Ix feature +.Ix elk:load-object +\f2elk:load-object\fP is provided by the interpreter on startup (see +``Features'' below). +.br +Example: +.Ss +(fluid-let ((load-noisily? #t)) + (load 'test.scm)) +.Se +. +.Va load-path +.LP +This variable is defined in the global environment. +It is bound to a list of directories in which files to be loaded are +searched for. +Each element of the list (a string or a symbol) is used in turn as +a prefix for the file name passed to \f2load\fP until opening succeeds. +Elements of \f2load-path\fP that are not of type string or symbol are ignored. +.LP +If the value of \f2load-path\fP is not a list of at least one valid +component, or if the name of the file to be loaded starts with ``/'' +or with ``~'', it is opened directly. +.LP +The initial value of \f2load-path\fP is a list of the three elements +``.'' (i.\|e.\& the current directory), ``$scheme_dir'', and ``$lib_dir''; +$scheme_dir and $lib_dir are the directories into which +the runtime Scheme files and object files are installed (typically +``/usr/elk/runtime/scm'' and ``/usr/elk/runtime/obj''; defined in +the installation's +.Ix "site file" +site file). +. +.Va load-noisily? +.LP +This variable is defined in the global environment. +When a file is loaded and the value of \f2load-noisily?\fP is true, +the result of the evaluation of each expression is printed. +The initial value of \f2load-noisily?\fP is #f. +. +.Va load-libraries +.LP +This variable is defined in the global environment. +If \f2load-libraries\fP is bound to a string, its value specifies +additional load libraries to be linked together with an +.Ix "object file" +object file that is loaded into the interpreter (see \f2load\fP above). +Its initial value is ``\-lc''. +. +.Pr autoload symbol file +.LP +Binds \f2symbol\fP in the current environment (as with \f2define\fP). +When \f2symbol\fP is evaluated the first time, \f2file\fP is loaded. +The definitions loaded from the file must provide a definition +for \f2symbol\fP different from \f2autoload\fP, otherwise an error +is signaled. +.LP +\f2file\fP must be either a string or a symbol or a list of strings +or symbols, in which case all elements of the list must be the names of +.Ix "object file" +object files (see \f2load\fP above). +. +.Va autoload-notify? +.LP +This variable is defined in the global environment. +If the value of \f2autoload-notify?\fP is true, a message is printed +whenever evaluation of a symbol triggers autoloading of a file. +\f2autoload-notify?\fP is bound to #t initially. +. +.Ch "Macros" +. +.Sy macro formals body +.LP +This special form creates a macro. +The syntax is identical to the syntax of \f2lambda\fP expressions. +When a macro is called, the actual arguments are bound to +the formal arguments of the \f2macro\fP expression \f2in the current +environment\fP (they are \f2not\fP evaluated), then the \f2body\fP is evaluated. +The result of this evaluation is considered the \f2macro expansion\fP +and is evaluated in place of the macro call. +. +.[[ +.Sy define-macro (variable formals) body +.Sy define-macro (variable . formal) body +.]] +.LP +Like \f2define\fP, except that \f2macro\fP is used instead of \f2lambda\fP. +.br +Examples: +.Ss +(define-macro (++ x) `(set! ,x (1+ ,x))) +(define foo 5) +foo ==> 5 +(++ foo) +foo ==> 6 +.Se +.Ss +(define-macro (while test . body) + `(let loop () + (cond (,test ,@body (loop))))) +.Se +. +.Pr macro? obj +.LP +Returns #t if \f2obj\fP is a macro, #f otherwise. +. +.Pr macro-body macro +.LP +Returns a copy of the \f2macro\fP expression which has been evaluated to +created the given macro (similar to +.Ix procedure-lambda +\f2procedure-lambda\fP). +.br +Examples: +.Ss +(define-macro (++ x) `(set! ,x (1+ ,x))) +.sp +(macro-body ++) + ==> (macro (x) (quasiquote (set! (unquote x) (1+ (unquote x))))) +.Se +. +.Pr macro-expand list +.LP +If the expression \f2list\fP is a macro call, the macro call +is expanded. +.br +Examples: +.Ss +(define-macro (++ x) `(set! ,x (1+ ,x))) +.sp +(macro-expand '(++ foo)) ==> (set! foo (1+ foo)) +.Se +.sp +The following function can be used to expand \f2all\fP macro calls +in an expression, i.\|e.\& not only at the outermost level: +.Ss +(define (expand form) + (if (or (not (pair? form)) (null? form)) + form + (let ((head (expand (car form))) + (args (expand (cdr form))) + (result)) + (if (and (symbol? head) (bound? head)) + (begin + (set! result (macro-expand (cons head args))) + (if (not (equal? result form)) + (expand result) + result)) + (cons head args))))) +.Se +. +.Ch "Error and Exception Handling" +. +.Va error-handler +.LP +This variable is defined in the global environment. +When an error occurs or when the procedure \f2error\fP is invoked +and the variable \f2error-handler\fP is bound to a compound procedure +(the \f2error handler\fP), the interpreter invokes this procedure. +The error handler is called with an object (either the first argument +that has been passed to \f2error\fP or a symbol identifying the +primitive procedure that has caused the error), and an error +message consisting of a format string +and a list of objects suitable to be passed to +.Ix format +\f2format\fP. +.LP +Typically, a user-defined error handler prints the error message and then +calls a control point that has been created outside the error handler. +If the error handler terminates normally or if \f2error-handler\fP +is not bound to a procedure, the error message is printed in a +default way, and then a +.Ix reset +\f2reset\fP is performed. +. +.Va interrupt-handler +.LP +This variable is defined in the global environment. +When an interrupt occurs (typically as a result of typing the +interrupt character on the keyboard), and the variable +\f2interrupt-handler\fP is bound to a procedure (the \f2interrupt +handler\fP), this procedure is called with no arguments. +If \f2interrupt-handler\fP is not bound to a procedure or if +the procedure terminates normally, a message is printed, and a +.Ix reset +\f2reset\fP is performed. +.br +Examples: +.Ss +(set! interrupt-handler + (lambda () + (newline) + (backtrace) + (reset))) +.Se +. +.[[ +.Pr disable-interrupts +.Pr enable-interrupts +.]] +.LP +\f2disable-interrupts\fP causes +.Ix signals +signals to be blocked from delivery to +the interpreter; \f2enable-interrupts\fP enables delivery of signals. +These functions control delivery of keyboard-generated interrupt signals +(see \f2interrupt-handler\fP above) as well as additional signals used by +extensions (such as the alarm signal). +The interpreter automatically blocks delivery of signals during critical +operations, such as garbage collection. +Signals are enabled on startup after initialization has completed. +.LP +A call to \f2enable-interrupts\fP immediately delivers signals that have +been generated while signals were disabled, but blocked signals are not +queued. +On platforms that support neither POSIX-style nor BSD-style reliable +signals, \f2disable-interrupts\fP causes signals to be ignored (as +opposed to blocking them until the next call to \f2enable-interrupts\fP). +.LP +Calls to \f2disable-interrupts\fP and \f2enable-interrupts\fP can be +nested. +The functions maintain a count indicating the number of calls +to \f2enable-interrupts\fP that it takes to return from a nested +\f2disable-interrupts\fP invocation to the topmost level (i.\|e.\& to +actually enable delivery of signals again). +Both functions return this nesting level as an integer. +.LP +Example: the following loop ensures that delivery of signals is enabled, +regardless of the current nesting depth of \f2disable-interrupts\fP calls: +.Ss +(let loop ((intr-level (enable-interrupts))) + (if (positive? intr-level) + (loop (enable-interrupts)))) + +.Se +.LP +.Ix dynamic-wind +\f2dynamic-wind\fP can be used to write a macro +.Ix with-interrupts-disabled +\f2with-interrupts-disabled\fP to protect a +.Ix "critical section" +critical section of code from being interrupted by a signal: +.Ss +(define-macro (with-interrupts-disabled . body) + `(dynamic-wind + (lambda () (disable-interrupts)) + (lambda () ,@body) + (lambda () (enable-interrupts)))) +.Se +. +.Pr error obj string obj ... +.LP +Signals an error. +The arguments of \f2error\fP are passed to the +.Ix error-handler +\f2error-handler\fP. +.br +Examples: +.Ss +(define (foo sym) + (if (not (symbol? sym)) + (error 'foo "argument not a symbol: ~s" sym)) + ... +.Se +. +.[[ +.Va top-level-control-point +.Pr reset +.]] +.LP +\f2reset\fP performs a reset by calling the control point to which the +variable \f2top-level-control-point\fP is bound in the global environment. +The control point is called with the argument #t. +If \f2top-level-control-point\fP is not bound to a control point, +or does not exist at all, +an error message is printed and the interpreter is terminated. +.br +Examples: +.Ss +(if (call-with-current-continuation + (lambda (x) + (fluid-let ((top-level-control-point x)) +\0\0\0\0\0\0\0\0\0\0\f2do\0something\fP + #f))) + (print "Got a reset!")) +.Se +. +.[[ +.Pr exit +.Pr exit n +.]] +.LP +Terminates the interpreter. +The optional argument \f2n\fP indicates the +.Ix "exit code" +exit code; it defaults to zero. +. +.Ch "Garbage Collection" +.LP +The interpreter supports two +.Ix "garbage collector" +garbage collectors: the +.Ix "garbage collector, stop-and-copy" +stop-and-copy garbage collector that was part of older versions of Elk, and a +.Ix "garbage collector, generational" +.Ix "garbage collector, incremental" +generational, incremental garbage collector. +.LP +If generational garbage collection has been selected, Scheme objects +surviving two garbage collections will not be touched again until +there is only a certain amount of memory left on the heap, triggering +a full garbage collection. +Particularly in applications with large amounts of Scheme code or +constant data, partial garbage collections run much faster than full +garbage collections. +In contrast to the stop-and-copy garbage collector, the generational +garbage collector is not limited to a pre-allocated amount of +heap; it will expand the heap in steps of 1 MB if the free space left +after a full garbage collection falls below a certain amount. +.LP +Another feature of the generational garbage collector (available on +some platforms only) is the ability to do incremental garbage +collection. +Starting a garbage collection does not interrupt the application until +the garbage collector is done. +Instead, the collector returns control to the application almost +immediately. +To synchronize between the garbage collection and the running +application, the code makes use of the \f2mprotect\fP system call. +. +.Pr garbage-collect-status strategy mode +.LP +\f2garbage-collect-status\fP is used to select a garbage collector +and an optional, garbage collector specific mode of operation, and +to query the currently enabled garbage collector and mode. +.LP +\f2strategy\fP is a symbol identifying a garbage collector. +Permitted values are \f2stop-and-copy\fP and \f2generational\fP +(future version of Elk may support additional garbage collectors). +The optional \f2mode\fP argument may be specified if the \f2strategy\fP +argument is equal to \f2generational\fP. +Currently, only the symbol \f2incremental\fP may be used for the +\f2mode\fP argument to enable incremental garbage collection. +.LP +The current version of the interpreter does not support dynamic +switching between the stop-and-copy and the generational, incremental +garbage collector at runtime. +Instead, a garbage collector has to be selected at compile time +(by setting the \f2generational_gc\fP variable in the installation's +.Ix "site file" +site file to either \f2yes\fP or \f2no\fP). +Thus, \f2garbage-collect-status\fP can currently only be used to query +the garbage collector and, if the generational, incremental garbage +collector has been selected, to enable and disable incremental +garbage collection (this restriction may be removed in future versions). +.LP +\f2garbage-collect-status\fP returns a list of symbols indicating +the currently enabled garbage collector and mode. +This list resembles the arguments to \f2garbage-collect-status\fP, +i.\|e.\& the first element of the list one of the symbols +\f2stop-and-copy\fP and \f2generational\fP, and an optional, second +symbol (\f2incremental\fP) may be present if the first symbol is +equal to \f2generational\fP. +.LP +If \f2garbage-collect-status\fP is invoked with no arguments, or if +the desired garbage collector or mode of operation cannot be enabled +(either because selection of a strategy at runtime is not supported, +of because the mode of operation cannot be supported), the primitive +just returns the currently active strategy and mode. +. +.Pr collect +.LP +Causes a garbage collection. +Even if incremental garbage collection has been enabled, \f2collect\fP +always performs a full garbage collection run. +. +.Pr collect-incremental +.LP +This primitive is only present if the generational +garbage collector has been selected. +An error is signaled if \f2collect-incremental\fP is +invoked and incremental garbage collection has not been enabled, +i.\|e.\& if a call to \f2garbage-collect-status\fP would return +the list \f2(generational)\fP. +.LP +\f2collect-incremental\fP starts an incremental garbage +collection and then returns immediately. +If an incremental garbage collection is already in progress, +\f2collect-incremental\fP triggers one incremental +garbage collection step, i.\|e.\& scans a few more pages of memory, +and then returns immediately. +The primitive returns true if the incremental garbage collection +has been finished, false otherwise. +.LP +If incremental garbage collection is disabled by a call to +\f2(garbage-collect-status 'generational)\fP while an incremental +garbage collection run is in progress, the next call to +\f2collect-incremental\fP finishes the incremental garbage collection run +and returns #t; further calls to \f2collect-incremental\fP will +signal an error. +. +.Va garbage-collect-notify? +.LP +This variable is defined in the global environment. +If the value of \f2garbage-collect-notify?\fP is true, +a message indicating the amount of free memory on the heap and +the size of the heap are displayed whenever a stop-and-copy garbage +collection is performed. +If the generational, incremental garbage collector has been enabled, +the amount of reclaimed memory is displayed on each garbage +collection run, and a message is displayed each time the heap +is expanded by the garbage collector. +\f2garbage-collect-notify?\fP is bound to #t initially. +. +.Ch "Features" +. +.Pr feature? symbol +.LP +Returns #t if \f2symbol\fP is a feature, i.\|e.\& \f2provide\fP has +been called to indicate that the feature \f2symbol\fP is present; +#f otherwise. +. +.Pr provide symbol +.LP +Indicates that the feature \f2symbol\fP is present. +Returns \f2void\fP. +. +.[[ +.Pr require symbol +.Pr require symbol file +.Pr require symbol file environment +.]] +.LP +If the feature \f2symbol\fP is not present (i.\|e. +(feature? \f2symbol\fP) evaluates to #f), \f2file\fP is loaded. +A message is displayed prior to loading the file if the value of the +global variable \f2autoload-notify?\fP is true. +If the feature is still not present after the file has been loaded, +an error is signaled. +.LP +If the \f2file\fP argument is omitted, it defaults to \f2symbol\fP; +if \f2symbol\fP does not end in a +.Ix suffix +suffix (i.\|e.\& does not contain a dot character), the suffix \f2.scm\fP +is appended to obtain a file name. +.LP +If an \f2environment\fP argument is supplied, the file is loaded +into given environment. +If the \f2environment\fP argument is omitted, it defaults to the +current environment. +.LP +\f2file\fP must be either a string or a symbol or a list of strings +or symbols, in which case all elements of the list must be the names +of object files (see \f2load\fP above). +. +.Pr features +.LP +Returns the currently provided features a list of symbols. +. +.Ch "Miscellaneous" +. +.Pr dump file +.LP +Writes a snapshot of the running interpreter to \f2file\fP and +returns #f. +When \f2file\fP is executed, execution of the interpreter resumes such +that the call to \f2dump\fP returns #t +(i.e., \f2dump\fP actually returns twice). +\f2dump\fP closes all ports except the current input and current +output port. +.LP +This primitive is not supported on platforms that are not capable +of creating an executable file from the memory image of the +running process. +If \f2dump\fP is available, the +.Ix feature +.Ix elk:dump +feature \f2elk:dump\fP is provided by the interpreter on startup +(see ``Features'' above). +. +.[[ +.Pr eval list +.Pr eval list environment +.]] +.LP +Evaluates the expression \f2list\fP in the specified environment. +If \f2environment\fP is omitted, the expression is evaluated +in the current environment. +.br +Examples: +.Ss +(let ((car 1)) + (eval 'car (global-environment))) ==> \f2primitive\fP \f1car\fP +.Se +.Ss +(define x 1) +(define env + (let ((x 2)) (the-environment))) +(eval 'x) ==> 1 +(eval 'x env) ==> 2 +.Se +. +.Pr bound? symbol +.LP +Returns #t if \f2symbol\fP is bound in the current environment, +#f otherwise. +. +.Pr type obj +.LP +Returns a symbol indicating the type of \f2obj\fP. +.br +Examples: +.Ss +(type 13782343423544) ==> integer +(type 1.5e8) ==> real +(type (lambda (x y) (cons x y))) ==> compound +(type #\ea) ==> character +(type '(a b c)) ==> pair +(type '()) ==> null +(type (read + (open-input-string ""))) ==> end-of-file +.Se +. +.Pr void? obj +.LP +Returns true if \f2obj\fP is the non-printing object, false otherwise. +. +.Pr command-line-args +.LP +Returns the command line arguments of the interpreter's invocation, +a list of strings. +. +.Ch "\*R Language Features not Implemented by Elk" +.IP \(bu +Rational and complex numbers are not supported. +.IP \(bu +Radix prefixes (#b, #o, #d, and #x) for real numbers are currently +not implemented. +.IP \(bu +The exponent markers \f2s\fP, \f2f\fP, \f2d\fP, and \f2l\fP are not +implemented; the character \f2#\fP is not permitted in place of digits +in numerical constants. +.IP \(bu +\f2char-ready\fP +.Ix char-ready +is not implemented correctly (see above). +.IP \(bu +\f2transcript-on\fP and \f2transcript-off\fP are not implemented. +.LP diff --git a/doc/kernel/kernel.ps b/doc/kernel/kernel.ps new file mode 100644 index 0000000..5b82bd3 --- /dev/null +++ b/doc/kernel/kernel.ps @@ -0,0 +1,2720 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier +%%+ font Symbol +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 37 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier +%%IncludeResource: font Symbol +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier@0 ENC0/Courier RE/Times-Roman@0 +ENC0/Times-Roman RE/Times-Italic@0 ENC0/Times-Italic RE/Times-Bold@0 ENC0 +/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(Elk \212 The Extension Language Kit)196.482 120 Q +(Scheme Refer)241.296 138 Q(ence)-.216 E/F1 10/Times-Italic@0 SF +(Oliver Laumann)255.085 162 Q/F2 11/Times-Bold@0 SF 2.75(1. Intr)72 234 R +(oduction)-.198 E/F3 11/Times-Roman@0 SF 2.418 +(This reference manual lists the primiti)97 252.6 R 2.748 -.165(ve p)-.275 H +2.418(rocedures, special forms, and other f).165 F(acilities)-.11 E 1.396 +(implemented by the Scheme interpreter included in Elk.)72 267.6 R(This)6.896 E +/F4 11/Times-Italic@0 SF -.11(ke)4.146 G(rnel).11 E F3 1.396 +(functionality can be aug-)4.146 F .646 +(mented by applications using Elk as their e)72 282.6 R .646 +(xtension language implementation or by reusable Elk)-.165 F -.165(ex)72 297.6 +S .039(tensions \(such as the UNIX or X11 e).165 F .039 +(xtensions included in the distrib)-.165 F 2.789(ution\). The)-.22 F .04 +(prede\214ned Elk)2.789 F -.165(ex)72 312.6 S +(tensions and the C/C++ programmer').165 E 2.75(si)-.605 G(nterf)256.261 312.6 +Q(ace to Elk are described in separate documents.)-.11 E .462 +(Only the procedures and special forms that are not de\214ned by the of)97 +331.2 R .462(\214cial Scheme language)-.275 F 2.384(speci\214cation `)72 346.2 +R(`R)-.814 E/F5 9/Times-Roman@0 SF(4)146.588 340.7 Q F3(RS')151.088 346.2 Q +5.134('\()-.814 G -.44(Wi)179.85 346.2 S 2.384 +(lliam Clinger and Jonathan Rees \(editors\),).44 F F4(Re)5.135 E(vised)-.165 E +/F6 9/Times-Italic@0 SF(4)429.711 340.7 Q F4 2.385(Report on the)439.346 346.2 +R .41(Algorithmic Langua)72 361.2 R .63 -.11(ge S)-.11 H -.165(ch).11 G(eme) +.165 E F3 3.16(,1)C .409(991\) are described in detail.)219.497 361.2 R .409 +(The language features that are part)5.909 F(of the of)72 376.2 Q +(\214cial language are only mentioned without a description or e)-.275 E +(xamples.)-.165 E F2 2.75(2. Lambda)72 406.2 R(Expr)2.75 E(essions, Pr)-.198 E +(ocedur)-.198 E(es)-.198 E(\(lambda)72 436.2 Q F4(formals body)4.583 E F2 +296.33(\)s)C(yntax)477.721 436.2 Q F3(See R)72 454.8 Q F5(4)97.971 449.3 Q F3 +(RS.)102.471 454.8 Q F2(\(pr)72 484.8 Q(ocedur)-.198 E(e-lambda)-.198 E F4(pr) +4.583 E(ocedur)-.495 E(e)-.407 E F2 240.923(\)p)C -.198(ro)462.244 484.8 S +(cedur).198 E(e)-.198 E F3 .332(Returns a cop)72 503.4 R 3.082(yo)-.11 G 3.082 +(ft)147.125 503.4 S(he)156.928 503.4 Q F4(lambda)3.082 E F3 -.165(ex)3.082 G +.332(pression which has been e).165 F -.275(va)-.275 G .332 +(luated to create the gi).275 F -.165(ve)-.275 G 3.082(np).165 G(rocedure.) +462.772 503.4 Q(Example:)72 518.4 Q/F7 10/Courier@0 SF +(\(define \(square x\) \(* x x\)\))100.346 540.903 Q +(\(procedure-lambda square\))100.346 554.903 Q 6(==> \(lambda)298.346 554.903 R +(\(x\) \(* x x\)\))6 E F2(\(pr)72 591.903 Q(ocedur)-.198 E(e?)-.198 E F4(obj) +4.583 E F2 304.789(\)p)C -.198(ro)462.244 591.903 S(cedur).198 E(e)-.198 E F3 +(See R)72 610.503 Q F5(4)97.971 605.003 Q F3(RS.)102.471 610.503 Q F2 +(\(primiti)72 640.503 Q -.11(ve)-.11 G(?).11 E F4(obj)4.583 E F2 309.497(\)p)C +-.198(ro)462.244 640.503 S(cedur).198 E(e)-.198 E F3(Returns #t if)72 659.103 Q +F4(obj)2.75 E F3(is a primiti)2.75 E .33 -.165(ve p)-.275 H +(rocedure, #f otherwise.).165 E EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(compound?)72 87 Q/F2 11/Times-Italic@0 SF +(obj)4.583 E F1 303.15(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 E F0 +1.527(Returns #t if)72 105.6 R F2(obj)4.277 E F0 1.527 +(is a compound procedure \(a procedure that has been created by e)4.277 F -.275 +(va)-.275 G 1.526(luating a).275 F(lambda e)72 120.6 Q +(xpression\), #f otherwise.)-.165 E F1 2.75(3. Local)72 150.6 R(Bindings)2.75 E +(\(let)72 180.6 Q F2(bindings body)4.583 E F1 315.899(\)s)C(yntax)477.721 180.6 +Q(\(let*)72 195.6 Q F2(bindings body)4.583 E F1 310.399(\)s)C(yntax)477.721 +195.6 Q(\(letr)72 210.6 Q(ec)-.198 E F2(bindings body)4.583 E F1 301.445(\)s)C +(yntax)477.721 210.6 Q F0(See R)72 229.2 Q/F3 9/Times-Roman@0 SF(4)97.971 223.7 +Q F0(RS.)102.471 229.2 Q F1 2.75(4. Fluid)72 259.2 R(Binding)2.75 E +(\(\215uid-let)72 289.2 Q F2(bindings body)4.583 E F1 290.83(\)s)C(yntax) +477.721 289.2 Q F2(bindings)72 307.8 Q F0 .643(is of the form \(\()3.393 F F2 +(variable)A/F4 10/Times-Italic@0 SF(1)3.3 I F2(init1)3.393 -3.3 M F0 3.393(\).) +C 3.393(..\). The)260.548 307.8 R F2(init)3.393 E F0 3.393(sa)C .644 +(re temporarily assigned to the)326.332 307.8 R F2(variable)3.394 E F0(s)A .378 +(and the)72 322.8 R F2(body)3.128 E F0 .378(is e)3.128 F -.165(xe)-.165 G 3.128 +(cuted. The).165 F -.275(va)3.128 G .378 +(riables must be bound in an enclosing scope.).275 F .377(When the body is) +5.877 F -.165(ex)72 337.8 S .261(ited normally or by in).165 F -.22(vo)-.44 G +.261(king a control point, the old v).22 F .261(alues of the v)-.275 F .262 +(ariables are restored.)-.275 F .262(In the)5.762 F 1.046(latter case, when th\ +e control returns back to the body of the \215uid-let by in)72 352.8 R -.22(vo) +-.44 G 1.046(cation of a control).22 F 1.317(point created within the body)72 +367.8 R 4.068(,t)-.715 G 1.318(he bindings are changed ag)215.36 367.8 R 1.318 +(ain to the v)-.055 F 1.318(alues the)-.275 F 4.068(yh)-.165 G 1.318 +(ad when the)448.212 367.8 R(body e)72 382.8 Q(xited.)-.165 E(Examples:)72 +397.8 Q/F5 10/Courier@0 SF(\(\(lambda \(x\))100.346 420.303 Q +(\(+ x \(fluid-let \(\(x 3\)\) x\)\)\) 1\))112.346 434.303 Q 6(==> 4)328.346 +434.303 R(\(fluid-let \(\(print-length 2\)\))100.346 463.806 Q +(\(write '\(a b c d\)\)\))112.346 477.806 Q 6(==> '\(a)328.346 477.806 R 6(b.)6 +G(..\))400.346 477.806 Q(\(define \(errset thunk\))100.346 507.309 Q +(\(call-with-current-continuation)112.346 521.309 Q(\(lambda \(catch\))124.346 +535.309 Q(\(fluid-let)136.346 549.309 Q(\(\(error-handler)160.346 563.309 Q +(\(lambda msg \(catch #f\)\)\)\))172.346 577.309 Q(\(list \(thunk\)\)\)\)\)\)) +148.346 591.309 Q(\(errset \(lambda \(\) \(+ 1 2\)\)\))100.346 619.309 Q 6 +(==> \(3\))328.346 619.309 R(\(errset \(lambda \(\) \(/ 1 0\)\)\))100.346 +633.309 Q 6(==> #f)328.346 633.309 R EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(5. De\214nitions)72 87 R(\(de\214ne)72 +117 Q/F2 11/Times-Italic@0 SF(variable e)4.583 E(xpr)-.22 E(ession)-.407 E F1 +275.584(\)s)C(yntax)477.721 117 Q(\(de\214ne)72 132 Q F2 +(\(variable formals\) body)4.583 E F1 256.928(\)s)C(yntax)477.721 132 Q +(\(de\214ne)72 147 Q F2(\(variable . formal\) body)4.583 E F1 255.707(\)s)C +(yntax)477.721 147 Q F0(See R)72 165.6 Q/F3 9/Times-Roman@0 SF(4)97.971 160.1 Q +F0(RS.)102.471 165.6 Q .601 +(Returns a symbol, the identi\214er that has been bound.)72 180.6 R .601 +(De\214nitions may appear an)6.101 F .6(ywhere within a)-.165 F 1.738 +(local body \(e.)72 195.6 R 1.739(g. a lambda body or a)1.833 F F2(let)4.489 E +F0 4.489(\). If)B(the)4.489 E F2 -.22(ex)4.489 G(pr).22 E(ession)-.407 E F0 +1.739(is omitted,)4.489 F F2(void)4.489 E F0 1.739(\(the non-printing)4.489 F +(object\) is used.)72 210.6 Q(Examples:)72 225.6 Q/F4 10/Courier@0 SF +(\(define nil #f\))100.346 248.103 Q(\(define \(\(f x\) y\) \(cons x y\)\)) +100.346 277.606 Q(\(define \(g x\) \(\(f x\) 5\)\))100.346 291.606 Q(\(g 'a\)) +100.346 305.606 Q 6(==> \(a)298.346 305.606 R 6(.5)6 G(\))364.346 305.606 Q F1 +2.75(6. Assignment)72 342.606 R(\(set!)72 372.606 Q F2(variable e)4.583 E(xpr) +-.22 E(ession)-.407 E F1 287.211(\)s)C(yntax)477.721 372.606 Q F0(See R)72 +391.206 Q F3(4)97.971 385.706 Q F0(RS.)102.471 391.206 Q(Returns the pre)72 +406.206 Q(vious v)-.275 E(alue of)-.275 E F2(variable)2.75 E F0(.)A(Examples:) +72 421.206 Q F4(\(define-macro \(swap x y\))100.346 443.709 Q +(`\(set! ,x \(set! ,y ,x\)\)\))112.346 457.709 Q F1 2.75(7. Pr)72 494.709 R +(ocedur)-.198 E 2.75(eA)-.198 G(pplication)144.644 494.709 Q(\(operator)72 +524.709 Q F2(oper)4.583 E(and)-.165 E/F5 10/Times-Italic@0 SF(1)3.3 I F2(...) +2.75 -3.3 M F1 296.104(\)s)C(yntax)477.721 524.709 Q F0(See R)72 543.309 Q F3 +(4)97.971 537.809 Q F0(RS.)102.471 543.309 Q F2(oper)5.5 E(ator)-.165 E F0 +(can be a macro \(see belo)2.75 E(w\).)-.275 E F1(\(apply)72 573.309 Q F2(ar) +4.583 E(g)-.407 E F5(1)3.3 I F2(... ar)2.75 -3.3 M(gs)-.407 E F1 293.156(\)p)C +-.198(ro)462.244 573.309 S(cedur).198 E(e)-.198 E F0(See R)72 591.909 Q F3(4) +97.971 586.409 Q F0(RS.)102.471 591.909 Q F1 2.75(8. Quotation,)72 621.909 R +(Quasiquotation)2.75 E(\(quote)72 651.909 Q F2(datum)4.583 E F1 335.754(\)s)C +(yntax)477.721 651.909 Q(')72 666.909 Q F2(datum)A F1(syntax)473.442 666.909 Q +F2(constant)72 681.909 Q F1(syntax)473.442 681.909 Q F0(See R)72 700.509 Q F3 +(4)97.971 695.009 Q F0(RS.)102.471 700.509 Q EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(quasiquote)72 87 Q/F2 11/Times-Italic@0 SF +-.22(ex)4.583 G(pr).22 E(ession)-.407 E F1 291.765(\)s)C(yntax)477.721 87 Q +(\(unquote)72 102 Q F2 -.22(ex)4.583 G(pr).22 E(ession)-.407 E F1 304.602(\)s)C +(yntax)477.721 102 Q(\(unquote-splicing)72 117 Q F2 -.22(ex)4.583 G(pr).22 E +(ession)-.407 E F1 264.87(\)s)C(yntax)477.721 117 Q F0(See R)72 135.6 Q/F3 9 +/Times-Roman@0 SF(4)97.971 130.1 Q F0(RS.)102.471 135.6 Q F1 2.75 +(9. Sequencing)72 165.6 R(\(begin)72 195.6 Q F2 -.22(ex)4.583 G(pr).22 E +(ession)-.407 E/F4 10/Times-Italic@0 SF(1)3.3 I F2 -.22(ex)2.75 -3.3 O(pr).22 E +(ession)-.407 E F4(2)3.3 I F2(...)2.75 -3.3 M F1 247.269(\)s)C(yntax)477.721 +195.6 Q F0(See R)72 214.2 Q F3(4)97.971 208.7 Q F0(RS.)102.471 214.2 Q F1 +(\(begin1)72 244.2 Q F2 -.22(ex)4.583 G(pr).22 E(ession)-.407 E F4(1)3.3 I F2 +-.22(ex)2.75 -3.3 O(pr).22 E(ession)-.407 E F4(2)3.3 I F2(...)2.75 -3.3 M F1 +241.769(\)s)C(yntax)477.721 244.2 Q F0(Identical to)72 262.8 Q F2(be)2.75 E +(gin)-.44 E F0 2.75(,e)C(xcept that the result of the \214rst)158.768 262.8 Q +F2 -.22(ex)2.75 G(pr).22 E(ession)-.407 E F0(is returned.)2.75 E F1 2.75 +(10. Conditionals)72 292.8 R(\(if)72 322.8 Q F2(test consequent alternate)4.583 +E F1 272.823(\)s)C(yntax)477.721 322.8 Q(\(if)72 337.8 Q F2(test consequent) +4.583 E F1 315.294(\)s)C(yntax)477.721 337.8 Q F0(See R)72 356.4 Q F3(4)97.971 +350.9 Q F0(RS.)102.471 356.4 Q(In the \214rst form,)72 371.4 Q F2(alternate) +2.75 E F0(can be a sequence of e)2.75 E(xpressions \(implicit)-.165 E F2(be) +2.75 E(gin)-.44 E F0(\).)A F1(\(case)72 401.4 Q F2 -.11(ke)4.583 G 2.75(yc)-.22 +G(lause)121.639 401.4 Q F4(1)3.3 I F2(clause)2.75 -3.3 M F4(2)3.3 I F2(...)2.75 +-3.3 M F1 273.064(\)s)C(yntax)477.721 401.4 Q F0(See R)72 420 Q F3(4)97.971 +414.5 Q F0(RS.)102.471 420 Q(Each)72 435 Q F2(clause)2.75 E F0(not be)2.75 E +(ginning with)-.165 E F2(else)2.75 E F0(can be of the form)2.75 E(\(\()108 456 +Q F2(datum)A F4(1)3.3 I F0(...\))2.75 -3.3 M F2 -.22(ex)2.75 G(pr).22 E(ession) +-.407 E F4(1)3.3 I F2 -.22(ex)2.75 -3.3 O(pr).22 E(ession)-.407 E F4(2)3.3 I F0 +(...\))2.75 -3.3 M(or)72 477 Q(\()108 498 Q F2(datum e)A(xpr)-.22 E(ession) +-.407 E F4(1)3.3 I F2 -.22(ex)2.75 -3.3 O(pr).22 E(ession)-.407 E F4(2)3.3 I F0 +(...\))2.75 -3.3 M(In the latter case, the)72 519 Q F2 -.11(ke)2.75 G(y)-.22 E +F0(is matched ag)2.75 E(ainst the)-.055 E F2(datum)2.75 E F0(.)A F1(\(cond)72 +549 Q F2(clause)4.583 E F4(1)3.3 I F2(clause)2.75 -3.3 M F4(2)3.3 I F2(...)2.75 +-3.3 M F1 286.957(\)s)C(yntax)477.721 549 Q F0(See R)72 567.6 Q F3(4)97.971 +562.1 Q F0(RS.)102.471 567.6 Q F1(\(and)72 597.6 Q F2(test)4.583 E F4(1)3.3 I +F2(...)2.75 -3.3 M F1 340.522(\)s)C(yntax)477.721 597.6 Q(\(or)72 612.6 Q F2 +(test)4.583 E F4(1)3.3 I F2(...)2.75 -3.3 M F1 347.87(\)s)C(yntax)477.721 612.6 +Q F0(See R)72 631.2 Q F3(4)97.971 625.7 Q F0(RS.)102.471 631.2 Q F1 2.75 +(11. Booleans)72 661.2 R EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(not)72 87 Q/F2 11/Times-Italic@0 SF(obj) +4.583 E F1 342.882(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 E F0(See R) +72 105.6 Q/F3 9/Times-Roman@0 SF(4)97.971 100.1 Q F0(RS.)102.471 105.6 Q F1 +(\(boolean?)72 135.6 Q F2(obj)4.583 E F1 315.987(\)p)C -.198(ro)462.244 135.6 S +(cedur).198 E(e)-.198 E F0(See R)72 154.2 Q F3(4)97.971 148.7 Q F0(RS.)102.471 +154.2 Q F1 2.75(12. Iteration)72 184.2 R(\(let)72 214.2 Q F2 +(variable bindings body)4.583 E F1 276.486(\)s)C(yntax)477.721 214.2 Q F0 -.814 +(``)72 232.8 S(Named).814 E F2(let)2.75 E F0 -.814('')C 5.5(.S).814 G(ee R) +144.908 232.8 Q F3(4)164.763 227.3 Q F0(RS.)169.263 232.8 Q F1(\(map)72 262.8 Q +F2(pr)4.583 E(ocedur)-.495 E 2.75(el)-.407 G(ist)151.141 262.8 Q/F4 10 +/Times-Italic@0 SF(1)3.3 I F2(list)2.75 -3.3 M F4(2)3.3 I F2(...)2.75 -3.3 M F1 +253.726(\)p)C -.198(ro)462.244 262.8 S(cedur).198 E(e)-.198 E(\(f)72 277.8 Q +(or)-.275 E(-each)-.407 E F2(pr)4.583 E(ocedur)-.495 E 2.75(el)-.407 G(ist) +168.774 277.8 Q F4(1)3.3 I F2(list)2.75 -3.3 M F4(2)3.3 I F2(...)2.75 -3.3 M F1 +236.093(\)p)C -.198(ro)462.244 277.8 S(cedur).198 E(e)-.198 E F0(See R)72 296.4 +Q F3(4)97.971 290.9 Q F0(RS.)102.471 296.4 Q F2(for)5.5 E(-eac)-.22 E(h)-.165 E +F0(returns the empty list.)2.75 E F1(\(do)72 326.4 Q F2 +(initializations test body)4.583 E F1 275.232(\)s)C(yntax)477.721 326.4 Q F0 +(See R)72 345 Q F3(4)97.971 339.5 Q F0(RS.)102.471 345 Q F1 2.75 +(13. Continuations)72 375 R(\(call-with-curr)72 405 Q(ent-continuation)-.198 E +F2(pr)4.583 E(ocedur)-.495 E(e)-.407 E F1 185.12(\)p)C -.198(ro)462.244 405 S +(cedur).198 E(e)-.198 E F0(See R)72 423.6 Q F3(4)97.971 418.1 Q F0(RS.)102.471 +423.6 Q F1(\(contr)72 453.6 Q(ol-point?)-.198 E F2(obj)4.583 E F1 291.138(\)p)C +-.198(ro)462.244 453.6 S(cedur).198 E(e)-.198 E F0(Returns #t if)72 472.2 Q F2 +(obj)2.75 E F0(is a control point \(a continuation\), #f otherwise.)2.75 E F1 +(\(dynamic-wind)72 502.2 Q F2(thunk thunk thunk)4.583 E F1 226.161(\)p)C -.198 +(ro)462.244 502.2 S(cedur).198 E(e)-.198 E F2(dynamic-wind)72 520.8 Q F0 +(is a generalization of the)2.75 E F2(unwind-pr)2.75 E(otect)-.495 E F0 -.11 +(fa)2.75 G(cility pro).11 E(vided by man)-.165 E 2.75(yL)-.165 G(isp systems.) +440.434 520.8 Q 1.66(All three ar)72 535.8 R 1.66 +(guments are procedures of no ar)-.198 F 4.409(guments. In)-.198 F 1.659 +(the normal case, all three thunks are)4.409 F .772(applied in order)72 550.8 R +6.272(.T)-.605 G .772(he \214rst thunk is also applied when the body \(the sec\ +ond thunk\) is entered by)158.334 550.8 R 3.11 +(the application of a control point created within the body \(by means of)72 +565.8 R F2(call-with-curr)5.86 E(ent-)-.407 E(continuation)72 580.8 Q F0 2.779 +(\). Similarly)B 2.779(,t)-.715 G .029(he third thunk is also applied whene) +188.383 580.8 R -.165(ve)-.275 G 2.78(rt).165 G .03(he body is e)366.878 580.8 +R .03(xited by in)-.165 F -.22(vo)-.44 G(cation).22 E +(of a control point created outside the body)72 595.8 Q(.)-.715 E(Examples:)72 +610.8 Q/F5 10/Courier@0 SF +(\(define-macro \(unwind-protect body . unwind-forms\))100.346 633.303 Q +(`\(dynamic-wind)112.346 647.303 Q(\(lambda \(\) #f\))124.346 661.303 Q +(\(lambda \(\) ,body\))124.346 675.303 Q(\(lambda \(\) ,@unwind-forms\)\)\)) +124.346 689.303 Q EP +%%Page: 6 6 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(let \(\(f \(open-input-file "foo"\)\)\)) +100.346 94.503 Q(\(dynamic-wind)112.346 108.503 Q(\(lambda \(\) #f\))124.346 +122.503 Q(\(lambda \(\))124.346 136.503 Q/F2 10/Times-Italic@0 SF +(do something with)6 E F1(f\))6 E(\(lambda \(\) \(close-input-port f\)\)\)\)) +124.346 150.503 Q/F3 11/Times-Bold@0 SF 2.75(14. Delay)72 187.503 R(ed Ev)-.11 +E(aluation)-.11 E(\(delay)72 217.503 Q/F4 11/Times-Italic@0 SF -.22(ex)4.583 G +(pr).22 E(ession)-.407 E F3 318.055(\)s)C(yntax)477.721 217.503 Q(\(f)72 +232.503 Q(or)-.275 E(ce)-.198 E F4(pr)4.583 E(omise)-.495 E F3 313.93(\)p)C +-.198(ro)462.244 232.503 S(cedur).198 E(e)-.198 E F0(See R)72 251.103 Q/F5 9 +/Times-Roman@0 SF(4)97.971 245.603 Q F0(RS.)102.471 251.103 Q F3(\(pr)72 +281.103 Q(omise?)-.198 E F4(obj)4.583 E F3 314.975(\)p)C -.198(ro)462.244 +281.103 S(cedur).198 E(e)-.198 E F0 1.402(Returns #t if)72 299.703 R F4(obj) +4.152 E F0 1.402(is a promise, an object returned by the application of)4.152 F +F4(delay)4.152 E F0 6.902(.O)C 1.402(therwise #f is)441.928 299.703 R +(returned.)72 314.703 Q F3 2.75(15. Equi)72 344.703 R -.11(va)-.11 G(lence Pr) +.11 E(edicates)-.198 E(\(eq?)72 374.703 Q F4(obj)4.583 E F2(1)3.3 I F4(obj)2.75 +-3.3 M F2(2)3.3 I F3 314.853(\)p)-3.3 K -.198(ro)462.244 374.703 S(cedur).198 E +(e)-.198 E(\(eqv?)72 389.703 Q F4(obj)4.583 E F2(1)3.3 I F4(obj)2.75 -3.3 M F2 +(2)3.3 I F3 309.353(\)p)-3.3 K -.198(ro)462.244 389.703 S(cedur).198 E(e)-.198 +E(\(equal?)72 404.703 Q F4(obj)4.583 E F2(1)3.3 I F4(obj)2.75 -3.3 M F2(2)3.3 I +F3 300.179(\)p)-3.3 K -.198(ro)462.244 404.703 S(cedur).198 E(e)-.198 E F0 +(See R)72 423.303 Q F5(4)97.971 417.803 Q F0(RS.)102.471 423.303 Q F3 2.75 +(16. P)72 453.303 R(airs and Lists)-.11 E(\(cons)72 483.303 Q F4(obj)4.583 E F2 +(1)3.3 I F4(obj)2.75 -3.3 M F2(2)3.3 I F3 310.574(\)p)-3.3 K -.198(ro)462.244 +483.303 S(cedur).198 E(e)-.198 E F0(See R)72 501.903 Q F5(4)97.971 496.403 Q F0 +(RS.)102.471 501.903 Q F3(\(car)72 531.903 Q F4(pair)4.583 E F3 338.614(\)p)C +-.198(ro)462.244 531.903 S(cedur).198 E(e)-.198 E(\(cdr)72 546.903 Q F4(pair) +4.583 E F3 337.998(\)p)C -.198(ro)462.244 546.903 S(cedur).198 E(e)-.198 E F0 +(See R)72 565.503 Q F5(4)97.971 560.003 Q F0(RS.)102.471 565.503 Q F3(\(cxr)72 +595.503 Q F4(pair pattern)4.583 E F3 304.085(\)p)C -.198(ro)462.244 595.503 S +(cedur).198 E(e)-.198 E F4(pattern)72 614.103 Q F0 .442(is either a symbol or \ +a string consisting of a combination of the characters `a' and `d'.)3.192 F(It) +5.943 E .826(encodes a sequence of)72 629.103 R F4(car)3.576 E F0(and)3.576 E +F4(cdr)3.576 E F0 .825(operations; each `a' denotes the application of)3.576 F +F4(car)3.575 E F0 3.575(,a)C .825(nd each)469.273 629.103 R +(`d' denotes the application of)72 644.103 Q F4(cdr)2.75 E F0 5.5(.F)C(or e) +232.534 644.103 Q(xample,)-.165 E F4(\(cxr p "ada"\))2.75 E F0(is equi)2.75 E +-.275(va)-.275 G(lent to).275 E F4(\(cadar p\))2.75 E F0(.)A F3(\(caar)72 +674.103 Q F4(pair)4.583 E F3 333.114(\)p)C -.198(ro)462.244 674.103 S(cedur) +.198 E(e)-.198 E(...)80.25 689.103 Q EP +%%Page: 7 7 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-7-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(cddddr)72 87 Q/F2 11/Times-Italic@0 SF +(pair)4.583 E F1 319.65(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 E F0 +(See R)72 105.6 Q/F3 9/Times-Roman@0 SF(4)97.971 100.1 Q F0(RS.)102.471 105.6 Q +F1(\(set-car!)72 135.6 Q F2(pair obj)4.583 E F1 301.654(\)p)C -.198(ro)462.244 +135.6 S(cedur).198 E(e)-.198 E(\(set-cdr!)72 150.6 Q F2(pair obj)4.583 E F1 +301.038(\)p)C -.198(ro)462.244 150.6 S(cedur).198 E(e)-.198 E F0(See R)72 169.2 +Q F3(4)97.971 163.7 Q F0(RS.)102.471 169.2 Q(Both procedures return)72 184.2 Q +F2(obj)2.75 E F0(.)A F1(\(mak)72 214.2 Q(e-list)-.11 E F2 2.75(ko)4.583 G(bj) +136.654 214.2 Q F1 307.253(\)p)C -.198(ro)462.244 214.2 S(cedur).198 E(e)-.198 +E F0(Returns a list of length)72 232.8 Q F2(k)2.75 E F0(initialized with)2.75 E +F2(obj)2.75 E F0(.)A(Examples:)72 247.8 Q/F4 10/Courier@0 SF +(\(make-list 0 'a\))100.346 270.303 Q 6(==> \(\))298.346 270.303 R +(\(make-list 2 \(make-list 2 1\)\))100.346 284.303 Q 6(==> \(\(1)298.346 +284.303 R(1\) \(1 1\)\))6 E F1(\(list)72 321.303 Q F2(obj ...)4.583 E F1 +333.103(\)p)C -.198(ro)462.244 321.303 S(cedur).198 E(e)-.198 E F0(See R)72 +339.903 Q F3(4)97.971 334.403 Q F0(RS.)102.471 339.903 Q F1(\(length)72 369.903 +Q F2(list)4.583 E F1 329.429(\)p)C -.198(ro)462.244 369.903 S(cedur).198 E(e) +-.198 E F0(See R)72 388.503 Q F3(4)97.971 383.003 Q F0(RS.)102.471 388.503 Q F1 +(\(list-r)72 418.503 Q(ef)-.198 E F2(list k)4.583 E F1 320.178(\)p)C -.198(ro) +462.244 418.503 S(cedur).198 E(e)-.198 E F0(See R)72 437.103 Q F3(4)97.971 +431.603 Q F0(RS.)102.471 437.103 Q F1(\(list-tail)72 467.103 Q F2(list k)4.583 +E F1 318.132(\)p)C -.198(ro)462.244 467.103 S(cedur).198 E(e)-.198 E F0(See R) +72 485.703 Q F3(4)97.971 480.203 Q F0(RS.)102.471 485.703 Q F1(\(last-pair)72 +515.703 Q F2(list)4.583 E F1 319.045(\)p)C -.198(ro)462.244 515.703 S(cedur) +.198 E(e)-.198 E F0(See R)72 534.303 Q F3(4)97.971 528.803 Q F0(RS.)102.471 +534.303 Q F1(\(append)72 564.303 Q F2(list ...)4.583 E F1 312.918(\)p)C -.198 +(ro)462.244 564.303 S(cedur).198 E(e)-.198 E F0(See R)72 582.903 Q F3(4)97.971 +577.403 Q F0(RS.)102.471 582.903 Q F1(\(append!)72 612.903 Q F2(list ...)4.583 +E F1 309.255(\)p)C -.198(ro)462.244 612.903 S(cedur).198 E(e)-.198 E F0(Lik)72 +631.503 Q(e)-.11 E F2(append)4.044 E F0 4.044(,e)C 1.294 +(xcept that the original ar)139.994 631.503 R 1.294 +(guments are modi\214ed \(destructi)-.198 F -.165(ve)-.275 G F2(append)4.21 E +F0 4.045(\). The)B 1.295(cdr of)4.045 F(each ar)72 646.503 Q +(gument is changed to point to the ne)-.198 E(xt ar)-.165 E(gument.)-.198 E +(Examples:)72 661.503 Q EP +%%Page: 8 8 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-8-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(define x '\(a b\)\))100.346 94.503 Q +(\(append x '\(c d\)\))100.346 108.503 Q 6(==> \(a)298.346 108.503 R 6(bcd)6 G +(\))376.346 108.503 Q 192(x=)100.346 122.503 S 6(=> \(a)304.346 122.503 R(b\))6 +E(\(append! x '\(c d\)\))100.346 136.503 Q 6(==> \(a)298.346 136.503 R 6(bcd)6 +G(\))376.346 136.503 Q 192(x=)100.346 150.503 S 6(=> \(a)304.346 150.503 R 6 +(bcd)6 G(\))376.346 150.503 Q/F2 11/Times-Bold@0 SF(\(r)72 187.503 Q -2.53 +-.165(ev e)-.198 H(rse).165 E/F3 11/Times-Italic@0 SF(list)4.583 E F2 325.04 +(\)p)C -.198(ro)462.244 187.503 S(cedur).198 E(e)-.198 E F0(See R)72 206.103 Q +/F4 9/Times-Roman@0 SF(4)97.971 200.603 Q F0(RS.)102.471 206.103 Q F2(\(r)72 +236.103 Q -2.53 -.165(ev e)-.198 H(rse!).165 E F3(list)4.583 E F2 321.377(\)p)C +-.198(ro)462.244 236.103 S(cedur).198 E(e)-.198 E F0(Destructi)72 254.703 Q +-.165(ve)-.275 G F3 -2.101 -.407(re v)2.915 H(er).407 E(se)-.11 E F0(.)A F2 +(\(memq)72 284.703 Q F3(obj list)4.583 E F2 312.632(\)p)C -.198(ro)462.244 +284.703 S(cedur).198 E(e)-.198 E(\(memv)72 299.703 Q F3(obj list)4.583 E F2 +313.248(\)p)C -.198(ro)462.244 299.703 S(cedur).198 E(e)-.198 E(\(member)72 +314.703 Q F3(obj list)4.583 E F2 302.864(\)p)C -.198(ro)462.244 314.703 S +(cedur).198 E(e)-.198 E F0(See R)72 333.303 Q F4(4)97.971 327.803 Q F0(RS.) +102.471 333.303 Q F2(\(assq)72 363.303 Q F3(obj alist)4.583 E F2 316.284(\)p)C +-.198(ro)462.244 363.303 S(cedur).198 E(e)-.198 E(\(assv)72 378.303 Q F3 +(obj alist)4.583 E F2 316.9(\)p)C -.198(ro)462.244 378.303 S(cedur).198 E(e) +-.198 E(\(assoc)72 393.303 Q F3(obj alist)4.583 E F2 312.016(\)p)C -.198(ro) +462.244 393.303 S(cedur).198 E(e)-.198 E F0(See R)72 411.903 Q F4(4)97.971 +406.403 Q F0(RS.)102.471 411.903 Q F2(\(null?)72 441.903 Q F3(obj)4.583 E F2 +334.313(\)p)C -.198(ro)462.244 441.903 S(cedur).198 E(e)-.198 E(\(pair?)72 +456.903 Q F3(obj)4.583 E F2 333.103(\)p)C -.198(ro)462.244 456.903 S(cedur).198 +E(e)-.198 E F0(See R)72 475.503 Q F4(4)97.971 470.003 Q F0(RS.)102.471 475.503 +Q F2(\(list?)72 505.503 Q F3(obj)4.583 E F2 338.603(\)p)C -.198(ro)462.244 +505.503 S(cedur).198 E(e)-.198 E F0(See R)72 524.103 Q F4(4)97.971 518.603 Q F0 +(RS.)102.471 524.103 Q F2 2.75(17. Numbers)72 554.103 R(\(=)72 584.103 Q F3(z) +4.583 E/F5 10/Times-Italic@0 SF(1)3.3 I F3(z)2.75 -3.3 M F5(2)3.3 I F3(...)2.75 +-3.3 M F2 333.641(\)p)C -.198(ro)462.244 584.103 S(cedur).198 E(e)-.198 E(\(<) +72 599.103 Q F3(z)4.583 E F5(1)3.3 I F3(z)2.75 -3.3 M F5(2)3.3 I F3(...)2.75 +-3.3 M F2 333.641(\)p)C -.198(ro)462.244 599.103 S(cedur).198 E(e)-.198 E(\(>) +72 614.103 Q F3(z)4.583 E F5(1)3.3 I F3(z)2.75 -3.3 M F5(2)3.3 I F3(...)2.75 +-3.3 M F2 333.641(\)p)C -.198(ro)462.244 614.103 S(cedur).198 E(e)-.198 E(\(<=) +72 629.103 Q F3(z)4.583 E F5(1)3.3 I F3(z)2.75 -3.3 M F5(2)3.3 I F3(...)2.75 +-3.3 M F2 327.371(\)p)C -.198(ro)462.244 629.103 S(cedur).198 E(e)-.198 E(\(>=) +72 644.103 Q F3(z)4.583 E F5(1)3.3 I F3(z)2.75 -3.3 M F5(2)3.3 I F3(...)2.75 +-3.3 M F2 327.371(\)p)C -.198(ro)462.244 644.103 S(cedur).198 E(e)-.198 E F0 +(See R)72 662.703 Q F4(4)97.971 657.203 Q F0(RS.)102.471 662.703 Q EP +%%Page: 9 9 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-9-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(1+)72 87 Q/F2 11/Times-Italic@0 SF(z)4.583 +E F1 356.17(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 E(\(-1+)72 102 Q +F2(z)4.583 E F1 352.507(\)p)C -.198(ro)462.244 102 S(cedur).198 E(e)-.198 E F0 +(Returns)72 120.6 Q F2(z)2.75 E F0(plus 1 or)2.75 E F2(z)2.75 E F0 +(minus 1, respecti)2.75 E -.165(ve)-.275 G(ly).165 E(.)-.715 E F1(\(1-)72 150.6 +Q F2(z)4.583 E F1 358.777(\)p)C -.198(ro)462.244 150.6 S(cedur).198 E(e)-.198 E +F0 2.75(As)72 169.2 S(ynon)86.971 169.2 Q(ym for)-.165 E F2(-1+)2.75 E F0 +(\(for backw)2.75 E(ards compatibility\).)-.11 E F1(\(+)72 199.2 Q F2(z)4.583 E +/F3 10/Times-Italic@0 SF(1)3.3 I F2(...)2.75 -3.3 M F1 345.67(\)p)C -.198(ro) +462.244 199.2 S(cedur).198 E(e)-.198 E(\(*)72 214.2 Q F2(z)4.583 E F3(1)3.3 I +F2(...)2.75 -3.3 M F1 346.44(\)p)C -.198(ro)462.244 214.2 S(cedur).198 E(e) +-.198 E F0(See R)72 232.8 Q/F4 9/Times-Roman@0 SF(4)97.971 227.3 Q F0(RS.) +102.471 232.8 Q F1(\(-)72 262.8 Q F2(z)4.583 E F3(1)3.3 I F2(z)2.75 -3.3 M F3 +(2)3.3 I F2(...)2.75 -3.3 M F1 336.248(\)p)C -.198(ro)462.244 262.8 S(cedur) +.198 E(e)-.198 E(\(/)72 277.8 Q F2(z)4.583 E F3(1)3.3 I F2(z)2.75 -3.3 M F3(2) +3.3 I F2(...)2.75 -3.3 M F1 336.853(\)p)C -.198(ro)462.244 277.8 S(cedur).198 E +(e)-.198 E F0(See R)72 296.4 Q F4(4)97.971 290.9 Q F0(RS.)102.471 296.4 Q F1 +(\(zer)72 326.4 Q(o?)-.198 E F2(z)4.583 E F1 342.486(\)p)C -.198(ro)462.244 +326.4 S(cedur).198 E(e)-.198 E(\(positi)72 341.4 Q -.11(ve)-.11 G(?).11 E F2(z) +4.583 E F1 326.602(\)p)C -.198(ro)462.244 341.4 S(cedur).198 E(e)-.198 E +(\(negati)72 356.4 Q -.11(ve)-.11 G(?).11 E F2(z)4.583 E F1 323.555(\)p)C -.198 +(ro)462.244 356.4 S(cedur).198 E(e)-.198 E(\(odd?)72 371.4 Q F2(z)4.583 E F1 +344.708(\)p)C -.198(ro)462.244 371.4 S(cedur).198 E(e)-.198 E(\(e)72 386.4 Q +-.11(ve)-.165 G(n?).11 E F2(z)4.583 E F1 341.331(\)p)C -.198(ro)462.244 386.4 S +(cedur).198 E(e)-.198 E(\(exact?)72 401.4 Q F2(z)4.583 E F1 338.009(\)p)C -.198 +(ro)462.244 401.4 S(cedur).198 E(e)-.198 E(\(inexact?)72 416.4 Q F2(z)4.583 E +F1 328.835(\)p)C -.198(ro)462.244 416.4 S(cedur).198 E(e)-.198 E F0(See R)72 +435 Q F4(4)97.971 429.5 Q F0(RS.)102.471 435 Q F1(\(abs)72 465 Q F2(z)4.583 E +F1 352.045(\)p)C -.198(ro)462.244 465 S(cedur).198 E(e)-.198 E F0(See R)72 +483.6 Q F4(4)97.971 478.1 Q F0(RS.)102.471 483.6 Q F1(\(quotient)72 513.6 Q F2 +(n)4.583 E F3(1)3.3 I F2(n)2.75 -3.3 M F3(2)3.3 I F1 309.353(\)p)-3.3 K -.198 +(ro)462.244 513.6 S(cedur).198 E(e)-.198 E(\(r)72 528.6 Q(emainder)-.198 E F2 +(n)4.583 E F3(1)3.3 I F2(n)2.75 -3.3 M F3(2)3.3 I F1 299.178(\)p)-3.3 K -.198 +(ro)462.244 528.6 S(cedur).198 E(e)-.198 E(\(modulo)72 543.6 Q F2(n)4.583 E F3 +(1)3.3 I F2(n)2.75 -3.3 M F3(2)3.3 I F1 313.016(\)p)-3.3 K -.198(ro)462.244 +543.6 S(cedur).198 E(e)-.198 E F0(See R)72 562.2 Q F4(4)97.971 556.7 Q F0(RS.) +102.471 562.2 Q F1(\(gcd)72 592.2 Q F2(n)4.583 E F3(1)3.3 I F2(...)2.75 -3.3 M +F1 334.219(\)p)C -.198(ro)462.244 592.2 S(cedur).198 E(e)-.198 E(\(lcm)72 607.2 +Q F2(n)4.583 E F3(1)3.3 I F2(...)2.75 -3.3 M F1 333.614(\)p)C -.198(ro)462.244 +607.2 S(cedur).198 E(e)-.198 E F0(See R)72 625.8 Q F4(4)97.971 620.3 Q F0(RS.) +102.471 625.8 Q F1(\(\215oor)72 655.8 Q F2(x)4.583 E F1 345.335(\)p)C -.198(ro) +462.244 655.8 S(cedur).198 E(e)-.198 E(\(ceiling)72 670.8 Q F2(x)4.583 E F1 +336.777(\)p)C -.198(ro)462.244 670.8 S(cedur).198 E(e)-.198 E(\(truncate)72 +685.8 Q F2(x)4.583 E F1 327.625(\)p)C -.198(ro)462.244 685.8 S(cedur).198 E(e) +-.198 E(\(r)72 700.8 Q(ound)-.198 E F2(x)4.583 E F1 338.801(\)p)C -.198(ro) +462.244 700.8 S(cedur).198 E(e)-.198 E EP +%%Page: 10 10 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(0-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(See R)72 87 Q/F1 9/Times-Roman@0 SF(4)97.971 81.5 Q F0(RS.)102.471 +87 Q/F2 11/Times-Bold@0 SF(\(sqrt)72 117 Q/F3 11/Times-Italic@0 SF(z)4.583 E F2 +348.998(\)p)C -.198(ro)462.244 117 S(cedur).198 E(e)-.198 E F0(See R)72 135.6 Q +F1(4)97.971 130.1 Q F0(RS.)102.471 135.6 Q F2(\(expt)72 165.6 Q F3(z)4.583 E/F4 +10/Times-Italic@0 SF(1)3.3 I F3(z)2.75 -3.3 M F4(2)3.3 I F2 330.748(\)p)-3.3 K +-.198(ro)462.244 165.6 S(cedur).198 E(e)-.198 E F0(See R)72 184.2 Q F1(4)97.971 +178.7 Q F0(RS.)102.471 184.2 Q F2(\(exp)72 214.2 Q F3(z)4.583 E F2 351.44(\)p)C +-.198(ro)462.244 214.2 S(cedur).198 E(e)-.198 E(\(log)72 229.2 Q F3(z)4.583 E +F2 353.882(\)p)C -.198(ro)462.244 229.2 S(cedur).198 E(e)-.198 E(\(sin)72 244.2 +Q F3(z)4.583 E F2 354.487(\)p)C -.198(ro)462.244 244.2 S(cedur).198 E(e)-.198 E +(\(cos)72 259.2 Q F3(z)4.583 E F2 353.277(\)p)C -.198(ro)462.244 259.2 S(cedur) +.198 E(e)-.198 E(\(tan)72 274.2 Q F3(z)4.583 E F2 352.661(\)p)C -.198(ro) +462.244 274.2 S(cedur).198 E(e)-.198 E(\(asin)72 289.2 Q F3(z)4.583 E F2 +348.987(\)p)C -.198(ro)462.244 289.2 S(cedur).198 E(e)-.198 E(\(acos)72 304.2 Q +F3(z)4.583 E F2 347.777(\)p)C -.198(ro)462.244 304.2 S(cedur).198 E(e)-.198 E +(\(atan)72 319.2 Q F3(z)4.583 E F2 347.161(\)p)C -.198(ro)462.244 319.2 S +(cedur).198 E(e)-.198 E(\(atan)72 334.2 Q F3 2.75(yx)4.583 G F2 338.922(\)p) +113.543 334.2 S -.198(ro)462.244 334.2 S(cedur).198 E(e)-.198 E F0(See R)72 +352.8 Q F1(4)97.971 347.3 Q F0(RS.)102.471 352.8 Q F2(\(min)72 382.8 Q F3(x) +4.583 E F4(1)3.3 I F3(x)2.75 -3.3 M F4(2)3.3 I F3(...)2.75 -3.3 M F2 320.364 +(\)p)C -.198(ro)462.244 382.8 S(cedur).198 E(e)-.198 E(\(max)72 397.8 Q F3(x) +4.583 E F4(1)3.3 I F3(x)2.75 -3.3 M F4(2)3.3 I F3(...)2.75 -3.3 M F2 318.538 +(\)p)C -.198(ro)462.244 397.8 S(cedur).198 E(e)-.198 E F0(See R)72 416.4 Q F1 +(4)97.971 410.9 Q F0(RS.)102.471 416.4 Q F2 -.917(\(random \))72 446.4 R(pr) +456.128 446.4 Q(ocedur)-.198 E(e)-.198 E F0(Returns an inte)72 465 Q +(ger pseudo-random number in the range from 0 to 2)-.165 E/F5 10/Times-Roman@0 +SF(31)-3.3 I F0(-1.)3.3 I F2(\(srandom)72 495 Q F3(n)4.583 E F2 325.161(\)p)C +-.198(ro)462.244 495 S(cedur).198 E(e)-.198 E F0 +(Sets the random number generator to the starting point)72 513.6 Q F3(n)2.75 E +F0(.)A F3(sr)5.5 E(andom)-.165 E F0(returns)2.75 E F3(n)2.75 E F0(.)A F2 +(\(number?)72 543.6 Q F3(obj)4.583 E F2 315.382(\)p)C -.198(ro)462.244 543.6 S +(cedur).198 E(e)-.198 E(\(complex?)72 558.6 Q F3(obj)4.583 E F2 313.556(\)p)C +-.198(ro)462.244 558.6 S(cedur).198 E(e)-.198 E(\(r)72 573.6 Q(eal?)-.198 E F3 +(obj)4.583 E F2 334.533(\)p)C -.198(ro)462.244 573.6 S(cedur).198 E(e)-.198 E +(\(rational?)72 588.6 Q F3(obj)4.583 E F2 315.382(\)p)C -.198(ro)462.244 588.6 +S(cedur).198 E(e)-.198 E(\(integer?)72 603.6 Q F3(obj)4.583 E F2 319.672(\)p)C +-.198(ro)462.244 603.6 S(cedur).198 E(e)-.198 E F0(See R)72 622.2 Q F1(4)97.971 +616.7 Q F0(RS.)102.471 622.2 Q F2(\(exact)72 652.2 Q/F6 11/Symbol SF(-)A F2 +(>inexact)A F3(z)4.583 E F2 297.595(\)p)C -.198(ro)462.244 652.2 S(cedur).198 E +(e)-.198 E(\(inexact)72 667.2 Q F6(-)A F2(>exact)A F3(z)4.583 E F2 297.595(\)p) +C -.198(ro)462.244 667.2 S(cedur).198 E(e)-.198 E F0(See R)72 685.8 Q F1(4) +97.971 680.3 Q F0(RS.)102.471 685.8 Q EP +%%Page: 11 11 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(1-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(number)72 87 Q/F2 11/Symbol SF(-)A F1 +(>string)A/F3 11/Times-Italic@0 SF(number)4.583 E F1 261.526(\)p)C -.198(ro) +462.244 87 S(cedur).198 E(e)-.198 E(\(number)72 102 Q F2(-)A F1(>string)A F3 +(number r)4.583 E(adix)-.165 E F1 235.72(\)p)C -.198(ro)462.244 102 S(cedur) +.198 E(e)-.198 E F0(See R)72 120.6 Q/F4 9/Times-Roman@0 SF(4)97.971 115.1 Q F0 +(RS.)102.471 120.6 Q F1(\(string)72 150.6 Q F2(-)A F1(>number)A F3(string)4.583 +E F1 269.457(\)p)C -.198(ro)462.244 150.6 S(cedur).198 E(e)-.198 E(\(string)72 +165.6 Q F2(-)A F1(>number)A F3(string r)4.583 E(adix)-.165 E F1 243.651(\)p)C +-.198(ro)462.244 165.6 S(cedur).198 E(e)-.198 E F0(See R)72 184.2 Q F4(4)97.971 +178.7 Q F0(RS.)102.471 184.2 Q F1 2.75(18. Characters)72 214.2 R(\(char)72 +244.2 Q F2(-)A F1(>integer)A F3 -.165(ch)4.583 G(ar).165 E F1 285.539(\)p)C +-.198(ro)462.244 244.2 S(cedur).198 E(e)-.198 E(\(integer)72 259.2 Q F2(-)A F1 +(>char)A F3(n)4.583 E F1 300.037(\)p)C -.198(ro)462.244 259.2 S(cedur).198 E(e) +-.198 E F0(See R)72 277.8 Q F4(4)97.971 272.3 Q F0(RS.)102.471 277.8 Q F1 +(\(char)72 307.8 Q(-upper)-.407 E(-case?)-.407 E F3 -.165(ch)4.583 G(ar).165 E +F1 271.162(\)p)C -.198(ro)462.244 307.8 S(cedur).198 E(e)-.198 E(\(char)72 +322.8 Q(-lo)-.407 E(wer)-.11 E(-case?)-.407 E F3 -.165(ch)4.583 G(ar).165 E F1 +273.12(\)p)C -.198(ro)462.244 322.8 S(cedur).198 E(e)-.198 E F0(See R)72 341.4 +Q F4(4)97.971 335.9 Q F0(RS.)102.471 341.4 Q F1(\(char)72 371.4 Q(-alphabetic?) +-.407 E F3 -.165(ch)4.583 G(ar).165 E F1 273.186(\)p)C -.198(ro)462.244 371.4 S +(cedur).198 E(e)-.198 E(\(char)72 386.4 Q(-numeric?)-.407 E F3 -.165(ch)4.583 G +(ar).165 E F1 282.976(\)p)C -.198(ro)462.244 386.4 S(cedur).198 E(e)-.198 E +(\(char)72 401.4 Q(-whitespace?)-.407 E F3 -.165(ch)4.583 G(ar).165 E F1 +270.755(\)p)C -.198(ro)462.244 401.4 S(cedur).198 E(e)-.198 E F0(See R)72 420 Q +F4(4)97.971 414.5 Q F0(RS.)102.471 420 Q F1(\(char)72 450 Q(-upcase)-.407 E F3 +-.165(ch)4.583 G(ar).165 E F1 295.802(\)p)C -.198(ro)462.244 450 S(cedur).198 E +(e)-.198 E(\(char)72 465 Q(-do)-.407 E(wncase)-.11 E F3 -.165(ch)4.583 G(ar) +.165 E F1 282.47(\)p)C -.198(ro)462.244 465 S(cedur).198 E(e)-.198 E F0(See R) +72 483.6 Q F4(4)97.971 478.1 Q F0(RS.)102.471 483.6 Q F1(\(char=?)72 513.6 Q F3 +-.165(ch)4.583 G(ar).165 E/F5 10/Times-Italic@0 SF(1)3.3 I F3 -.165(ch)2.75 +-3.3 O(ar).165 E F5(2)3.3 I F1 286.319(\)p)-3.3 K -.198(ro)462.244 513.6 S +(cedur).198 E(e)-.198 E(\(char?)72 543.6 Q F3 -.165(ch) +4.583 G(ar).165 E F5(1)3.3 I F3 -.165(ch)2.75 -3.3 O(ar).165 E F5(2)3.3 I F1 +286.319(\)p)-3.3 K -.198(ro)462.244 543.6 S(cedur).198 E(e)-.198 E(\(char<=?)72 +558.6 Q F3 -.165(ch)4.583 G(ar).165 E F5(1)3.3 I F3 -.165(ch)2.75 -3.3 O(ar) +.165 E F5(2)3.3 I F1 280.049(\)p)-3.3 K -.198(ro)462.244 558.6 S(cedur).198 E +(e)-.198 E(\(char>=?)72 573.6 Q F3 -.165(ch)4.583 G(ar).165 E F5(1)3.3 I F3 +-.165(ch)2.75 -3.3 O(ar).165 E F5(2)3.3 I F1 280.049(\)p)-3.3 K -.198(ro) +462.244 573.6 S(cedur).198 E(e)-.198 E F0(See R)72 592.2 Q F4(4)97.971 586.7 Q +F0(RS.)102.471 592.2 Q F1(\(char)72 622.2 Q(-ci=?)-.407 E F3 -.165(ch)4.583 G +(ar).165 E F5(1)3.3 I F3 -.165(ch)2.75 -3.3 O(ar).165 E F5(2)3.3 I F1 275.121 +(\)p)-3.3 K -.198(ro)462.244 622.2 S(cedur).198 E(e)-.198 E(\(char)72 637.2 Q +(-ci?)-.407 E F3 -.165(ch)4.583 G(ar).165 E F5(1) +3.3 I F3 -.165(ch)2.75 -3.3 O(ar).165 E F5(2)3.3 I F1 275.121(\)p)-3.3 K -.198 +(ro)462.244 652.2 S(cedur).198 E(e)-.198 E(\(char)72 667.2 Q(-ci<=?)-.407 E F3 +-.165(ch)4.583 G(ar).165 E F5(1)3.3 I F3 -.165(ch)2.75 -3.3 O(ar).165 E F5(2) +3.3 I F1 268.851(\)p)-3.3 K -.198(ro)462.244 667.2 S(cedur).198 E(e)-.198 E +(\(char)72 682.2 Q(-ci>=?)-.407 E F3 -.165(ch)4.583 G(ar).165 E F5(1)3.3 I F3 +-.165(ch)2.75 -3.3 O(ar).165 E F5(2)3.3 I F1 268.851(\)p)-3.3 K -.198(ro) +462.244 682.2 S(cedur).198 E(e)-.198 E F0(See R)72 700.8 Q F4(4)97.971 695.3 Q +F0(RS.)102.471 700.8 Q EP +%%Page: 12 12 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(2-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(char?)72 87 Q/F2 11/Times-Italic@0 SF(obj) +4.583 E F1 331.277(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 E F0(See R) +72 105.6 Q/F3 9/Times-Roman@0 SF(4)97.971 100.1 Q F0(RS.)102.471 105.6 Q F1 +2.75(19. Strings)72 135.6 R(\(string)72 165.6 Q F2 -.165(ch)4.583 G(ar ...).165 +E F1 313.721(\)p)C -.198(ro)462.244 165.6 S(cedur).198 E(e)-.198 E F0 +(Returns a string containing the speci\214ed characters.)72 184.2 Q(Examples:) +72 199.2 Q/F4 10/Courier@0 SF 144(\(string\) ==>)100.346 221.703 R("")328.346 +221.703 Q(\(string #\\a #\\space #\\b\))100.346 235.703 Q 6(==> "a)298.346 +235.703 R(b")6 E F1(\(string?)72 272.703 Q F2(obj)4.583 E F1 325.161(\)p)C +-.198(ro)462.244 272.703 S(cedur).198 E(e)-.198 E F0(See R)72 291.303 Q F3(4) +97.971 285.803 Q F0(RS.)102.471 291.303 Q F1(\(mak)72 321.303 Q(e-string)-.11 E +F2 2.75(kc)4.583 G(har)149.315 321.303 Q F1 287.871(\)p)C -.198(ro)462.244 +321.303 S(cedur).198 E(e)-.198 E F0(See R)72 339.903 Q F3(4)97.971 334.403 Q F0 +(RS.)102.471 339.903 Q F1(\(string-length)72 369.903 Q F2(string)4.583 E F1 +286.045(\)p)C -.198(ro)462.244 369.903 S(cedur).198 E(e)-.198 E F0(See R)72 +388.503 Q F3(4)97.971 383.003 Q F0(RS.)102.471 388.503 Q F1(\(string-r)72 +418.503 Q(ef)-.198 E F2(string k)4.583 E F1 294.515(\)p)C -.198(ro)462.244 +418.503 S(cedur).198 E(e)-.198 E F0(See R)72 437.103 Q F3(4)97.971 431.603 Q F0 +(RS.)102.471 437.103 Q F1(\(string-set!)72 467.103 Q F2(string k c)4.583 E(har) +-.165 E F1 268.511(\)p)C -.198(ro)462.244 467.103 S(cedur).198 E(e)-.198 E F0 +(See R)72 485.703 Q F3(4)97.971 480.203 Q F0(RS.)102.471 485.703 Q +(Returns the pre)72 500.703 Q(vious v)-.275 E(alue of element)-.275 E F2(k)2.75 +E F0(of the gi)2.75 E -.165(ve)-.275 G 2.75(ns).165 G(tring.)308.082 500.703 Q +F1(\(substring)72 530.703 Q F2(string start end)4.583 E F1 260.976(\)p)C -.198 +(ro)462.244 530.703 S(cedur).198 E(e)-.198 E F0(See R)72 549.303 Q F3(4)97.971 +543.803 Q F0(RS.)102.471 549.303 Q F1(\(string-copy)72 579.303 Q F2(string) +4.583 E F1 293.382(\)p)C -.198(ro)462.244 579.303 S(cedur).198 E(e)-.198 E F0 +(See R)72 597.903 Q F3(4)97.971 592.403 Q F0(RS.)102.471 597.903 Q F1 +(\(string-append)72 627.903 Q F2(string ...)4.583 E F1 269.534(\)p)C -.198(ro) +462.244 627.903 S(cedur).198 E(e)-.198 E F0(See R)72 646.503 Q F3(4)97.971 +641.003 Q F0(RS.)102.471 646.503 Q F1(\(list)72 676.503 Q/F5 11/Symbol SF(-)A +F1(>string)A F2 -.165(ch)4.583 G(ar).165 E(s)-.11 E F1 294.185(\)p)C -.198(ro) +462.244 676.503 S(cedur).198 E(e)-.198 E(\(string)72 691.503 Q F5(-)A F1(>list) +A F2(string)4.583 E F1 292.678(\)p)C -.198(ro)462.244 691.503 S(cedur).198 E(e) +-.198 E F0(See R)72 710.103 Q F3(4)97.971 704.603 Q F0(RS.)102.471 710.103 Q EP +%%Page: 13 13 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(3-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(string-\214ll!)72 87 Q/F2 11/Times-Italic@0 +SF(string c)4.583 E(har)-.165 E F1 276.739(\)p)C -.198(ro)462.244 87 S(cedur) +.198 E(e)-.198 E F0(See R)72 105.6 Q/F3 9/Times-Roman@0 SF(4)97.971 100.1 Q F0 +(RS.)102.471 105.6 Q(Returns)72 120.6 Q F2(string)2.75 E F0(.)A F1 +(\(substring-\214ll!)72 150.6 Q F2(string start end c)4.583 E(har)-.165 E F1 +218.67(\)p)C -.198(ro)462.244 150.6 S(cedur).198 E(e)-.198 E F0(Stores)72 169.2 +Q F2 -.165(ch)2.75 G(ar).165 E F0(in e)2.75 E -.165(ve)-.275 G(ry element of) +.165 E F2(string)2.75 E F0(from)2.75 E F2(start)2.75 E F0(\(inclusi)2.75 E +-.165(ve)-.275 G 2.75(\)t).165 G(o)340.433 169.2 Q F2(end)2.75 E F0(\(e)2.75 E +(xclusi)-.165 E -.165(ve)-.275 G 2.75(\). Returns).165 F F2(string)2.75 E F0(.) +A F1(\(string=?)72 199.2 Q F2(string)4.583 E/F4 10/Times-Italic@0 SF(1)3.3 I F2 +(string)2.75 -3.3 M F4(2)3.3 I F1 268.851(\)p)-3.3 K -.198(ro)462.244 199.2 S +(cedur).198 E(e)-.198 E(\(string?)72 229.2 Q F2(string)4.583 E F4(1)3.3 I F2 +(string)2.75 -3.3 M F4(2)3.3 I F1 268.851(\)p)-3.3 K -.198(ro)462.244 229.2 S +(cedur).198 E(e)-.198 E(\(string<=?)72 244.2 Q F2(string)4.583 E F4(1)3.3 I F2 +(string)2.75 -3.3 M F4(2)3.3 I F1 262.581(\)p)-3.3 K -.198(ro)462.244 244.2 S +(cedur).198 E(e)-.198 E(\(string>=?)72 259.2 Q F2(string)4.583 E F4(1)3.3 I F2 +(string)2.75 -3.3 M F4(2)3.3 I F1 262.581(\)p)-3.3 K -.198(ro)462.244 259.2 S +(cedur).198 E(e)-.198 E F0(See R)72 277.8 Q F3(4)97.971 272.3 Q F0(RS.)102.471 +277.8 Q F1(\(string-ci=?)72 307.8 Q F2(string)4.583 E F4(1)3.3 I F2(string)2.75 +-3.3 M F4(2)3.3 I F1 257.246(\)p)-3.3 K -.198(ro)462.244 307.8 S(cedur).198 E +(e)-.198 E(\(string-ci?)72 337.8 Q F2(string)4.583 E F4(1)3.3 I F2(string)2.75 +-3.3 M F4(2)3.3 I F1 257.246(\)p)-3.3 K -.198(ro)462.244 337.8 S(cedur).198 E +(e)-.198 E(\(string-ci<=?)72 352.8 Q F2(string)4.583 E F4(1)3.3 I F2(string) +2.75 -3.3 M F4(2)3.3 I F1 250.976(\)p)-3.3 K -.198(ro)462.244 352.8 S(cedur) +.198 E(e)-.198 E(\(string-ci>=?)72 367.8 Q F2(string)4.583 E F4(1)3.3 I F2 +(string)2.75 -3.3 M F4(2)3.3 I F1 250.976(\)p)-3.3 K -.198(ro)462.244 367.8 S +(cedur).198 E(e)-.198 E F0(See R)72 386.4 Q F3(4)97.971 380.9 Q F0(RS.)102.471 +386.4 Q F1(\(substring?)72 416.4 Q F2(string)4.583 E F4(1)3.3 I F2(string)2.75 +-3.3 M F4(2)3.3 I F1 258.61(\)p)-3.3 K -.198(ro)462.244 416.4 S(cedur).198 E(e) +-.198 E(\(substring-ci?)72 431.4 Q F2(string)4.583 E F4(1)3.3 I F2(string)2.75 +-3.3 M F4(2)3.3 I F1 247.005(\)p)-3.3 K -.198(ro)462.244 431.4 S(cedur).198 E +(e)-.198 E F0(If)72 450 Q F2(string)3.265 E F4(1)3.3 I F0 .515 +(is a substring of)3.265 -3.3 N F2(string)3.265 E F4(2)3.3 I F0 3.265(,t)-3.3 K +.514(hese procedures return the starting position of the \214rst occur)231.058 +450 R(-)-.22 E .471(rence of the substring within)72 465 R F2(string)3.221 E F4 +(2)3.3 I F0 5.971(.O)-3.3 K .472(therwise #f is returned.)250.315 465 R F2 +(substring-ci?)5.972 E F0 .472(is the case insensi-)3.222 F(ti)72 480 Q .33 +-.165(ve ve)-.275 H(rsion of).165 E F2(substring?)2.75 E F0(.)A(Examples:)72 +495 Q/F5 10/Courier@0 SF(\(define s "Hello world"\))100.346 517.503 Q +(\(substring? "foo" x\))100.346 531.503 Q 6(==> #f)298.346 531.503 R +(\(substring? "hello" x\))100.346 545.503 Q 6(==> #f)298.346 545.503 R +(\(substring-ci? "hello" x\))100.346 559.503 Q 6(==> 0)298.346 559.503 R +(\(substring? "!" x\))100.346 573.503 Q 6(==> 11)298.346 573.503 R F1 2.75 +(20. V)72 610.503 R(ectors)-1.1 E(\(v)72 640.503 Q(ector?)-.11 E F2(obj)4.583 E +F1 323.456(\)p)C -.198(ro)462.244 640.503 S(cedur).198 E(e)-.198 E F0(See R)72 +659.103 Q F3(4)97.971 653.603 Q F0(RS.)102.471 659.103 Q EP +%%Page: 14 14 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(4-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(mak)72 87 Q(e-v)-.11 E(ector)-.11 E/F2 11 +/Times-Italic@0 SF(k)4.583 E F1 308.914(\)p)C -.198(ro)462.244 87 S(cedur).198 +E(e)-.198 E(\(mak)72 102 Q(e-v)-.11 E(ector)-.11 E F2 2.75<6b8c>4.583 G(ll) +151.801 102 Q F1 294.548(\)p)C -.198(ro)462.244 102 S(cedur).198 E(e)-.198 E F0 +(See R)72 120.6 Q/F3 9/Times-Roman@0 SF(4)97.971 115.1 Q F0(RS.)102.471 120.6 Q +F1(\(v)72 150.6 Q(ector)-.11 E F2(obj ...)4.583 E F1 317.956(\)p)C -.198(ro) +462.244 150.6 S(cedur).198 E(e)-.198 E F0(See R)72 169.2 Q F3(4)97.971 163.7 Q +F0(RS.)102.471 169.2 Q F1(\(v)72 199.2 Q(ector)-.11 E(-length)-.407 E F2 +(vector)4.583 E F1 282.932(\)p)C -.198(ro)462.244 199.2 S(cedur).198 E(e)-.198 +E F0(See R)72 217.8 Q F3(4)97.971 212.3 Q F0(RS.)102.471 217.8 Q F1(\(v)72 +247.8 Q(ector)-.11 E(-r)-.407 E(ef)-.198 E F2(vector k)4.583 E F1 291.402(\)p)C +-.198(ro)462.244 247.8 S(cedur).198 E(e)-.198 E F0(See R)72 266.4 Q F3(4)97.971 +260.9 Q F0(RS.)102.471 266.4 Q F1(\(v)72 296.4 Q(ector)-.11 E(-set!)-.407 E F2 +(vector k obj)4.583 E F1 271.338(\)p)C -.198(ro)462.244 296.4 S(cedur).198 E(e) +-.198 E F0(See R)72 315 Q F3(4)97.971 309.5 Q F0(RS.)102.471 315 Q +(Returns the pre)72 330 Q(vious v)-.275 E(alue of element)-.275 E F2(k)2.75 E +F0(of the v)2.75 E(ector)-.165 E(.)-.605 E F1(\(v)72 360 Q(ector)-.11 E/F4 11 +/Symbol SF(-)A F1(>list)A F2(vector)4.583 E F1 289.158(\)p)C -.198(ro)462.244 +360 S(cedur).198 E(e)-.198 E(\(list)72 375 Q F4(-)A F1(>v)A(ector)-.11 E F2 +(list)4.583 E F1 303.194(\)p)C -.198(ro)462.244 375 S(cedur).198 E(e)-.198 E F0 +(See R)72 393.6 Q F3(4)97.971 388.1 Q F0(RS.)102.471 393.6 Q F1(\(v)72 423.6 Q +(ector)-.11 E(-\214ll!)-.407 E F2(vector \214ll)4.583 E F1 282.008(\)p)C -.198 +(ro)462.244 423.6 S(cedur).198 E(e)-.198 E F0(See R)72 442.2 Q F3(4)97.971 +436.7 Q F0(RS.)102.471 442.2 Q(Returns)72 457.2 Q F2(vector)2.75 E F0(.)A F1 +(\(v)72 487.2 Q(ector)-.11 E(-copy)-.407 E F2(vector)4.583 E F1 290.269(\)p)C +-.198(ro)462.244 487.2 S(cedur).198 E(e)-.198 E F0(Returns a cop)72 505.8 Q +2.75(yo)-.11 G(f)146.129 505.8 Q F2(vector)2.75 E F0(.)A F1 2.75(21. Symbols)72 +535.8 R(\(string)72 565.8 Q F4(-)A F1(>symbol)A F2(string)4.583 E F1 273.12 +(\)p)C -.198(ro)462.244 565.8 S(cedur).198 E(e)-.198 E(\(symbol)72 580.8 Q F4 +(-)A F1(>string)A F2(symbol)4.583 E F1 267.631(\)p)C -.198(ro)462.244 580.8 S +(cedur).198 E(e)-.198 E F0(See R)72 599.4 Q F3(4)97.971 593.9 Q F0(RS.)102.471 +599.4 Q F1(\(put)72 629.4 Q F2(symbol k)4.583 E .66 -.33(ey v)-.11 H(alue).33 E +F1 281.623(\)p)C -.198(ro)462.244 629.4 S(cedur).198 E(e)-.198 E(\(put)72 644.4 +Q F2(symbol k)4.583 E -.33(ey)-.11 G F1 308.199(\)p).33 G -.198(ro)462.244 +644.4 S(cedur).198 E(e)-.198 E F0(Associates)72 663 Q F2(value)2.774 E F0(with) +2.774 E F2 -.11(ke)2.773 G(y)-.22 E F0 .023(in the property list of the gi) +2.773 F -.165(ve)-.275 G 2.773(ns).165 G(ymbol.)330.755 663 Q F2 -.11(ke)5.523 +G(y)-.22 E F0 .023(must be a symbol.)2.773 F(Returns)5.523 E F2 -.11(ke)72 678 +S(y)-.22 E F0(.)A(If)72 693 Q F2(value)2.75 E F0 +(is omitted, the property is remo)2.75 E -.165(ve)-.165 G 2.75(df).165 G +(rom the symbol')268.724 693 Q 2.75(sp)-.605 G(roperty list.)353.369 693 Q EP +%%Page: 15 15 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(5-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(get)72 87 Q/F2 11/Times-Italic@0 SF +(symbol k)4.583 E -.33(ey)-.11 G F1 310.047(\)p).33 G -.198(ro)462.244 87 S +(cedur).198 E(e)-.198 E F0 .37(Returns the v)72 105.6 R .37 +(alue associated with)-.275 F F2 -.11(ke)3.12 G(y)-.22 E F0 .37 +(in the property list of)3.12 F F2(symbol)3.12 E F0(.)A F2 -.11(ke)5.87 G(y) +-.22 E F0 .37(must be a symbol.)3.12 F .371(If no)5.871 F -.275(va)72 120.6 S +(lue is associated with).275 E F2 -.11(ke)2.75 G(y)-.22 E F0(in the symbol') +2.75 E 2.75(sp)-.605 G(roperty list, #f is returned.)271.1 120.6 Q(Examples:)72 +135.6 Q/F3 10/Courier@0 SF(\(put 'norway 'capital "Oslo"\))100.346 158.103 Q +(\(put 'norway 'continent "Europe"\))100.346 172.103 Q +(\(get 'norway 'capital\))100.346 186.103 Q 6(==> "Oslo")298.346 186.103 R F1 +(\(symbol-plist)72 223.103 Q F2(symbol)4.583 E F1 283.603(\)p)C -.198(ro) +462.244 223.103 S(cedur).198 E(e)-.198 E F0(Returns a cop)72 241.703 Q 2.75(yo) +-.11 G 2.75(ft)146.129 241.703 S(he property list of)155.6 241.703 Q F2(symbol) +2.75 E F0(as an)2.75 E F2(alist)2.75 E F0(.)A(Examples:)72 256.703 Q F3 +(\(put 'norway 'capital "Oslo"\))100.346 279.206 Q +(\(put 'norway 'continent "Europe"\))100.346 293.206 Q +(\(symbol-plist 'norway\))100.346 307.206 Q 6(==> \(\(capital)118.346 321.206 R +6(.")6 G(Oslo"\) \(continent . "Europe"\)\))226.346 321.206 Q +(\(symbol-plist 'foo\))100.346 335.206 Q 6(==> \(\))298.346 335.206 R F1 +(\(symbol?)72 372.206 Q F2(obj)4.583 E F1 319.045(\)p)C -.198(ro)462.244 +372.206 S(cedur).198 E(e)-.198 E F0(See R)72 390.806 Q/F4 9/Times-Roman@0 SF(4) +97.971 385.306 Q F0(RS.)102.471 390.806 Q F1 -.917(\(oblist \))72 420.806 R(pr) +456.128 420.806 Q(ocedur)-.198 E(e)-.198 E F0 .677 +(Returns a list of lists containing all currently interned symbols.)72 439.406 +R .677(Each sublist represents a b)6.177 F(uck)-.22 E(et)-.11 E +(of the interpreters internal hash array)72 454.406 Q(.)-.715 E(Examples:)72 +469.406 Q F3(\(define \(apropos what\))100.346 491.909 Q +(\(let \(\(ret \(\)\)\))112.346 505.909 Q +(\(do \(\(tail \(oblist\) \(cdr tail\)\)\) \(\(null? tail\)\))124.346 519.909 Q +(\(do \(\(l \(car tail\) \(cdr l\)\)\) \(\(null? l\)\))136.346 533.909 Q +(\(if \(substring? what \(symbol->string \(car l\)\)\))148.346 547.909 Q +(\(set! ret \(cons \(car l\) ret\)\)\)\)\))172.346 561.909 Q(ret\)\))124.346 +575.909 Q(\(apropos "let"\))100.346 605.412 Q 6(==> \(let*)232.346 605.412 R +(let letrec fluid-let\))6 E(\(apropos "make"\))100.346 619.412 Q 6 +(==> \(make-list)232.346 619.412 R(make-vector make-string\))6 E +(\(apropos "foo"\))100.346 633.412 Q 6(==> \(\))232.346 633.412 R EP +%%Page: 16 16 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(6-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(22. En)72 87 R(vir)-.44 E(onments)-.198 +E(\(the-en)72 117 Q(vir)-.44 E -.917(onment \))-.198 F(pr)456.128 117 Q(ocedur) +-.198 E(e)-.198 E F0(Returns the current en)72 135.6 Q(vironment.)-.44 E F1 +(\(global-en)72 165.6 Q(vir)-.44 E -.917(onment \))-.198 F(pr)456.128 165.6 Q +(ocedur)-.198 E(e)-.198 E F0 .924(Returns the global en)72 184.2 R .924 +(vironment \(the `)-.44 F(`root')-.814 E 3.675('e)-.814 G -.44(nv)277.108 184.2 +S .925(ironment in which all prede\214ned procedures are).44 F(bound\).)72 +199.2 Q F1(\(en)72 229.2 Q(vir)-.44 E(onment)-.198 E/F2 11/Symbol SF(-)A F1 +(>list)A/F3 11/Times-Italic@0 SF(en)4.583 E(vir)-.44 E(onment)-.495 E F1 +232.552(\)p)C -.198(ro)462.244 229.2 S(cedur).198 E(e)-.198 E F0 .539 +(Returns a list representing the speci\214ed en)72 247.8 R 3.289 +(vironment. The)-.44 F .539(list is a list of)3.289 F F3(fr)3.289 E(ames)-.165 +E F0 3.289(,e)C .538(ach frame is a)440.995 247.8 R 1.393 +(list of bindings \(an)72 262.8 R F3(alist)4.144 E F0 4.144(\). The)B 1.394 +(car of the list represents the most recently established en)4.144 F(viron-) +-.44 E 2.75(ment. The)72 277.8 R(list returned by)2.75 E F3(en)2.75 E(vir)-.44 +E(onment)-.495 E F2(-)A F3(>list)A F0(can contain c)2.75 E(ycles.)-.165 E +(Examples:)72 292.8 Q/F4 10/Courier@0 SF(\(let \(\(x 1\) \(y 2\)\))100.346 +315.303 Q(\(car \(environment->list)112.346 329.303 Q 66 +(\(the-environment\)\)\)\) ==>)124.346 343.303 R(\(\(y . 2\) \(x . 1\)\)) +346.346 343.303 Q(\(\(lambda \(foo\))100.346 372.806 Q +(\(caar \(environment->list)118.346 386.806 Q +(\(the-environment\)\)\)\) "abc"\))130.346 400.806 Q 6(==> \(foo)316.346 +400.806 R 6(.")6 G(abc"\))394.346 400.806 Q(\(eq?)100.346 430.309 Q +(\(car \(last-pair \(environment->list)112.346 444.309 Q +(\(the-environment\)\)\)\))124.346 458.309 Q(\(car \(environment->list)112.346 +472.309 Q 48(\(global-environment\)\)\)\) ==>)124.346 486.309 R(#t)346.346 +486.309 Q F1(\(pr)72 523.309 Q(ocedur)-.198 E(e-en)-.198 E(vir)-.44 E(onment) +-.198 E F3(pr)4.583 E(ocedur)-.495 E(e)-.407 E F1 217.13(\)p)C -.198(ro)462.244 +523.309 S(cedur).198 E(e)-.198 E(\(pr)72 538.309 Q(omise-en)-.198 E(vir)-.44 E +(onment)-.198 E F3(pr)4.583 E(omise)-.495 E F1 236.677(\)p)C -.198(ro)462.244 +538.309 S(cedur).198 E(e)-.198 E(\(contr)72 553.309 Q(ol-point-en)-.198 E(vir) +-.44 E(onment)-.198 E F3(contr)4.583 E(ol-point)-.495 E F1 190.224(\)p)C -.198 +(ro)462.244 553.309 S(cedur).198 E(e)-.198 E F0 .522(Returns the en)72 571.909 +R .522(vironment in which the the body of the)-.44 F F3(pr)3.272 E(ocedur)-.495 +E(e)-.407 E F0 .522(is e)3.272 F -.275(va)-.275 G .522(luated, the en).275 F +.521(vironment in)-.44 F 1.676(which a v)72 586.909 R 1.676(alue for the)-.275 +F F3(pr)4.426 E(omise)-.495 E F0 1.676(is computed when)4.426 F F3(for)4.426 E +(ce)-.407 E F0 1.677(is applied to it, or the en)4.426 F 1.677(vironment in) +-.44 F(which the)72 601.909 Q F3(contr)2.75 E(ol-point)-.495 E F0 +(has been created, respecti)2.75 E -.165(ve)-.275 G(ly).165 E(.)-.715 E F1 +(\(en)72 631.909 Q(vir)-.44 E(onment?)-.198 E F3(obj)4.583 E F1 293.415(\)p)C +-.198(ro)462.244 631.909 S(cedur).198 E(e)-.198 E F0(Returns #t if)72 650.509 Q +F3(obj)2.75 E F0(is an en)2.75 E(vironment, #f otherwise.)-.44 E EP +%%Page: 17 17 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(7-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(23. P)72 87 R(orts and Files)-.22 E F0 +(Generally)72 105.6 Q 2.961(,a\214)-.715 G .211 +(le name can either be a string or a symbol.)134.33 105.6 R .21 +(If a symbol is gi)5.71 F -.165(ve)-.275 G .21(n, it is con).165 F -.165(ve) +-.44 G .21(rted into).165 F 3.112(as)72 120.6 S .362(tring by applying)84.275 +120.6 R/F2 11/Times-Italic@0 SF(symbol)3.113 E/F3 11/Symbol SF(-)A F2(>string)A +F0 5.863(.A)C .363(tilde at the be)253.86 120.6 R .363 +(ginning of a \214le name is e)-.165 F .363(xpanded accord-)-.165 F +(ing to the rules emplo)72 135.6 Q(yed by the C-Shell \(see)-.11 E F2(csh)2.75 +E F0(\(1\)\).)A 1.407(Elk adds a third type of ports,)72 154.2 R F2 +(input-output)4.157 E F0 1.407(\(bidirectional\) ports.)4.157 F(Both)6.907 E F2 +(input-port?)4.157 E F0(and)4.157 E F2(output-)4.156 E(port?)72 169.2 Q F0 .556 +(return #t when applied to an input-output port, and both input primiti)3.305 F +-.165(ve)-.275 G 3.306(sa).165 G .556(nd output primi-)430.772 169.2 R(ti)72 +184.2 Q -.165(ve)-.275 G 2.994(sm).165 G .243 +(ay be applied to input-output ports.)103.891 184.2 R .243 +(An input-output port \(in f)5.743 F(act,)-.11 E F2(any)2.993 E F0 .243 +(port\) may be closed)2.993 F(with an)72 199.2 Q 2.75(yo)-.165 G 2.75(ft) +118.277 199.2 S(he primiti)127.748 199.2 Q -.165(ve)-.275 G(s).165 E F2 +(close-input-port)2.75 E F0(and)2.75 E F2(close-output-port)2.75 E F0(.)A .62 +(The only w)72 217.8 R .621 +(ay to create an input-output-port is by means of the procedure)-.11 F F2 +(open-input-output-\214le)3.371 E F0(.)A(Extensions may pro)72 232.8 Q +(vide additional means to create bidirectional ports.)-.165 E F1 +(\(call-with-input-\214le)72 262.8 Q F2(\214le pr)4.583 E(ocedur)-.495 E(e) +-.407 E F1 224.324(\)p)C -.198(ro)462.244 262.8 S(cedur).198 E(e)-.198 E +(\(call-with-output-\214le)72 277.8 Q F2(\214le pr)4.583 E(ocedur)-.495 E(e) +-.407 E F1 218.219(\)p)C -.198(ro)462.244 277.8 S(cedur).198 E(e)-.198 E F0 +(See R)72 296.4 Q/F4 9/Times-Roman@0 SF(4)97.971 290.9 Q F0(RS.)102.471 296.4 Q +F1(\(input-port?)72 326.4 Q F2(obj)4.583 E F1 303.766(\)p)C -.198(ro)462.244 +326.4 S(cedur).198 E(e)-.198 E(\(output-port?)72 341.4 Q F2(obj)4.583 E F1 +297.661(\)p)C -.198(ro)462.244 341.4 S(cedur).198 E(e)-.198 E F0(See R)72 360 Q +F4(4)97.971 354.5 Q F0(RS.)102.471 360 Q F1(\(curr)72 390 Q -.917 +(ent-input-port \))-.198 F(pr)456.128 390 Q(ocedur)-.198 E(e)-.198 E(\(curr)72 +405 Q -.917(ent-output-port \))-.198 F(pr)456.128 405 Q(ocedur)-.198 E(e)-.198 +E F0(See R)72 423.6 Q F4(4)97.971 418.1 Q F0(RS.)102.471 423.6 Q F1 +(\(with-input-fr)72 453.6 Q(om-\214le)-.198 E F2(\214le thunk)4.583 E F1 +237.678(\)p)C -.198(ro)462.244 453.6 S(cedur).198 E(e)-.198 E +(\(with-output-to-\214le)72 468.6 Q F2(\214le thunk)4.583 E F1 245.422(\)p)C +-.198(ro)462.244 468.6 S(cedur).198 E(e)-.198 E F0(See R)72 487.2 Q F4(4)97.971 +481.7 Q F0(RS.)102.471 487.2 Q F2(\214le)72 502.2 Q F0 +(can be a string as well as a symbol.)2.75 E F1(\(open-input-\214le)72 532.2 Q +F2(\214le)4.583 E F1 289.708(\)p)C -.198(ro)462.244 532.2 S(cedur).198 E(e) +-.198 E(\(open-output-\214le)72 547.2 Q F2(\214le)4.583 E F1 283.603(\)p)C +-.198(ro)462.244 547.2 S(cedur).198 E(e)-.198 E(\(open-input-output-\214le)72 +562.2 Q F2(\214le)4.583 E F1 254.871(\)p)C -.198(ro)462.244 562.2 S(cedur).198 +E(e)-.198 E F0(See R)72 580.8 Q F4(4)97.971 575.3 Q F0(RS.)102.471 580.8 Q F2 +(\214le)72 595.8 Q F0 .199(can be a string as well as a symbol.)2.949 F F2 +(open-input-output-\214le)5.698 E F0 .198 +(opens the \214le for reading and writ-)2.948 F +(ing and returns an input-output port; the \214le must e)72 610.8 Q +(xist and is not truncated.)-.165 E F1(\(close-input-port)72 640.8 Q F2(port) +4.583 E F1 278.719(\)p)C -.198(ro)462.244 640.8 S(cedur).198 E(e)-.198 E +(\(close-output-port)72 655.8 Q F2(port)4.583 E F1 272.614(\)p)C -.198(ro) +462.244 655.8 S(cedur).198 E(e)-.198 E F0(See R)72 674.4 Q F4(4)97.971 668.9 Q +F0(RS.)102.471 674.4 Q .042(Calls to)72 689.4 R F2(close-input-port)2.792 E F0 +(and)2.792 E F2(close-output-port)2.792 E F0 .042 +(are ignored when applied to string ports or to ports)2.792 F +(connected with the standard input or standard output of the process.)72 704.4 +Q EP +%%Page: 18 18 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(8-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(clear)72 87 Q -.917(-output-port \))-.407 F +(pr)456.128 87 Q(ocedur)-.198 E(e)-.198 E(\(clear)72 102 Q(-output-port)-.407 E +/F2 11/Times-Italic@0 SF(output-port)4.583 E F1 240.637(\)p)C -.198(ro)462.244 +102 S(cedur).198 E(e)-.198 E F0(If the ar)72 120.6 Q(gument is omitted, it def) +-.198 E(aults to the current output port.)-.11 E .066(In case of `)72 135.6 R +(`b)-.814 E(uf)-.22 E(fered')-.275 E 2.815('o)-.814 G .065 +(utput, this procedure is used to discard all characters that ha)175.805 135.6 +R .395 -.165(ve b)-.22 H .065(een output).165 F(to the port b)72 150.6 Q(ut ha) +-.22 E .33 -.165(ve n)-.22 H +(ot yet been sent to the \214le associated with the port.).165 E F1 -.917 +(\(\215ush-output-port \))72 180.6 R(pr)456.128 180.6 Q(ocedur)-.198 E(e)-.198 +E(\(\215ush-output-port)72 195.6 Q F2(output-port)4.583 E F1 240.813(\)p)C +-.198(ro)462.244 195.6 S(cedur).198 E(e)-.198 E F0(If the ar)72 214.2 Q +(gument is omitted, it def)-.198 E(aults to the current output port.)-.11 E +.638(In case of `)72 229.2 R(`b)-.814 E(uf)-.22 E(fered')-.275 E 3.388('o)-.814 +G .639(utput, this procedure is used to force all characters that ha)178.095 +229.2 R .969 -.165(ve b)-.22 H .639(een output).165 F 1.174 +(to the port to be printed immediately)72 244.2 R 6.674(.T)-.715 G 1.173 +(his may be necessary to force output that is not termi-)255.8 244.2 R .14 +(nated with a ne)72 259.2 R .141(wline to appear on the terminal.)-.275 F .141 +(An output port is \215ushed automatically when it is)5.641 F(closed.)72 274.2 +Q F1(\(clear)72 304.2 Q -.917(-input-port \))-.407 F(pr)456.128 304.2 Q(ocedur) +-.198 E(e)-.198 E(\(clear)72 319.2 Q(-input-port)-.407 E F2(input-port)4.583 E +F1 252.242(\)p)C -.198(ro)462.244 319.2 S(cedur).198 E(e)-.198 E F0(If the ar) +72 337.8 Q(gument is omitted, it def)-.198 E(aults to the current input port.) +-.11 E 1.474(In case of `)72 352.8 R(`b)-.814 E(uf)-.22 E(fered')-.275 E 4.224 +('i)-.814 G 1.474(nput, this procedure discards all characters that ha)178.997 +352.8 R 1.803 -.165(ve a)-.22 H 1.473(lready been read).165 F 1.21 +(from the \214le associated with the port b)72 367.8 R 1.21(ut ha)-.22 F 1.54 +-.165(ve n)-.22 H 1.21(ot been processed using).165 F F2 -.407(re)3.96 G(ad) +.407 E F0 1.21(or similar proce-)3.96 F(dures.)72 382.8 Q F1 +(\(port-\214le-name)72 412.8 Q F2(port)4.583 E F1 286.672(\)p)C -.198(ro) +462.244 412.8 S(cedur).198 E(e)-.198 E F0 +(Returns the name of the \214le associated with)72 431.4 Q F2(port)2.75 E F0 +(if it is a \214le port, #f otherwise.)2.75 E F1 -.917(\(port-line-number \))72 +461.4 R(pr)456.128 461.4 Q(ocedur)-.198 E(e)-.198 E F0 .1(Returns the current \ +line number of a \214le input port or string input port, i.)72 480 R .099 +(e. the number of ne)1.833 F(wline)-.275 E .781(characters that ha)72 495 R +1.111 -.165(ve b)-.22 H .781(een read from this port plus one.).165 F -.814(``) +6.282 G(Unreading').814 E 3.532('an)-.814 G -.275(ew)400.103 495 S .782 +(line character decre-).275 F .58(ments the line number)72 510 R 3.33(,b)-.44 G +.58(ut it ne)182.736 510 R -.165(ve)-.275 G 3.33(rd).165 G .58(rops belo) +236.891 510 R 3.33(wo)-.275 G 3.33(ne. The)294.602 510 R .58 +(result of applying)3.33 F F2(port-line-number)3.329 E F0(to)3.329 E +(an output port is unde\214ned.)72 525 Q F1(\(tilde-expand)72 555 Q F2(\214le) +4.583 E F1 300.103(\)p)C -.198(ro)462.244 555 S(cedur).198 E(e)-.198 E F0(If)72 +573.6 Q F2(\214le)3.14 E F0 .39(starts with a tilde, performs tilde e)3.14 F +.39(xpansion as described abo)-.165 F .72 -.165(ve a)-.165 H .39 +(nd returns the result of the).165 F -.165(ex)72 588.6 S +(pansion \(a string\); returns).165 E F2(\214le)2.75 E F0(otherwise.)2.75 E F2 +(\214le)5.5 E F0(is a string or a symbol.)2.75 E F1(\(\214le-exists?)72 618.6 Q +F2(\214le)4.583 E F1 309.893(\)p)C -.198(ro)462.244 618.6 S(cedur).198 E(e) +-.198 E F0 .084(Returns #t if)72 637.2 R F2(\214le)2.834 E F0 .084 +(is accessible, #f otherwise.)2.834 F F2(\214le)5.584 E F0 .084 +(is a string or a symbol; tilde e)2.834 F .083(xpansion is not per)-.165 F(-) +-.22 E(formed.)72 652.2 Q EP +%%Page: 19 19 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(9-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(24. Input)72 87 R(\(r)72 117 Q -.917 +(ead \))-.198 F(pr)456.128 117 Q(ocedur)-.198 E(e)-.198 E(\(r)72 132 Q(ead) +-.198 E/F2 11/Times-Italic@0 SF(input-port)4.583 E F1 306.417(\)p)C -.198(ro) +462.244 132 S(cedur).198 E(e)-.198 E F0(See R)72 150.6 Q/F3 9/Times-Roman@0 SF +(4)97.971 145.1 Q F0(RS.)102.471 150.6 Q F1(\(r)72 180.6 Q -.917(ead-char \)) +-.198 F(pr)456.128 180.6 Q(ocedur)-.198 E(e)-.198 E(\(r)72 195.6 Q(ead-char) +-.198 E F2(input-port)4.583 E F1 281.37(\)p)C -.198(ro)462.244 195.6 S(cedur) +.198 E(e)-.198 E F0(See R)72 214.2 Q F3(4)97.971 208.7 Q F0(RS.)102.471 214.2 Q +F1(\(r)72 244.2 Q -.917(ead-string \))-.198 F(pr)456.128 244.2 Q(ocedur)-.198 E +(e)-.198 E(\(r)72 259.2 Q(ead-string)-.198 E F2(input-port)4.583 E F1 275.254 +(\)p)C -.198(ro)462.244 259.2 S(cedur).198 E(e)-.198 E F0(If the ar)72 277.8 Q +(gument is omitted, it def)-.198 E(aults to the current input port.)-.11 E(Ret\ +urns the rest of the current input line as a string \(not including the termin\ +ating ne)72 292.8 Q(wline\).)-.275 E F1(\(unr)72 322.8 Q(ead-char)-.198 E F2 +-.165(ch)4.583 G(ar).165 E F1 293.756(\)p)C -.198(ro)462.244 322.8 S(cedur).198 +E(e)-.198 E(\(unr)72 337.8 Q(ead-char)-.198 E F2 -.165(ch)4.583 G +(ar input-port).165 E F1 246.39(\)p)C -.198(ro)462.244 337.8 S(cedur).198 E(e) +-.198 E F0(If the second ar)72 356.4 Q(gument is omitted, it def)-.198 E +(aults to the current input port.)-.11 E(Pushes)72 371.4 Q F2 -.165(ch)3.531 G +(ar).165 E F0 .781(back on the stream of input characters.)3.531 F .781(It is) +6.281 F F2(not)3.531 E F0 .782(an error for)3.531 F F2 -.165(ch)3.532 G(ar).165 +E F0 .782(not to be the last)3.532 F .158(character read from the port.)72 +386.4 R .158 +(It is unde\214ned whether more than one character can be pushed back)5.658 F +.419(without an intermittent read operation, and whether a character can be pu\ +shed back before some-)72 401.4 R(thing has been read from the port.)72 416.4 Q +(The procedure returns)5.5 E F2 -.165(ch)2.75 G(ar).165 E F0(.)A F1 -.917 +(\(peek-char \))72 446.4 R(pr)456.128 446.4 Q(ocedur)-.198 E(e)-.198 E +(\(peek-char)72 461.4 Q F2(input-port)4.583 E F1 280.556(\)p)C -.198(ro)462.244 +461.4 S(cedur).198 E(e)-.198 E F0(See R)72 480 Q F3(4)97.971 474.5 Q F0(RS.) +102.471 480 Q F2(peek-c)72 498.6 Q(har)-.165 E F0(uses)2.75 E F2(unr)2.75 E +(ead-c)-.407 E(har)-.165 E F0(to push back the character)2.75 E(.)-.605 E F1 +(\(eof-object?)72 528.6 Q F2(obj)4.583 E F1 306.241(\)p)C -.198(ro)462.244 +528.6 S(cedur).198 E(e)-.198 E F0(See R)72 547.2 Q F3(4)97.971 541.7 Q F0(RS.) +102.471 547.2 Q F1(\(char)72 577.2 Q(-r)-.407 E(eady?)-.198 E F2(input-port) +4.583 E F1 270.777(\)p)C -.198(ro)462.244 577.2 S(cedur).198 E(e)-.198 E F0 +(See R)72 595.8 Q F3(4)97.971 590.3 Q F0(RS.)102.471 595.8 Q F2 -.165(ch)72 +614.4 S(ar).165 E(-r)-.22 E(eady)-.407 E F0 1.204 +(cannot be implemented correctly based on C FILE pointers.)3.954 F 1.203 +(In the current v)6.704 F(ersion,)-.165 E F2 -.165(ch)72 629.4 S(ar).165 E(-r) +-.22 E(eady)-.407 E F0(can return #f although a call to)2.75 E F2 -.407(re)2.75 +G(ad-c).407 E(har)-.165 E F0 -.11(wo)2.75 G(uld not block.).11 E F1 2.75 +(25. Output)72 659.4 R EP +%%Page: 20 20 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(0-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 334.023(print-length v)72 87 R(ariable)-.11 E +336.465(print-depth v)72 102 R(ariable)-.11 E F0 1.501(These v)72 120.6 R 1.501 +(ariables are de\214ned in the global en)-.275 F 4.252(vironment. The)-.44 F +4.252(yc)-.165 G 1.502(ontrol the maximum length and)359.271 120.6 R 1.622 +(maximum depth, respecti)72 135.6 R -.165(ve)-.275 G(ly).165 E 4.372(,o)-.715 G +4.372(fal)217.171 135.6 S 1.622(ist or v)237.52 135.6 R 1.621 +(ector that is printed.)-.165 F 1.621(If one of the v)7.121 F 1.621 +(ariables is not)-.275 F 1.654(bound to an inte)72 150.6 R(ger)-.165 E 4.404 +(,o)-.44 G 4.404(ri)174.25 150.6 S 4.404(fi)185.375 150.6 S 1.654(ts v)196.5 +150.6 R 1.654(alue e)-.275 F 1.654(xceeds a certain, lar)-.165 F 1.655 +(ge maximum v)-.198 F 1.655(alue \(which is at least)-.275 F .883 +(2^20\), a def)72 165.6 R .883(ault v)-.11 F .883(alue is tak)-.275 F 3.633 +(en. The)-.11 F(def)3.633 E .883(ault v)-.11 F .883(alue for)-.275 F/F2 11 +/Times-Italic@0 SF(print-length)3.632 E F0 .882(is 1000, and the def)3.632 F +.882(ault v)-.11 F(alue)-.275 E(for)72 180.6 Q F2(print-depth)3.183 E F0 .433 +(is 20.)3.183 F(Ne)5.933 E -.055(ga)-.165 G(ti).055 E .763 -.165(ve v)-.275 H +.433(alues of)-.11 F F2(print-length)3.183 E F0(and)3.183 E F2(print-depth) +3.183 E F0 .433(are treated as `)3.183 F(`unlimited')-.814 E(',)-.814 E -.917 +(i. e.)72 195.6 R(output is not truncated.)2.75 E F1(\(write)72 225.6 Q F2(obj) +4.583 E F1 333.73(\)p)C -.198(ro)462.244 225.6 S(cedur).198 E(e)-.198 E +(\(write)72 240.6 Q F2(obj output-port)4.583 E F1 280.864(\)p)C -.198(ro) +462.244 240.6 S(cedur).198 E(e)-.198 E F0(See R)72 259.2 Q/F3 9/Times-Roman@0 +SF(4)97.971 253.7 Q F0(RS.)102.471 259.2 Q F1(\(display)72 289.2 Q F2(obj)4.583 +E F1 324.534(\)p)C -.198(ro)462.244 289.2 S(cedur).198 E(e)-.198 E(\(display)72 +304.2 Q F2(obj output-port)4.583 E F1 271.668(\)p)C -.198(ro)462.244 304.2 S +(cedur).198 E(e)-.198 E F0(See R)72 322.8 Q F3(4)97.971 317.3 Q F0(RS.)102.471 +322.8 Q F1(\(write-char)72 352.8 Q F2 -.165(ch)4.583 G(ar).165 E F1 302.743 +(\)p)C -.198(ro)462.244 352.8 S(cedur).198 E(e)-.198 E(\(write-char)72 367.8 Q +F2 -.165(ch)4.583 G(ar output-port).165 E F1 249.877(\)p)C -.198(ro)462.244 +367.8 S(cedur).198 E(e)-.198 E F0(See R)72 386.4 Q F3(4)97.971 380.9 Q F0(RS.) +102.471 386.4 Q F1 -.917(\(newline \))72 416.4 R(pr)456.128 416.4 Q(ocedur) +-.198 E(e)-.198 E(\(newline)72 431.4 Q F2(output-port)4.583 E F1 286.045(\)p)C +-.198(ro)462.244 431.4 S(cedur).198 E(e)-.198 E F0(See R)72 450 Q F3(4)97.971 +444.5 Q F0(RS.)102.471 450 Q F1(\(print)72 480 Q F2(obj)4.583 E F1 334.324(\)p) +C -.198(ro)462.244 480 S(cedur).198 E(e)-.198 E(\(print)72 495 Q F2 +(obj output-port)4.583 E F1 281.458(\)p)C -.198(ro)462.244 495 S(cedur).198 E +(e)-.198 E F0(If the second ar)72 513.6 Q(gument is omitted, it def)-.198 E +(aults to the current output port.)-.11 E(Prints)72 528.6 Q F2(obj)2.75 E F0 +(using)2.75 E F2(write)2.75 E F0(and then prints a ne)2.75 E(wline.)-.275 E F2 +(print)5.5 E F0(returns)2.75 E F2(void)2.75 E F0(.)A F1(\(f)72 558.6 Q(ormat) +-.275 E F2(destination format-string obj ...)4.583 E F1 201.994(\)p)C -.198(ro) +462.244 558.6 S(cedur).198 E(e)-.198 E F0 .774(Prints the third and the follo) +72 577.2 R .774(wing ar)-.275 F .774 +(guments according to the speci\214cations in the string)-.198 F F2(format-) +3.523 E(string)72 592.2 Q F0 5.615(.C)C .115 +(haracters from the format string are copied to the output.)113.376 592.2 R +.116(When a tilde is encountered in)5.615 F .672 +(the format string, the tilde and the immediately follo)72 607.2 R .671 +(wing character are replaced in the output as)-.275 F(follo)72 622.2 Q(ws:) +-.275 E 14.308(~s is)72 640.8 R +(replaced by the printed representation of the ne)2.75 E(xt)-.165 E F2(obj)2.75 +E F0(in the sense of)2.75 E F2(write)2.75 E F0(.)A 13.703(~a is)72 659.4 R +(replaced by the printed representation of the ne)2.75 E(xt)-.165 E F2(obj)2.75 +E F0(in the sense of)2.75 E F2(display)2.75 E F0(.)A 14.924(~~ is)72 678 R +(replaced by a single tilde.)2.75 E 9.424(~% is)72 696.6 R(replaced by a ne) +2.75 E(wline.)-.275 E .029(An error is signaled if fe)72 715.2 R(wer)-.275 E F2 +(obj)2.78 E F0 2.78(sa)C .03(re pro)224.974 715.2 R .03 +(vided than required by the gi)-.165 F -.165(ve)-.275 G 2.78(nf).165 G .03 +(ormat string.)399.622 715.2 R .03(If the for)5.53 F(-)-.22 E +(mat string ends in a tilde, the tilde is ignored.)72 730.2 Q EP +%%Page: 21 21 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(1-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(If)72 87 Q/F1 11/Times-Italic@0 SF(destination)4.716 E F0 1.966 +(is #t, the output is sent to the current output port; if #f is gi)4.716 F +-.165(ve)-.275 G 1.966(n, the output is).165 F +(returned as a string; otherwise,)72 102 Q F1(destination)2.75 E F0 +(must be an output or input-output port.)2.75 E(Examples:)72 117 Q/F2 10 +/Courier@0 SF(\(format #f "Hello world!"\))100.346 139.503 Q 6(==> "Hello) +298.346 139.503 R(world")6 E(\(format #f "~s world!" "Hello"\))100.346 153.503 +Q 6(==> "\\"Hello\\")298.346 153.503 R(world")6 E +(\(format #f "~a world!" "Hello"\))100.346 167.503 Q 6(==> "Hello)298.346 +167.503 R(world")6 E(\(format #f "Hello~a"\))100.346 181.503 Q 6(==> "Hello!") +298.346 181.503 R(\(define \(flat-size s\))100.346 211.006 Q +(\(fluid-let \(\(print-length 1000\) \(print-depth 100\)\))112.346 225.006 Q +(\(string-length \(format #f "~a" s\)\)\)\))124.346 239.006 Q +(\(flat-size 1.5\))100.346 268.509 Q 6(==> 3)298.346 268.509 R +(\(flat-size '\(a b c\)\))100.346 282.509 Q 6(==> 7)298.346 282.509 R/F3 11 +/Times-Bold@0 SF 2.75(26. String)72 319.509 R -.22(Po)2.75 G(rts).22 E F0 1.482 +(String ports are similar to \214le ports, e)72 338.109 R 1.482 +(xcept that characters are appended to a string instead of)-.165 F .414 +(being sent to a \214le, or tak)72 353.109 R .413 +(en from a string instead of being read from a \214le.)-.11 F .413 +(It is not necessary to)5.913 F .848(close string ports.)72 368.109 R .849 +(When an string input port has reached the end of the input string, successi) +6.349 F -.165(ve)-.275 G(read operations return end-of-\214le.)72 383.109 Q F3 +(\(open-input-string)72 413.109 Q F1(string)4.583 E F3 264.034(\)p)C -.198(ro) +462.244 413.109 S(cedur).198 E(e)-.198 E F0(Returns a ne)72 431.709 Q 2.75(ws) +-.275 G(tring input port initialized with)141.685 431.709 Q F1(string)2.75 E F0 +(.)A(Examples:)72 446.709 Q F2 +(\(define p \(open-input-string "Hello world!"\)\))100.346 469.212 Q +(\(read-char p\))100.346 483.212 Q 6(==> #\\H)298.346 483.212 R(\(read p\)) +100.346 497.212 Q 6(==> ello)298.346 497.212 R(\(read p\))100.346 511.212 Q 6 +(==> world!)298.346 511.212 R(\(read p\))100.346 525.212 Q(==>)298.346 525.212 +Q/F4 10/Times-Italic@0 SF(end of \214le)328.346 525.212 Q F2 +(\(define p \(open-input-string "\(cons 'a 'b\)"\)\))100.346 554.715 Q +(\(eval \(read p\)\))100.346 568.715 Q 6(==> \(a)298.346 568.715 R 6(.b)6 G(\)) +364.346 568.715 Q F3 -.917(\(open-output-string \))72 605.715 R(pr)456.128 +605.715 Q(ocedur)-.198 E(e)-.198 E F0(Returns a ne)72 624.315 Q 2.75(ws)-.275 G +(tring output port.)141.685 624.315 Q F3(\(get-output-string)72 654.315 Q F1 +(string-output-port)4.583 E F3 212.719(\)p)C -.198(ro)462.244 654.315 S(cedur) +.198 E(e)-.198 E F0 .566(Returns the string currently associated with the spec\ +i\214ed string output port.)72 672.915 R .565(As a side-ef)6.065 F .565 +(fect, the)-.275 F(string is reset to zero length.)72 687.915 Q(Examples:)72 +702.915 Q EP +%%Page: 22 22 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(2-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(define p \(open-output-string\)\))100.346 +94.503 Q(\(display '\(a b c\) p\))100.346 108.503 Q(\(get-output-string p\)) +100.346 122.503 Q 6(==> "\(a)298.346 122.503 R 6(bc)6 G(\)")370.346 122.503 Q +(\(get-output-string p\))100.346 136.503 Q 6(==> "")298.346 136.503 R +(\(define \(flat-size s\))100.346 166.006 Q +(\(let \(\(p \(open-output-string\)\)\))112.346 180.006 Q(\(display s p\)) +124.346 194.006 Q(\(string-length \(get-output-string p\)\)\)\))124.346 208.006 +Q/F2 11/Times-Bold@0 SF 2.75(27. Loading)72 245.006 R(\(load)72 275.006 Q/F3 11 +/Times-Italic@0 SF(\214le)4.583 E F2 338.603(\)p)C -.198(ro)462.244 275.006 S +(cedur).198 E(e)-.198 E(\(load)72 290.006 Q F3(\214le en)4.583 E(vir)-.44 E +(onment)-.495 E F2 281.799(\)p)C -.198(ro)462.244 290.006 S(cedur).198 E(e) +-.198 E F0 .197(Loads a source \214le or one or more object \214les.)72 308.606 +R .197(If the \214le contains source code, the e)5.697 F .198(xpressions in) +-.165 F 1.379(the \214le are read and e)72 323.606 R -.275(va)-.275 G 4.129 +(luated. If).275 F 4.129<618c>4.129 G 1.379 +(le contains object code, the contents of the \214le is link)246.208 323.606 R +(ed)-.11 E .021(together with the running interpreter and with additional libr\ +aries that are speci\214ed by the v)72 338.606 R(ariable)-.275 E F3(load-libr) +72 353.606 Q(aries)-.165 E F0(\(see belo)2.75 E 2.75(w\). Names)-.275 F +(of object \214les must ha)2.75 E .33 -.165(ve t)-.22 H(he suf).165 E(\214x `) +-.275 E(`.o')-.814 E('.)-.814 E F3(load)5.5 E F0(returns)2.75 E F3(void)2.75 E +F0(.)A F3(\214le)72 372.206 Q F0 .158 +(must be either a string or a symbol or a list of strings or symbols.)2.908 F +.157(If it is a list, all elements of)5.658 F .208 +(the list must be the names of object \214les.)72 387.206 R .208 +(In this case, all object \214les are link)5.708 F .209(ed by a single run of) +-.11 F(the link)72 402.206 Q(er)-.11 E(.)-.605 E 1.228(If an optional)72 +417.206 R F3(en)3.978 E(vir)-.44 E(onment)-.495 E F0 1.227 +(is speci\214ed, the contents of the \214le is e)3.978 F -.275(va)-.275 G 1.227 +(luated in this en).275 F(vironment)-.44 E(instead of the current en)72 432.206 +Q(vironment.)-.44 E 1.373 +(Loading of object \214les is not supported on some platforms.)72 450.806 R +1.374(On the platforms where it is sup-)6.874 F 2.675(ported, the feature)72 +465.806 R F3(elk:load-object)5.425 E F0 2.675(is pro)5.425 F 2.674 +(vided by the interpreter on startup \(see `)-.165 F(`Features')-.814 E(')-.814 +E(belo)72 480.806 Q(w\).)-.275 E(Example:)72 495.806 Q F1 +(\(fluid-let \(\(load-noisily? #t\)\))100.346 518.309 Q(\(load 'test.scm\)\)) +112.346 532.309 Q F2 345.628(load-path v)72 569.309 R(ariable)-.11 E F0 .004 +(This v)72 587.909 R .004(ariable is de\214ned in the global en)-.275 F 2.754 +(vironment. It)-.44 F .004(is bound to a list of directories in which \214les) +2.754 F .569(to be loaded are searched for)72 602.909 R 6.069(.E)-.605 G .569 +(ach element of the list \(a string or a symbol\) is used in turn as a)216.533 +602.909 R .228(pre\214x for the \214le name passed to)72 617.909 R F3(load) +2.979 E F0 .229(until opening succeeds.)2.979 F .229(Elements of)5.729 F F3 +(load-path)2.979 E F0 .229(that are not)2.979 F +(of type string or symbol are ignored.)72 632.909 Q .483(If the v)72 651.509 R +.483(alue of)-.275 F F3(load-path)3.233 E F0 .483 +(is not a list of at least one v)3.233 F .483 +(alid component, or if the name of the \214le to)-.275 F +(be loaded starts with `)72 666.509 Q(`/')-.814 E 2.75('o)-.814 G 2.75(rw) +189.821 666.509 S(ith `)204.176 666.509 Q(`~')-.814 E(', it is opened directly) +-.814 E(.)-.715 E 2.231(The initial v)72 685.109 R 2.231(alue of)-.275 F F3 +(load-path)4.981 E F0 2.231(is a list of the three elements `)4.981 F(`.)-.814 +E 3.859 -.814('' \()-.77 H -.917(i. e.).814 F 2.231(the current directory\),) +4.981 F -.814(``)72 700.109 S($scheme_dir').814 E .351(', and `)-.814 F +(`$lib_dir')-.814 E .351 +('; $scheme_dir and $lib_dir are the directories into which the run-)-.814 F +5.783(time Scheme \214les and object \214les are installed \(typically `)72 +715.109 R(`/usr/elk/runtime/scm')-.814 E 8.534('a)-.814 G(nd)493 715.109 Q +-.814(``)72 730.109 S(/usr/elk/runtime/obj').814 E +('; de\214ned in the installation')-.814 E 2.75(ss)-.605 G(ite \214le\).) +304.122 730.109 Q EP +%%Page: 23 23 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(3-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 330.954(load-noisily? v)72 87 R(ariable)-.11 +E F0 .796(This v)72 105.6 R .795(ariable is de\214ned in the global en)-.275 F +3.545(vironment. When)-.44 F 3.545<618c>3.545 G .795(le is loaded and the v) +349.319 105.6 R .795(alue of)-.275 F/F2 11/Times-Italic@0 SF(load-)3.545 E +(noisily?)72 120.6 Q F0 1.532(is true, the result of the e)4.282 F -.275(va) +-.275 G 1.532(luation of each e).275 F 1.532(xpression is printed.)-.165 F +1.533(The initial v)7.033 F 1.533(alue of)-.275 F F2(load-noisily?)72 135.6 Q +F0(is #f.)2.75 E F1 327.302(load-libraries v)72 165.6 R(ariable)-.11 E F0 .319 +(This v)72 184.2 R .318(ariable is de\214ned in the global en)-.275 F 3.068 +(vironment. If)-.44 F F2(load-libr)3.068 E(aries)-.165 E F0 .318 +(is bound to a string, its v)3.068 F(alue)-.275 E .884 +(speci\214es additional load libraries to be link)72 199.2 R .884 +(ed together with an object \214le that is loaded into the)-.11 F +(interpreter \(see)72 214.2 Q F2(load)2.75 E F0(abo)2.75 E -.165(ve)-.165 G +2.75(\). Its).165 F(initial v)2.75 E(alue is `)-.275 E(`\255lc')-.814 E('.) +-.814 E F1(\(autoload)72 244.2 Q F2(symbol \214le)4.583 E F1 283.911(\)p)C +-.198(ro)462.244 244.2 S(cedur).198 E(e)-.198 E F0(Binds)72 262.8 Q F2(symbol) +4.436 E F0 1.686(in the current en)4.436 F 1.686(vironment \(as with)-.44 F F2 +(de\214ne)4.436 E F0 4.436(\). When)B F2(symbol)4.436 E F0 1.686(is e)4.436 F +-.275(va)-.275 G 1.686(luated the \214rst).275 F(time,)72 277.8 Q F2(\214le) +3.159 E F0 .409(is loaded.)3.159 F .41 +(The de\214nitions loaded from the \214le must pro)5.909 F .41 +(vide a de\214nition for)-.165 F F2(symbol)3.16 E F0(dif-)3.16 E(ferent from)72 +292.8 Q F2(autoload)2.75 E F0 2.75(,o)C(therwise an error is signaled.)174.652 +292.8 Q F2(\214le)72 311.4 Q F0 .564(must be either a string or a symbol or a \ +list of strings or symbols, in which case all elements)3.315 F +(of the list must be the names of object \214les \(see)72 326.4 Q F2(load)2.75 +E F0(abo)2.75 E -.165(ve)-.165 G(\).).165 E F1 313.244(autoload-notify? v)72 +356.4 R(ariable)-.11 E F0 .195(This v)72 375 R .195 +(ariable is de\214ned in the global en)-.275 F 2.945(vironment. If)-.44 F .195 +(the v)2.945 F .195(alue of)-.275 F F2(autoload-notify?)2.945 E F0 .195 +(is true, a mes-)2.945 F .114(sage is printed whene)72 390 R -.165(ve)-.275 G +2.864(re).165 G -.275(va)188.429 390 S .114 +(luation of a symbol triggers autoloading of a \214le.).275 F F2 +(autoload-notify?)5.613 E F0(is)2.863 E(bound to #t initially)72 405 Q(.)-.715 +E F1 2.75(28. Macr)72 435 R(os)-.198 E(\(macr)72 465 Q(o)-.198 E F2 +(formals body)4.583 E F1 302.05(\)s)C(yntax)477.721 465 Q F0 .867 +(This special form creates a macro.)72 483.6 R .867 +(The syntax is identical to the syntax of)6.367 F F2(lambda)3.618 E F0 -.165 +(ex)3.618 G(pressions.).165 E 1.223(When a macro is called, the actual ar)72 +498.6 R 1.223(guments are bound to the formal ar)-.198 F 1.223(guments of the) +-.198 F F2(macr)3.972 E(o)-.495 E F0 -.165(ex)72 513.6 S(pression).165 E F2 +1.095(in the curr)3.845 F 1.095(ent en)-.407 F(vir)-.44 E(onment)-.495 E F0 +(\(the)3.845 E 3.845(ya)-.165 G(re)277.307 513.6 Q F2(not)3.845 E F0 -.275(eva) +3.845 G 1.095(luated\), then the).275 F F2(body)3.845 E F0 1.095(is e)3.845 F +-.275(va)-.275 G 3.846(luated. The).275 F .382(result of this e)72 528.6 R +-.275(va)-.275 G .382(luation is considered the).275 F F2(macr)3.132 E 3.132 +(oe)-.495 G(xpansion)292.538 528.6 Q F0 .382(and is e)3.132 F -.275(va)-.275 G +.382(luated in place of the macro).275 F(call.)72 543.6 Q F1(\(de\214ne-macr)72 +573.6 Q(o)-.198 E F2(\(variable formals\) body)4.583 E F1 223.532(\)s)C(yntax) +477.721 573.6 Q(\(de\214ne-macr)72 588.6 Q(o)-.198 E F2 +(\(variable . formal\) body)4.583 E F1 222.311(\)s)C(yntax)477.721 588.6 Q F0 +(Lik)72 607.2 Q(e)-.11 E F2(de\214ne)2.75 E F0 2.75(,e)C(xcept that)131.29 +607.2 Q F2(macr)2.75 E(o)-.495 E F0(is used instead of)2.75 E F2(lambda)2.75 E +F0(.)A(Examples:)72 622.2 Q/F3 10/Courier@0 SF +(\(define-macro \(++ x\) `\(set! ,x \(1+ ,x\)\)\))100.346 644.703 Q +(\(define foo 5\))100.346 658.703 Q 60(foo ==>)100.346 672.703 R(5)214.346 +672.703 Q(\(++ foo\))100.346 686.703 Q 60(foo ==>)100.346 700.703 R(6)214.346 +700.703 Q EP +%%Page: 24 24 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(4-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(define-macro \(while test . body\))100.346 +94.503 Q(`\(let loop \(\))112.346 108.503 Q +(\(cond \(,test ,@body \(loop\)\)\)\)\))130.346 122.503 Q/F2 11/Times-Bold@0 SF +(\(macr)72 159.503 Q(o?)-.198 E/F3 11/Times-Italic@0 SF(obj)4.583 E F2 322.928 +(\)p)C -.198(ro)462.244 159.503 S(cedur).198 E(e)-.198 E F0(Returns #t if)72 +178.103 Q F3(obj)2.75 E F0(is a macro, #f otherwise.)2.75 E F2(\(macr)72 +208.103 Q(o-body)-.198 E F3(macr)4.583 E(o)-.495 E F2 287.981(\)p)C -.198(ro) +462.244 208.103 S(cedur).198 E(e)-.198 E F0 1.607(Returns a cop)72 226.703 R +4.357(yo)-.11 G 4.357(ft)150.95 226.703 S(he)162.028 226.703 Q F3(macr)4.357 E +(o)-.495 E F0 -.165(ex)4.357 G 1.607(pression which has been e).165 F -.275(va) +-.275 G 1.608(luated to created the gi).275 F -.165(ve)-.275 G 4.358(nm).165 G +(acro)485.069 226.703 Q(\(similar to)72 241.703 Q F3(pr)2.75 E(ocedur)-.495 E +(e-lambda)-.407 E F0(\).)A(Examples:)72 256.703 Q F1 +(\(define-macro \(++ x\) `\(set! ,x \(1+ ,x\)\)\))100.346 279.206 Q +(\(macro-body ++\))100.346 307.206 Q 6(==> \(macro)112.346 321.206 R +(\(x\) \(quasiquote \(set! \(unquote x\) \(1+ \(unquote x\)\)\)\)\))6 E F2 +(\(macr)72 358.206 Q(o-expand)-.198 E F3(list)4.583 E F2 291.138(\)p)C -.198 +(ro)462.244 358.206 S(cedur).198 E(e)-.198 E F0(If the e)72 376.806 Q +(xpression)-.165 E F3(list)2.75 E F0(is a macro call, the macro call is e)2.75 +E(xpanded.)-.165 E(Examples:)72 391.806 Q F1 +(\(define-macro \(++ x\) `\(set! ,x \(1+ ,x\)\)\))100.346 414.309 Q +(\(macro-expand '\(++ foo\)\))100.346 442.309 Q 6(==> \(set!)298.346 442.309 R +(foo \(1+ foo\)\))6 E F0 .119(The follo)72 479.309 R .119 +(wing function can be used to e)-.275 F(xpand)-.165 E F3(all)2.869 E F0 .119 +(macro calls in an e)2.869 F .118(xpression, i.)-.165 F .118 +(e. not only at the)1.833 F(outermost le)72 494.309 Q -.165(ve)-.275 G(l:).165 +E F1(\(define \(expand form\))100.346 516.812 Q +(\(if \(or \(not \(pair? form\)\) \(null? form\)\))112.346 530.812 Q(form) +136.346 544.812 Q(\(let \(\(head \(expand \(car form\)\)\))136.346 558.812 Q +(\(args \(expand \(cdr form\)\)\))172.346 572.812 Q(\(result\)\))172.346 +586.812 Q(\(if \(and \(symbol? head\) \(bound? head\)\))148.346 600.812 Q +(\(begin)172.346 614.812 Q(\(set! result \(macro-expand \(cons head args\)\)\)) +184.346 628.812 Q(\(if \(not \(equal? result form\)\))184.346 642.812 Q +(\(expand result\))208.346 656.812 Q(result\)\))208.346 670.812 Q +(\(cons head args\)\)\)\)\))184.346 684.812 Q EP +%%Page: 25 25 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(5-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(29. Err)72 87 R +(or and Exception Handling)-.198 E(err)72 117 Q(or)-.198 E 326.092(-handler v) +-.407 F(ariable)-.11 E F0 .6(This v)72 135.6 R .6 +(ariable is de\214ned in the global en)-.275 F 3.35(vironment. When)-.44 F .601 +(an error occurs or when the procedure)3.35 F/F2 11/Times-Italic@0 SF(err)72 +150.6 Q(or)-.495 E F0 .164(is in)2.914 F -.22(vo)-.44 G -.11(ke).22 G 2.914(da) +.11 G .164(nd the v)150.361 150.6 R(ariable)-.275 E F2(err)2.913 E(or)-.495 E +(-handler)-.22 E F0 .163(is bound to a compound procedure \(the)2.913 F F2(err) +2.913 E .163(or han-)-.495 F(dler)72 165.6 Q F0 .299(\), the interpreter in)B +-.22(vo)-.44 G -.11(ke).22 G 3.049(st).11 G .299(his procedure.)204.096 165.6 R +.299(The error handler is called with an object \(either the)5.799 F .748 +(\214rst ar)72 180.6 R .747(gument that has been passed to)-.198 F F2(err)3.497 +E(or)-.495 E F0 .747(or a symbol identifying the primiti)3.497 F 1.077 -.165 +(ve p)-.275 H .747(rocedure that).165 F .256(has caused the error\), and an er\ +ror message consisting of a format string and a list of objects suit-)72 195.6 +R(able to be passed to)72 210.6 Q F2(format)2.75 E F0(.)A -.88(Ty)72 229.2 S +(pically).88 E 3.2(,au)-.715 G(ser)132.102 229.2 Q .449(-de\214ned error handl\ +er prints the error message and then calls a control point that)-.22 F 1.09 +(has been created outside the error handler)72 244.2 R 6.59(.I)-.605 G 3.84(ft) +274.209 244.2 S 1.09(he error handler terminates normally or if)284.77 244.2 R +F2(err)3.841 E(or)-.495 E(-)-.22 E(handler)72 259.2 Q F0 .056 +(is not bound to a procedure, the error message is printed in a def)2.806 F +.056(ault w)-.11 F(ay)-.11 E 2.806(,a)-.715 G .056(nd then a)439.779 259.2 R F2 +-.407(re)2.806 G(set).407 E F0(is performed.)72 274.2 Q F1 307.139 +(interrupt-handler v)72 304.2 R(ariable)-.11 E F0 .15(This v)72 322.8 R .15 +(ariable is de\214ned in the global en)-.275 F 2.9(vironment. When)-.44 F .15 +(an interrupt occurs \(typically as a result)2.9 F .038 +(of typing the interrupt character on the k)72 337.8 R -.165(ey)-.11 G .038 +(board\), and the v).165 F(ariable)-.275 E F2(interrupt-handler)2.788 E F0 .038 +(is bound to a)2.788 F 2.741(procedure \(the)72 352.8 R F2 2.741 +(interrupt handler)5.491 F F0 2.742(\), this procedure is called with no ar)B +5.492(guments. If)-.198 F F2(interrupt-)5.492 E(handler)72 367.8 Q F0 .199 +(is not bound to a procedure or if the procedure terminates normally)2.949 F +2.948(,am)-.715 G .198(essage is printed,)428.144 367.8 R(and a)72 382.8 Q F2 +-.407(re)2.75 G(set).407 E F0(is performed.)2.75 E(Examples:)72 397.8 Q/F3 10 +/Courier@0 SF(\(set! interrupt-handler)100.346 420.303 Q(\(lambda \(\))112.346 +434.303 Q(\(newline\))124.346 448.303 Q(\(backtrace\))124.346 462.303 Q +(\(reset\)\)\))124.346 476.303 Q F1 -.917(\(disable-interrupts \))72 513.303 R +(pr)456.128 513.303 Q(ocedur)-.198 E(e)-.198 E -.917(\(enable-interrupts \))72 +528.303 R(pr)456.128 528.303 Q(ocedur)-.198 E(e)-.198 E F2(disable-interrupts) +72 546.903 Q F0 .521(causes signals to be block)3.271 F .522(ed from deli)-.11 +F -.165(ve)-.275 G .522(ry to the interpreter;).165 F F2(enable-interrupts) +3.272 E F0 .303(enables deli)72 561.903 R -.165(ve)-.275 G .303(ry of signals.) +.165 F .303(These functions control deli)5.803 F -.165(ve)-.275 G .303(ry of k) +.165 F -.165(ey)-.11 G .302(board-generated interrupt sig-).165 F 1.126 +(nals \(see)72 576.903 R F2(interrupt-handler)3.876 E F0(abo)3.876 E -.165(ve) +-.165 G 3.876(\)a).165 G 3.876(sw)234.42 576.903 S 1.127 +(ell as additional signals used by e)250.517 576.903 R 1.127 +(xtensions \(such as the)-.165 F .597(alarm signal\).)72 591.903 R .597 +(The interpreter automatically blocks deli)6.097 F -.165(ve)-.275 G .596 +(ry of signals during critical operations,).165 F(such as g)72 606.903 Q +(arbage collection.)-.055 E +(Signals are enabled on startup after initialization has completed.)5.5 E 3.99 +(Ac)72 625.503 S 1.24(all to)88.816 625.503 R F2(enable-interrupts)3.99 E F0 +1.24(immediately deli)3.99 F -.165(ve)-.275 G 1.24(rs signals that ha).165 F +1.57 -.165(ve b)-.22 H 1.24(een generated while signals).165 F 1.577 +(were disabled, b)72 640.503 R 1.577(ut block)-.22 F 1.577 +(ed signals are not queued.)-.11 F 1.577 +(On platforms that support neither POSIX-)7.077 F .94 +(style nor BSD-style reliable signals,)72 655.503 R F2(disable-interrupts)3.69 +E F0 .94(causes signals to be ignored \(as opposed)3.69 F +(to blocking them until the ne)72 670.503 Q(xt call to)-.165 E F2 +(enable-interrupts)2.75 E F0(\).)A .966(Calls to)72 689.103 R F2 +(disable-interrupts)3.716 E F0(and)3.716 E F2(enable-interrupts)3.716 E F0 .966 +(can be nested.)3.716 F .966(The functions maintain a count)6.466 F 1.045 +(indicating the number of calls to)72 704.103 R F2(enable-interrupts)3.795 E F0 +1.046(that it tak)3.795 F 1.046(es to return from a nested)-.11 F F2(disable-) +3.796 E(interrupts)72 719.103 Q F0(in)3.125 E -.22(vo)-.44 G .374 +(cation to the topmost le).22 F -.165(ve)-.275 G 3.124(l\().165 G -.917(i. e.) +261.982 719.103 R .374(to actually enable deli)3.124 F -.165(ve)-.275 G .374 +(ry of signals ag).165 F 3.124(ain\). Both)-.055 F +(functions return this nesting le)72 734.103 Q -.165(ve)-.275 G 2.75(la).165 G +2.75(sa)226.462 734.103 S 2.75(ni)238.375 734.103 S(nte)249.683 734.103 Q(ger) +-.165 E(.)-.605 E EP +%%Page: 26 26 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(6-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL .613(Example: the follo)72 87 R .613(wing loop ensures that deli) +-.275 F -.165(ve)-.275 G .614(ry of signals is enabled, re).165 F -.055(ga) +-.165 G .614(rdless of the current).055 F(nesting depth of)72 102 Q/F1 11 +/Times-Italic@0 SF(disable-interrupts)2.75 E F0(calls:)2.75 E/F2 10/Courier@0 +SF(\(let loop \(\(intr-level \(enable-interrupts\)\)\))100.346 124.503 Q +(\(if \(positive? intr-level\))130.346 138.503 Q +(\(loop \(enable-interrupts\)\)\)\))154.346 152.503 Q F1(dynamic-wind)72 +192.103 Q F0 .001(can be used to write a macro)2.751 F F1 +(with-interrupts-disabled)2.751 E F0(to protect a critical section of)2.75 E +(code from being interrupted by a signal:)72 207.103 Q F2 +(\(define-macro \(with-interrupts-disabled . body\))100.346 229.606 Q +(`\(dynamic-wind)112.346 243.606 Q(\(lambda \(\) \(disable-interrupts\)\)) +130.346 257.606 Q(\(lambda \(\) ,@body\))130.346 271.606 Q +(\(lambda \(\) \(enable-interrupts\)\)\)\))130.346 285.606 Q/F3 11/Times-Bold@0 +SF(\(err)72 322.606 Q(or)-.198 E F1(obj string obj ...)4.583 E F3 277.091(\)p)C +-.198(ro)462.244 322.606 S(cedur).198 E(e)-.198 E F0(Signals an error)72 +341.206 Q 5.5(.T)-.605 G(he ar)156.018 341.206 Q(guments of)-.198 E F1(err)2.75 +E(or)-.495 E F0(are passed to the)2.75 E F1(err)2.75 E(or)-.495 E(-handler)-.22 +E F0(.)A(Examples:)72 356.206 Q F2(\(define \(foo sym\))100.346 378.709 Q +(\(if \(not \(symbol? sym\)\))112.346 392.709 Q +(\(error 'foo "argument not a symbol: ~s" sym\)\))136.346 406.709 Q(...)112.346 +420.709 Q F3(top-le)72 457.709 Q -.11(ve)-.165 G(l-contr).11 E 285.623 +(ol-point v)-.198 F(ariable)-.11 E(\(r)72 472.709 Q -.917(eset \))-.198 F(pr) +456.128 472.709 Q(ocedur)-.198 E(e)-.198 E F1 -.407(re)72 491.309 S(set).407 E +F0 .576(performs a reset by calling the control point to which the v)3.326 F +(ariable)-.275 E F1(top-le)3.327 E(vel-contr)-.165 E(ol-point)-.495 E F0(is) +3.327 E .725(bound in the global en)72 506.309 R 3.475(vironment. The)-.44 F +.725(control point is called with the ar)3.475 F .725(gument #t.)-.198 F(If) +6.225 E F1(top-le)3.475 E(vel-)-.165 E(contr)72 521.309 Q(ol-point)-.495 E F0 +.714(is not bound to a control point, or does not e)3.464 F .715 +(xist at all, an error message is printed)-.165 F +(and the interpreter is terminated.)72 536.309 Q(Examples:)72 551.309 Q F2 +(\(if \(call-with-current-continuation)100.346 573.812 Q(\(lambda \(x\))136.346 +587.812 Q(\(fluid-let \(\(top-level-control-point x\)\))148.346 601.812 Q/F4 10 +/Times-Italic@0 SF 2.5(do something)160.346 615.812 R F2(#f\)\)\))160.346 +629.812 Q(\(print "Got a reset!"\)\))124.346 643.812 Q F3 -.917(\(exit \))72 +680.812 R(pr)456.128 680.812 Q(ocedur)-.198 E(e)-.198 E(\(exit)72 695.812 Q F1 +(n)4.583 E F3 349.614(\)p)C -.198(ro)462.244 695.812 S(cedur).198 E(e)-.198 E +F0 -.77(Te)72 714.412 S(rminates the interpreter).77 E 5.5(.T)-.605 G +(he optional ar)199.842 714.412 Q(gument)-.198 E F1(n)2.75 E F0 +(indicates the e)2.75 E(xit code; it def)-.165 E(aults to zero.)-.11 E EP +%%Page: 27 27 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(7-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(30. Garbage)72 87 R(Collection)2.75 E F0 +.143(The interpreter supports tw)72 105.6 R 2.893(og)-.11 G .143 +(arbage collectors: the stop-and-cop)205.606 105.6 R 2.893(yg)-.11 G .142 +(arbage collector that w)374.027 105.6 R .142(as part)-.11 F(of older v)72 +120.6 Q(ersions of Elk, and a generational, incremental g)-.165 E +(arbage collector)-.055 E(.)-.605 E .834(If generational g)72 139.2 R .835 +(arbage collection has been selected, Scheme objects survi)-.055 F .835 +(ving tw)-.275 F 3.585(og)-.11 G .835(arbage col-)453.995 139.2 R .156 +(lections will not be touched ag)72 154.2 R .156 +(ain until there is only a certain amount of memory left on the heap,)-.055 F +1.359(triggering a full g)72 169.2 R 1.359(arbage collection.)-.055 F -.165(Pa) +6.859 G 1.359(rticularly in applications with lar).165 F 1.36 +(ge amounts of Scheme)-.198 F .041(code or constant data, partial g)72 184.2 R +.041(arbage collections run much f)-.055 F .04(aster than full g)-.11 F .04 +(arbage collections.)-.055 F(In)5.54 E .846(contrast to the stop-and-cop)72 +199.2 R 3.597(yg)-.11 G .847(arbage collector)211.477 199.2 R 3.597(,t)-.44 G +.847(he generational g)291.843 199.2 R .847(arbage collector is not limited) +-.055 F .621(to a pre-allocated amount of heap; it will e)72 214.2 R .621 +(xpand the heap in steps of 1 MB if the free space left)-.165 F(after a full g) +72 229.2 Q(arbage collection f)-.055 E(alls belo)-.11 E 2.75(wac)-.275 G +(ertain amount.)267.668 229.2 Q 1.244(Another feature of the generational g)72 +247.8 R 1.244(arbage collector \(a)-.055 F -.275(va)-.22 G 1.245 +(ilable on some platforms only\) is the).275 F .738 +(ability to do incremental g)72 262.8 R .738(arbage collection.)-.055 F .738 +(Starting a g)6.238 F .737(arbage collection does not interrupt the)-.055 F .55 +(application until the g)72 277.8 R .55(arbage collector is done.)-.055 F .551 +(Instead, the collector returns control to the appli-)6.051 F .088 +(cation almost immediately)72 292.8 R 5.588(.T)-.715 G 2.838(os)202.361 292.8 S +.088(ynchronize between the g)214.978 292.8 R .087 +(arbage collection and the running appli-)-.055 F(cation, the code mak)72 307.8 +Q(es use of the)-.11 E/F2 11/Times-Italic@0 SF(mpr)2.75 E(otect)-.495 E F0 +(system call.)2.75 E F1(\(garbage-collect-status)72 337.8 Q F2(str)4.583 E(ate) +-.165 E(gy mode)-.44 E F1 208.165(\)p)C -.198(ro)462.244 337.8 S(cedur).198 E +(e)-.198 E F2(garba)72 356.4 Q -.11(ge)-.11 G(-collect-status).11 E F0 .122 +(is used to select a g)2.872 F .123(arbage collector and an optional, g)-.055 F +.123(arbage collector spe-)-.055 F +(ci\214c mode of operation, and to query the currently enabled g)72 371.4 Q +(arbage collector and mode.)-.055 E F2(str)72 390 Q(ate)-.165 E(gy)-.44 E F0 +.246(is a symbol identifying a g)2.996 F .246(arbage collector)-.055 F 5.746 +(.P)-.605 G .246(ermitted v)312.844 390 R .246(alues are)-.275 F F2 +(stop-and-copy)2.996 E F0(and)2.996 E F2 -.11(ge)2.996 G(n-).11 E(er)72 405 Q +(ational)-.165 E F0 1.051(\(future v)3.801 F 1.051 +(ersion of Elk may support additional g)-.165 F 1.051(arbage collectors\).) +-.055 F 1.052(The optional)6.551 F F2(mode)3.802 E F0(ar)72 420 Q .644 +(gument may be speci\214ed if the)-.198 F F2(str)3.393 E(ate)-.165 E(gy)-.44 E +F0(ar)3.393 E .643(gument is equal to)-.198 F F2 -.11(ge)3.393 G(ner).11 E +(ational)-.165 E F0 6.143(.C)C(urrently)427.353 420 Q 3.393(,o)-.715 G .643 +(nly the)473.107 420 R(symbol)72 435 Q F2(incr)2.803 E(emental)-.407 E F0 .053 +(may be used for the)2.803 F F2(mode)2.803 E F0(ar)2.803 E .053 +(gument to enable incremental g)-.198 F .054(arbage collection.)-.055 F .603 +(The current v)72 453.6 R .602(ersion of the interpreter does not support dyna\ +mic switching between the stop-and-)-.165 F(cop)72 468.6 Q 3.231(ya)-.11 G .482 +(nd the generational, incremental g)101.389 468.6 R .482 +(arbage collector at runtime.)-.055 F .482(Instead, a g)5.982 F .482 +(arbage collector)-.055 F .056 +(has to be selected at compile time \(by setting the)72 483.6 R F2 -.11(ge) +2.805 G(ner).11 E(ational_gc)-.165 E F0 -.275(va)2.805 G .055 +(riable in the installation').275 F 2.805(ss)-.605 G(ite)493 483.6 Q 1.604 +(\214le to either)72 498.6 R F2(yes)4.354 E F0(or)4.354 E F2(no)4.354 E F0 +4.354(\). Thus,)B F2(garba)4.354 E -.11(ge)-.11 G(-collect-status).11 E F0 +1.605(can currently only be used to query the)4.354 F -.055(ga)72 513.6 S 1.874 +(rbage collector and, if the generational, incremental g).055 F 1.873 +(arbage collector has been selected, to)-.055 F .509 +(enable and disable incremental g)72 528.6 R .509 +(arbage collection \(this restriction may be remo)-.055 F -.165(ve)-.165 G +3.259(di).165 G 3.26(nf)448.387 528.6 S .51(uture v)460.81 528.6 R(er)-.165 E +(-)-.22 E(sions\).)72 543.6 Q F2(garba)72 562.2 Q -.11(ge)-.11 G +(-collect-status).11 E F0 .332 +(returns a list of symbols indicating the currently enabled g)3.082 F .331 +(arbage collector)-.055 F 1.111(and mode.)72 577.2 R 1.112 +(This list resembles the ar)6.612 F 1.112(guments to)-.198 F F2(garba)3.862 E +-.11(ge)-.11 G(-collect-status).11 E F0 3.862(,i)C 1.833(.e)401.788 577.2 S +3.862(.t)-1.833 G 1.112(he \214rst element of)420.925 577.2 R 2.205 +(the list one of the symbols)72 592.2 R F2(stop-and-copy)4.955 E F0(and)4.955 E +F2 -.11(ge)4.955 G(ner).11 E(ational)-.165 E F0 4.955(,a)C 2.205 +(nd an optional, second symbol)361.048 592.2 R(\()72 607.2 Q F2(incr)A(emental) +-.407 E F0 2.75(\)m)C(ay be present if the \214rst symbol is equal to)142.774 +607.2 Q F2 -.11(ge)2.75 G(ner).11 E(ational)-.165 E F0(.)A(If)72 625.8 Q F2 +(garba)4.727 E -.11(ge)-.11 G(-collect-status).11 E F0 1.977(is in)4.727 F -.22 +(vo)-.44 G -.11(ke).22 G 4.727(dw).11 G 1.977(ith no ar)246.954 625.8 R 1.977 +(guments, or if the desired g)-.198 F 1.978(arbage collector or)-.055 F .318 +(mode of operation cannot be enabled \(either because selection of a strate)72 +640.8 R .318(gy at runtime is not sup-)-.165 F .473 +(ported, of because the mode of operation cannot be supported\), the primiti)72 +655.8 R .804 -.165(ve j)-.275 H .474(ust returns the cur).165 F(-)-.22 E +(rently acti)72 670.8 Q .33 -.165(ve s)-.275 H(trate).165 E(gy and mode.)-.165 +E EP +%%Page: 28 28 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(8-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF -.917(\(collect \))72 87 R(pr)456.128 87 Q +(ocedur)-.198 E(e)-.198 E F0 1.53(Causes a g)72 105.6 R 1.53 +(arbage collection.)-.055 F(Ev)7.03 E 1.53(en if incremental g)-.165 F 1.529 +(arbage collection has been enabled,)-.055 F/F2 11/Times-Italic@0 SF(collect) +4.279 E F0(al)72 120.6 Q -.11(wa)-.11 G(ys performs a full g).11 E +(arbage collection run.)-.055 E F1(\(collect-incr)72 150.6 Q -.917(emental \)) +-.198 F(pr)456.128 150.6 Q(ocedur)-.198 E(e)-.198 E F0 .422(This primiti)72 +169.2 R .752 -.165(ve i)-.275 H 3.172(so).165 G .422 +(nly present if the generational g)153.808 169.2 R .422 +(arbage collector has been selected.)-.055 F .423(An error is)5.923 F 3.253 +(signaled if)72 184.2 R F2(collect-incr)6.003 E(emental)-.407 E F0 3.253(is in) +6.003 F -.22(vo)-.44 G -.11(ke).22 G 6.003(da).11 G 3.253(nd incremental g) +277.421 184.2 R 3.252(arbage collection has not been)-.055 F(enabled, i.)72 +199.2 Q(e. if a call to)1.833 E F2(garba)2.75 E -.11(ge)-.11 G(-collect-status) +.11 E F0 -.11(wo)2.75 G(uld return the list).11 E F2(\(g)2.75 E(ener)-.11 E +(ational\))-.165 E F0(.)A F2(collect-incr)72 217.8 Q(emental)-.407 E F0 .915 +(starts an incremental g)3.665 F .916 +(arbage collection and then returns immediately)-.055 F 6.416(.I)-.715 G 3.666 +(fa)486.287 217.8 S(n)498.5 217.8 Q .693(incremental g)72 232.8 R .693 +(arbage collection is already in progress,)-.055 F F2(collect-incr)3.443 E +(emental)-.407 E F0 .692(triggers one incremen-)3.442 F .201(tal g)72 247.8 R +.201(arbage collection step, i.)-.055 F .201(e. scans a fe)1.833 F 2.951(wm) +-.275 G .201(ore pages of memory)273.98 247.8 R 2.951(,a)-.715 G .201 +(nd then returns immediately)377.623 247.8 R(.)-.715 E .167(The primiti)72 +262.8 R .497 -.165(ve r)-.275 H .167(eturns true if the incremental g).165 F +.166(arbage collection has been \214nished, f)-.055 F .166(alse otherwise.)-.11 +F 1.301(If incremental g)72 281.4 R 1.302 +(arbage collection is disabled by a call to)-.055 F F2(\(garba)4.052 E -.11(ge) +-.11 G 1.302(-collect-status 'g).11 F(ener)-.11 E(ational\))-.165 E F0 .069 +(while an incremental g)72 296.4 R .068 +(arbage collection run is in progress, the ne)-.055 F .068(xt call to)-.165 F +F2(collect-incr)2.818 E(emental)-.407 E F0(\214n-)2.818 E 1.416 +(ishes the incremental g)72 311.4 R 1.416 +(arbage collection run and returns #t; further calls to)-.055 F F2 +(collect-incr)4.166 E(emental)-.407 E F0(will signal an error)72 326.4 Q(.) +-.605 E F1 282.719(garbage-collect-notify? v)72 356.4 R(ariable)-.11 E F0 .327 +(This v)72 375 R .327(ariable is de\214ned in the global en)-.275 F 3.077 +(vironment. If)-.44 F .326(the v)3.077 F .326(alue of)-.275 F F2(garba)3.076 E +-.11(ge)-.11 G(-collect-notify?).11 E F0 .326(is true,)3.076 F 3.974(am)72 390 +S 1.225(essage indicating the amount of free memory on the heap and the size o\ +f the heap are dis-)89.416 390 R .284(played whene)72 405 R -.165(ve)-.275 G +3.034(ras).165 G(top-and-cop)161.908 405 Q 3.034(yg)-.11 G .284 +(arbage collection is performed.)228.929 405 R .283 +(If the generational, incremen-)5.784 F 1.469(tal g)72 420 R 1.469(arbage coll\ +ector has been enabled, the amount of reclaimed memory is displayed on each) +-.055 F -.055(ga)72 435 S .154 +(rbage collection run, and a message is displayed each time the heap is e).055 +F .153(xpanded by the g)-.165 F(arbage)-.055 E(collector)72 450 Q(.)-.605 E F2 +(garba)5.5 E -.11(ge)-.11 G(-collect-notify?).11 E F0(is bound to #t initially) +2.75 E(.)-.715 E F1 2.75(31. F)72 480 R(eatur)-.275 E(es)-.198 E(\(featur)72 +510 Q(e?)-.198 E F2(symbol)4.583 E F1 302.16(\)p)C -.198(ro)462.244 510 S +(cedur).198 E(e)-.198 E F0 .221(Returns #t if)72 528.6 R F2(symbol)2.972 E F0 +.222(is a feature, i.)2.972 F(e.)1.833 E F2(pr)2.972 E -.11(ov)-.495 G(ide).11 +E F0 .222(has been called to indicate that the feature)2.972 F F2(symbol)2.972 +E F0(is)2.972 E(present; #f otherwise.)72 543.6 Q F1(\(pr)72 573.6 Q -.11(ov) +-.198 G(ide).11 E F2(symbol)4.583 E F1 305.306(\)p)C -.198(ro)462.244 573.6 S +(cedur).198 E(e)-.198 E F0(Indicates that the feature)72 592.2 Q F2(symbol)2.75 +E F0(is present.)2.75 E(Returns)5.5 E F2(void)2.75 E F0(.)A F1(\(r)72 622.2 Q +(equir)-.198 E(e)-.198 E F2(symbol)4.583 E F1 306.626(\)p)C -.198(ro)462.244 +622.2 S(cedur).198 E(e)-.198 E(\(r)72 637.2 Q(equir)-.198 E(e)-.198 E F2 +(symbol \214le)4.583 E F1 290.434(\)p)C -.198(ro)462.244 637.2 S(cedur).198 E +(e)-.198 E(\(r)72 652.2 Q(equir)-.198 E(e)-.198 E F2(symbol \214le en)4.583 E +(vir)-.44 E(onment)-.495 E F1 233.63(\)p)C -.198(ro)462.244 652.2 S(cedur).198 +E(e)-.198 E F0 .27(If the feature)72 670.8 R F2(symbol)3.02 E F0 .269 +(is not present \(i.)3.02 F 3.019(e. \(feature?)1.833 F F2(symbol)3.019 E F0 +3.019(\)e)C -.275(va)338.03 670.8 S .269(luates to #f\),).275 F F2(\214le)3.019 +E F0 .269(is loaded.)3.019 F 3.019(Am)5.769 G(es-)491.174 670.8 Q 1.179 +(sage is displayed prior to loading the \214le if the v)72 685.8 R 1.179 +(alue of the global v)-.275 F(ariable)-.275 E F2(autoload-notify?)3.929 E F0 +(is)3.929 E 2.75(true. If)72 700.8 R(the feature is still not present after th\ +e \214le has been loaded, an error is signaled.)2.75 E EP +%%Page: 29 29 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(9-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL .609(If the)72 87 R/F1 11/Times-Italic@0 SF(\214le)3.359 E F0(ar) +3.359 E .609(gument is omitted, it def)-.198 F .609(aults to)-.11 F F1(symbol) +3.359 E F0 3.359(;i)C(f)311.521 87 Q F1(symbol)3.358 E F0 .608 +(does not end in a suf)3.358 F .608(\214x \(i.)-.275 F .608(e. does)1.833 F +(not contain a dot character\), the suf)72 102 Q<8c78>-.275 E F1(.scm)2.75 E F0 +(is appended to obtain a \214le name.)2.75 E .481(If an)72 120.6 R F1(en)3.231 +E(vir)-.44 E(onment)-.495 E F0(ar)3.231 E .482 +(gument is supplied, the \214le is loaded into gi)-.198 F -.165(ve)-.275 G +3.232(ne).165 G -.44(nv)381.422 120.6 S 3.232(ironment. If).44 F(the)3.232 E F1 +(en)3.232 E(vir)-.44 E(on-)-.495 E(ment)72 135.6 Q F0(ar)2.75 E +(gument is omitted, it def)-.198 E(aults to the current en)-.11 E(vironment.) +-.44 E F1(\214le)72 154.2 Q F0 .564(must be either a string or a symbol or a l\ +ist of strings or symbols, in which case all elements)3.315 F +(of the list must be the names of object \214les \(see)72 169.2 Q F1(load)2.75 +E F0(abo)2.75 E -.165(ve)-.165 G(\).).165 E/F2 11/Times-Bold@0 SF(\(featur)72 +199.2 Q -.917(es \))-.198 F(pr)456.128 199.2 Q(ocedur)-.198 E(e)-.198 E F0 +(Returns the currently pro)72 217.8 Q(vided features a list of symbols.)-.165 E +F2 2.75(32. Miscellaneous)72 247.8 R(\(dump)72 277.8 Q F1(\214le)4.583 E F2 +331.266(\)p)C -.198(ro)462.244 277.8 S(cedur).198 E(e)-.198 E F0 .75 +(Writes a snapshot of the running interpreter to)72 296.4 R F1(\214le)3.501 E +F0 .751(and returns #f.)3.501 F(When)6.251 E F1(\214le)3.501 E F0 .751(is e) +3.501 F -.165(xe)-.165 G .751(cuted, e).165 F -.165(xe)-.165 G(cu-).165 E 1.166 +(tion of the interpreter resumes such that the call to)72 311.4 R F1(dump)3.916 +E F0 1.166(returns #t \(i.e.,)3.916 F F1(dump)3.915 E F0 1.165 +(actually returns)3.915 F(twice\).)72 326.4 Q F1(dump)5.5 E F0 +(closes all ports e)2.75 E(xcept the current input and current output port.) +-.165 E 1.335(This primiti)72 345 R 1.665 -.165(ve i)-.275 H 4.085(sn).165 G +1.335(ot supported on platforms that are not capable of creating an e)156.547 +345 R -.165(xe)-.165 G 1.336(cutable \214le).165 F .167 +(from the memory image of the running process.)72 360 R(If)5.667 E F1(dump) +2.917 E F0 .167(is a)2.917 F -.275(va)-.22 G .167(ilable, the feature).275 F F1 +(elk:dump)2.917 E F0 .166(is pro-)2.916 F +(vided by the interpreter on startup \(see `)72 375 Q(`Features')-.814 E 2.75 +('a)-.814 G(bo)302.527 375 Q -.165(ve)-.165 G(\).).165 E F2(\(e)72 405 Q -.11 +(va)-.165 G(l).11 E F1(list)4.583 E F2 340.099(\)p)C -.198(ro)462.244 405 S +(cedur).198 E(e)-.198 E(\(e)72 420 Q -.11(va)-.165 G(l).11 E F1(list en)4.583 E +(vir)-.44 E(onment)-.495 E F2 283.295(\)p)C -.198(ro)462.244 420 S(cedur).198 E +(e)-.198 E F0(Ev)72 438.6 Q .575(aluates the e)-.275 F(xpression)-.165 E F1 +(list)3.325 E F0 .575(in the speci\214ed en)3.325 F 3.325(vironment. If)-.44 F +F1(en)3.325 E(vir)-.44 E(onment)-.495 E F0 .576(is omitted, the e)3.325 F +(xpres-)-.165 E(sion is e)72 453.6 Q -.275(va)-.275 G(luated in the current en) +.275 E(vironment.)-.44 E(Examples:)72 468.6 Q/F3 10/Courier@0 SF +(\(let \(\(car 1\)\))100.346 491.103 Q(\(eval 'car \(global-environment\)\)\)) +112.346 505.103 Q(==>)340.346 505.103 Q/F4 10/Times-Italic@0 SF(primitive) +370.346 505.103 Q/F5 10/Times-Roman@0 SF(car)6 E F3(\(define x 1\))100.346 +534.606 Q(\(define env)100.346 548.606 Q +(\(let \(\(x 2\)\) \(the-environment\)\)\))112.346 562.606 Q(\(eval 'x\)) +100.346 576.606 Q 6(==> 1)196.346 576.606 R(\(eval 'x env\))100.346 590.606 Q 6 +(==> 2)196.346 590.606 R F2(\(bound?)72 627.606 Q F1(symbol)4.583 E F2 305.592 +(\)p)C -.198(ro)462.244 627.606 S(cedur).198 E(e)-.198 E F0(Returns #t if)72 +646.206 Q F1(symbol)2.75 E F0(is bound in the current en)2.75 E +(vironment, #f otherwise.)-.44 E F2(\(type)72 676.206 Q F1(obj)4.583 E F2 +337.998(\)p)C -.198(ro)462.244 676.206 S(cedur).198 E(e)-.198 E F0 +(Returns a symbol indicating the type of)72 694.806 Q F1(obj)2.75 E F0(.)A +(Examples:)72 709.806 Q EP +%%Page: 30 30 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(0-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(type 13782343423544\))100.346 94.503 Q 6 +(==> integer)310.346 94.503 R(\(type 1.5e8\))100.346 108.503 Q 6(==> real) +310.346 108.503 R(\(type \(lambda \(x y\) \(cons x y\)\)\))100.346 122.503 Q 6 +(==> compound)310.346 122.503 R(\(type #\\a\))100.346 136.503 Q 6 +(==> character)310.346 136.503 R(\(type '\(a b c\)\))100.346 150.503 Q 6 +(==> pair)310.346 150.503 R(\(type '\(\)\))100.346 164.503 Q 6(==> null)310.346 +164.503 R(\(type \(read)100.346 178.503 Q(\(open-input-string ""\)\)\))112.346 +192.503 Q 6(==> end-of-file)310.346 192.503 R/F2 11/Times-Bold@0 SF(\(v)72 +229.503 Q(oid?)-.11 E/F3 11/Times-Italic@0 SF(obj)4.583 E F2 332.597(\)p)C +-.198(ro)462.244 229.503 S(cedur).198 E(e)-.198 E F0(Returns true if)72 248.103 +Q F3(obj)2.75 E F0(is the non-printing object, f)2.75 E(alse otherwise.)-.11 E +F2(\(command-line-ar)72 278.103 Q -.917(gs \))-.11 F(pr)456.128 278.103 Q +(ocedur)-.198 E(e)-.198 E F0(Returns the command line ar)72 296.703 Q +(guments of the interpreter')-.198 E 2.75(si)-.605 G -2.09 -.44(nv o)325.99 +296.703 T(cation, a list of strings.).44 E F2 2.75(33. R)72 326.703 R/F4 9 +/Times-Bold@0 SF(4)99.192 321.203 Q F2(RS Language F)103.692 326.703 Q(eatur) +-.275 E(es not Implemented by Elk)-.198 E F0 21.15<8352>72 345.303 S +(ational and comple)104.337 345.303 Q 2.75(xn)-.165 G +(umbers are not supported.)201.632 345.303 Q 21.15<8352>72 363.903 S +(adix pre\214x)104.337 363.903 Q +(es \(#b, #o, #d, and #x\) for real numbers are currently not implemented.) +-.165 E 21.15<8354>72 382.503 S .488(he e)103.721 382.503 R .488(xponent mark) +-.165 F(ers)-.11 E F3(s)3.238 E F0(,)A F3(f)3.238 E F0(,)A F3(d)3.237 E F0 +3.237(,a)C(nd)234.984 382.503 Q F3(l)3.237 E F0 .487 +(are not implemented; the character)3.237 F F3(#)3.237 E F0 .487 +(is not permitted in)3.237 F(place of digits in numerical constants.)97 397.503 +Q<83>72 416.103 Q F3 -.165(ch)97 416.103 S(ar).165 E(-r)-.22 E(eady)-.407 E F0 +(is not implemented correctly \(see abo)2.75 E -.165(ve)-.165 G(\).).165 E<83> +72 434.703 Q F3(tr)97 434.703 Q(anscript-on)-.165 E F0(and)2.75 E F3(tr)2.75 E +(anscript-of)-.165 E(f)-.198 E F0(are not implemented.)2.75 E EP +%%Page: 31 31 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(1-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 13/Times-Bold@0 SF(Index)272.108 123 Q(*)72 174 Q F0(*,)72 204 Q +/F2 12/Times-Bold@0 SF(9)2.75 E F1(+)72 234 Q F0(+,)72 264 Q F2(9)2.75 E F1(-) +72 294 Q F0(-,)72 324 Q F2(9)2.75 E F0(-1+,)72 339 Q F2(9)2.75 E F1(/)72 369 Q +F0(/,)72 399 Q F2(9)2.75 E F1(1)72 429 Q F0(1+,)72 459 Q F2(9)2.75 E F0(1-,)72 +474 Q F2(9)2.75 E F1(<)72 504 Q F0(<,)72 534 Q F2(8)2.75 E F0(<=,)72 549 Q F2 +(8)2.75 E F1(=)72 579 Q F0(=,)72 609 Q F2(8)2.75 E F1(>)72 639 Q F0(>,)72 669 Q +F2(8)2.75 E F0(>=,)302.4 174 Q F2(8)2.75 E F1(A)302.4 204 Q F0(abs,)302.4 234 Q +F2(9)2.75 E F0(acos,)302.4 249 Q F2(10)2.75 E F0(and,)302.4 264 Q F2(4)2.75 E +F0(append!,)302.4 279 Q F2(7)2.75 E F0(append,)302.4 294 Q F2(7)2.75 E F0 +(apply)302.4 309 Q(,)-.715 E F2(3)2.75 E F0(asin,)302.4 324 Q F2(10)2.75 E F0 +(assoc,)302.4 339 Q F2(8)2.75 E F0(assq,)302.4 354 Q F2(8)2.75 E F0(assv)302.4 +369 Q(,)-.715 E F2(8)2.75 E F0(atan,)302.4 384 Q F2(10)2.75 E F0(autoload,) +302.4 399 Q F2(23)2.75 E F0(autoload-notify?,)302.4 414 Q F2(23)2.75 E F1(B) +302.4 444 Q F0(be)302.4 474 Q(gin,)-.165 E F2(4)2.75 E F0(be)302.4 489 Q(gin1,) +-.165 E F2(4)2.75 E F0(boolean?,)302.4 504 Q F2(5)2.75 E F0(bound?,)302.4 519 Q +F2(29)2.75 E F1(C)302.4 549 Q F0(caar)302.4 579 Q(,)-.44 E F2(6)2.75 E F0 +(call-with-current-continuation,)302.4 594 Q F2(5)2.75 E F0 +(call-with-input-\214le,)302.4 609 Q F2(17)2.75 E F0(call-with-output-\214le,) +302.4 624 Q F2(17)2.75 E F0(car)302.4 639 Q(,)-.44 E F2(6)2.75 E F0(case,)302.4 +654 Q F2(4)2.75 E F0(cddddr)302.4 669 Q(,)-.44 E F2(7)2.75 E F0(cdr)302.4 684 Q +(,)-.44 E F2(6)2.75 E F0(ceiling,)302.4 699 Q F2(9)2.75 E F0(char)302.4 714 Q +(-alphabetic?,)-.22 E F2(11)2.75 E F0(char)302.4 729 Q(-ci<=?,)-.22 E F2(11) +2.75 E EP +%%Page: 32 32 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(2-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(char)72 87 Q(-ci=?,)-.22 E F1(11)2.75 +E F0(char)72 132 Q(-ci>?,)-.22 E F1(11)2.75 E F0(char)72 147 Q(-do)-.22 E +(wncase,)-.275 E F1(11)2.75 E F0(char)72 162 Q(-lo)-.22 E(wer)-.275 E(-case?,) +-.22 E F1(11)2.75 E F0(char)72 177 Q(-numeric?,)-.22 E F1(11)2.75 E F0(char)72 +192 Q(-ready)-.22 E 2.75(,3)-.715 G(0)129.09 192 Q(char)72 207 Q(-ready?,)-.22 +E F1(19)2.75 E F0(char)72 222 Q(-upcase,)-.22 E F1(11)2.75 E F0(char)72 237 Q +(-upper)-.22 E(-case?,)-.22 E F1(11)2.75 E F0(char)72 252 Q(-whitespace?,)-.22 +E F1(11)2.75 E F0(char<=?,)72 267 Q F1(11)2.75 E F0(char=?,)72 312 Q F1(11)2.75 E F0 +(char>?,)72 327 Q F1(11)2.75 E F0(char?,)72 342 Q F1(12)2.75 E F0(char)72 357 Q +/F2 11/Symbol SF(-)A F0(>inte)A(ger)-.165 E(,)-.44 E F1(11)2.75 E F0(clear)72 +372 Q(-input-port,)-.22 E F1(18)2.75 E F0(clear)72 387 Q(-output-port,)-.22 E +F1(18)2.75 E F0(close-input-port,)72 402 Q F1(17)2.75 E F0(close-output-port,) +72 417 Q F1(17)2.75 E F0(collect,)72 432 Q F1(28)2.75 E F0 +(collect-incremental,)72 447 Q F1(28)2.75 E F0(command-line-ar)72 462 Q(gs,) +-.198 E F1(30)2.75 E F0(comple)72 477 Q(x?,)-.165 E F1(10)2.75 E F0(compound?,) +72 492 Q F1(2)2.75 E F0(cond,)72 507 Q F1(4)2.75 E F0(cons,)72 522 Q F1(6)2.75 +E F0(constant,)72 537 Q F1(3)2.75 E F0(control-point-en)72 552 Q(vironment,) +-.44 E F1(16)2.75 E F0(control-point?,)72 567 Q F1(5)2.75 E F0(cos,)72 582 Q F1 +(10)2.75 E F0(critical section, 26)72 597 Q(current-input-port,)72 612 Q F1(17) +2.75 E F0(current-output-port,)72 627 Q F1(17)2.75 E F0(cxr)72 642 Q(,)-.44 E +F1(6)2.75 E/F3 13/Times-Bold@0 SF(D)72 672 Q F0(de\214ne,)72 702 Q F1(3)2.75 E +F0(de\214ne-macro,)72 717 Q F1(23)2.75 E F0(delay)72 732 Q(,)-.715 E F1(6)2.75 +E F0(disable-interrupts,)302.4 87 Q F1(25)2.75 E F0(display)302.4 102 Q(,)-.715 +E F1(20)2.75 E F0(do,)302.4 117 Q F1(5)2.75 E F0(dump,)302.4 132 Q F1(29)2.75 E +F0(dynamic-wind,)302.4 147 Q F1(5)2.75 E F0 2.75(,2)C(6)388.447 147 Q F3(E) +302.4 177 Q F0(elk:dump, 29)302.4 207 Q(elk:load-object, 22)302.4 222 Q +(enable-interrupts,)302.4 237 Q F1(25)2.75 E F0(en)302.4 252 Q(vironment?,)-.44 +E F1(16)2.75 E F0(en)302.4 267 Q(vironment)-.44 E F2(-)A F0(>list,)A F1(16)2.75 +E F0(eof-object?,)302.4 282 Q F1(19)2.75 E F0(eq?,)302.4 297 Q F1(6)2.75 E F0 +(equal?,)302.4 312 Q F1(6)2.75 E F0(eqv?,)302.4 327 Q F1(6)2.75 E F0(error) +302.4 342 Q(,)-.44 E F1(26)2.75 E F0(error)302.4 357 Q(-handler)-.22 E(,)-.44 E +F1(25)2.75 E F0 2.75(,2)C(6)388.265 357 Q -.275(eva)302.4 372 S(l,).275 E F1 +(29)2.75 E F0 -2.365 -.275(ev e)302.4 387 T(n?,).275 E F1(9)2.75 E F0 -.165(ex) +302.4 402 S(act?,).165 E F1(9)2.75 E F0 -.165(ex)302.4 417 S(act).165 E F2(-)A +F0(>ine)A(xact,)-.165 E F1(10)2.75 E F0 -.165(ex)302.4 432 S(it code, 26).165 E +-.165(ex)302.4 447 S(it,).165 E F1(26)2.75 E F0 -.165(ex)302.4 462 S(p,).165 E +F1(10)2.75 E F0 -.165(ex)302.4 477 S(pt,).165 E F1(10)2.75 E F3(F)302.4 507 Q +F0(feature, 22, 29)302.4 537 Q(feature?,)302.4 552 Q F1(28)2.75 E F0(features,) +302.4 567 Q F1(29)2.75 E F0(\214le name, 17)302.4 582 Q(\214le-e)302.4 597 Q +(xists?,)-.165 E F1(18)2.75 E F0(\215oor)302.4 612 Q(,)-.44 E F1(9)2.75 E F0 +(\215uid-let,)302.4 627 Q F1(2)2.75 E F0(\215ush-output-port,)302.4 642 Q F1 +(18)2.75 E F0(for)302.4 657 Q(-each,)-.22 E F1(5)2.75 E F0(force,)302.4 672 Q +F1(6)2.75 E EP +%%Page: 33 33 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(3-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(format,)72 87 Q/F1 12/Times-Bold@0 SF(20)2.75 E F0 2.75(,2)C(5) +129.826 87 Q/F2 13/Times-Bold@0 SF(G)72 117 Q F0 -.055(ga)72 147 S +(rbage collector).055 E 2.75(,2)-.44 G(7)158.559 147 Q -.055(ga)72 162 S +(rbage collector).055 E 2.75(,g)-.44 G(enerational, 27)158.559 162 Q -.055(ga) +72 177 S(rbage collector).055 E 2.75(,i)-.44 G(ncremental, 27)156.117 177 Q +-.055(ga)72 192 S(rbage collector).055 E 2.75(,s)-.44 G(top-and-cop)157.338 192 +Q 1.43 -.715(y, 2)-.11 H(7).715 E -.055(ga)72 207 S(rbage-collect-notify?,).055 +E F1(28)2.75 E F0 -.055(ga)72 222 S(rbage-collect-status,).055 E F1(27)2.75 E +F0(gcd,)72 237 Q F1(9)2.75 E F0(get,)72 252 Q F1(15)2.75 E F0 +(get-output-string,)72 267 Q F1(21)2.75 E F0(global-en)72 282 Q(vironment,)-.44 +E F1(16)2.75 E F2(I)72 312 Q F0(if,)72 342 Q F1(4)2.75 E F0(ine)72 357 Q +(xact?,)-.165 E F1(9)2.75 E F0(ine)72 372 Q(xact)-.165 E/F3 11/Symbol SF(-)A F0 +(>e)A(xact,)-.165 E F1(10)2.75 E F0(input-port?,)72 387 Q F1(17)2.75 E F0(inte) +72 402 Q(ger?,)-.165 E F1(10)2.75 E F0(inte)72 417 Q(ger)-.165 E F3(-)A F0 +(>char)A(,)-.44 E F1(11)2.75 E F0(interrupt-handler)72 432 Q(,)-.44 E F1(25) +2.75 E F2(L)72 462 Q F0(lambda,)72 492 Q F1(1)2.75 E F0(last-pair)72 507 Q(,) +-.44 E F1(7)2.75 E F0(lcm,)72 522 Q F1(9)2.75 E F0(length,)72 537 Q F1(7)2.75 E +F0(let,)72 552 Q F1(2)2.75 E F0(,)A F1(5)2.75 E F0(let*,)72 567 Q F1(2)2.75 E +F0(letrec,)72 582 Q F1(2)2.75 E F0(link)72 597 Q(er)-.11 E 2.75(,2)-.44 G(2) +108.113 597 Q(list,)72 612 Q F1(7)2.75 E F0(list-ref,)72 627 Q F1(7)2.75 E F0 +(list-tail,)72 642 Q F1(7)2.75 E F0(list?,)72 657 Q F1(8)2.75 E F0(list)72 672 +Q F3(-)A F0(>string,)A F1(12)2.75 E F0(list)72 687 Q F3(-)A F0(>v)A(ector)-.165 +E(,)-.44 E F1(14)2.75 E F0(load,)72 702 Q F1(22)2.75 E F0(load-libraries, 22,) +72 717 Q F1(23)2.75 E F0(load-noisily?,)72 732 Q F1(23)2.75 E F0(load-path,) +302.4 87 Q F1(22)2.75 E F0(log,)302.4 102 Q F1(10)2.75 E F2(M)302.4 132 Q F0 +(macro,)302.4 162 Q F1(23)2.75 E F0(macro-body)302.4 177 Q(,)-.715 E F1(24)2.75 +E F0(macro-e)302.4 192 Q(xpand,)-.165 E F1(24)2.75 E F0(macro?,)302.4 207 Q F1 +(24)2.75 E F0(mak)302.4 222 Q(e-list,)-.11 E F1(7)2.75 E F0(mak)302.4 237 Q +(e-string,)-.11 E F1(12)2.75 E F0(mak)302.4 252 Q(e-v)-.11 E(ector)-.165 E(,) +-.44 E F1(14)2.75 E F0(map,)302.4 267 Q F1(5)2.75 E F0(max,)302.4 282 Q F1(10) +2.75 E F0(member)302.4 297 Q(,)-.44 E F1(8)2.75 E F0(memq,)302.4 312 Q F1(8) +2.75 E F0(memv)302.4 327 Q(,)-.715 E F1(8)2.75 E F0(min,)302.4 342 Q F1(10)2.75 +E F0(modulo,)302.4 357 Q F1(9)2.75 E F2(N)302.4 387 Q F0(ne)302.4 417 Q -.055 +(ga)-.165 G(ti).055 E -.165(ve)-.275 G(?,).165 E F1(9)2.75 E F0(ne)302.4 432 Q +(wline,)-.275 E F1(20)2.75 E F0(not,)302.4 447 Q F1(5)2.75 E F0(null?,)302.4 +462 Q F1(8)2.75 E F0(number?,)302.4 477 Q F1(10)2.75 E F0(number)302.4 492 Q F3 +(-)A F0(>string,)A F1(11)2.75 E F2(O)302.4 522 Q F0(object code, 22)302.4 552 Q +(object \214le, 23)302.4 567 Q(object \214les, 22)302.4 582 Q(oblist,)302.4 597 +Q F1(15)2.75 E F0(odd?,)302.4 612 Q F1(9)2.75 E F0(open-input-\214le,)302.4 627 +Q F1(17)2.75 E F0(open-input-output-\214le,)302.4 642 Q F1(17)2.75 E F0 +(open-input-string,)302.4 657 Q F1(21)2.75 E F0(open-output-\214le,)302.4 672 Q +F1(17)2.75 E F0(open-output-string,)302.4 687 Q F1(21)2.75 E F0(operator)302.4 +702 Q(,)-.44 E F1(3)2.75 E F0(or)302.4 717 Q(,)-.44 E F1(4)2.75 E EP +%%Page: 34 34 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(4-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(output-port?,)72 87 Q/F1 12/Times-Bold@0 SF(17)2.75 E/F2 13 +/Times-Bold@0 SF(P)72 117 Q F0(pair?,)72 147 Q F1(8)2.75 E F0(peek-char)72 162 +Q(,)-.44 E F1(19)2.75 E F0(port-\214le-name,)72 177 Q F1(18)2.75 E F0 +(port-line-number)72 192 Q(,)-.44 E F1(18)2.75 E F0(positi)72 207 Q -.165(ve) +-.275 G(?,).165 E F1(9)2.75 E F0(primiti)72 222 Q -.165(ve)-.275 G(?,).165 E F1 +(1)2.75 E F0(print,)72 237 Q F1(20)2.75 E F0(print-depth,)72 252 Q F1(20)2.75 E +F0(print-length,)72 267 Q F1(20)2.75 E F0(procedure-en)72 282 Q(vironment,)-.44 +E F1(16)2.75 E F0(procedure-lambda,)72 297 Q F1(1)2.75 E F0 2.75(,2)C(4)174.525 +297 Q(procedure?,)72 312 Q F1(1)2.75 E F0(promise-en)72 327 Q(vironment,)-.44 E +F1(16)2.75 E F0(promise?,)72 342 Q F1(6)2.75 E F0(property list, 14, 15)72 357 +Q(pro)72 372 Q(vide,)-.165 E F1(28)2.75 E F0(put,)72 387 Q F1(14)2.75 E F2(Q)72 +417 Q F0(quasiquote,)72 447 Q F1(4)2.75 E F0(quote,)72 462 Q F1(3)2.75 E F0 +(quotient,)72 477 Q F1(9)2.75 E F2(R)72 507 Q F0(random,)72 537 Q F1(10)2.75 E +F0(rational?,)72 552 Q F1(10)2.75 E F0(read,)72 567 Q F1(19)2.75 E F0 +(read-char)72 582 Q(,)-.44 E F1(19)2.75 E F0(read-string,)72 597 Q F1(19)2.75 E +F0(real?,)72 612 Q F1(10)2.75 E F0(remainder)72 627 Q(,)-.44 E F1(9)2.75 E F0 +(require,)72 642 Q F1(28)2.75 E F0(reset, 25,)72 657 Q F1(26)2.75 E F0(re)72 +672 Q -.165(ve)-.275 G(rse!,).165 E F1(8)2.75 E F0(re)72 687 Q -.165(ve)-.275 G +(rse,).165 E F1(8)2.75 E F0(round,)302.4 87 Q F1(9)2.75 E F2(S)302.4 117 Q F0 +(set!,)302.4 147 Q F1(3)2.75 E F0(set-car!,)302.4 162 Q F1(7)2.75 E F0 +(set-cdr!,)302.4 177 Q F1(7)2.75 E F0(signals, 25)302.4 192 Q(sin,)302.4 207 Q +F1(10)2.75 E F0(site \214le, 22, 27)302.4 222 Q(sqrt,)302.4 237 Q F1(10)2.75 E +F0(srandom,)302.4 252 Q F1(10)2.75 E F0(string ports, 21)302.4 267 Q(string,) +302.4 282 Q F1(12)2.75 E F0(string-append,)302.4 297 Q F1(12)2.75 E F0 +(string-ci<=?,)302.4 312 Q F1(13)2.75 E F0(string-ci=?,)302.4 357 Q F1(13) +2.75 E F0(string-ci>?,)302.4 372 Q F1(13)2.75 E F0(string-cop)302.4 387 Q -.715 +(y,)-.11 G F1(12)3.465 E F0(string-\214ll!,)302.4 402 Q F1(13)2.75 E F0 +(string-length,)302.4 417 Q F1(12)2.75 E F0(string-ref,)302.4 432 Q F1(12)2.75 +E F0(string-set!,)302.4 447 Q F1(12)2.75 E F0(string<=?,)302.4 462 Q F1(13)2.75 +E F0(string=?,)302.4 507 Q F1(13)2.75 E F0(string>?,)302.4 522 Q F1(13)2.75 E F0 +(string?,)302.4 537 Q F1(12)2.75 E F0(string)302.4 552 Q/F3 11/Symbol SF(-)A F0 +(>list,)A F1(12)2.75 E F0(string)302.4 567 Q F3(-)A F0(>number)A(,)-.44 E F1 +(11)2.75 E F0(string)302.4 582 Q F3(-)A F0(>symbol,)A F1(14)2.75 E F0 +(substring,)302.4 597 Q F1(12)2.75 E F0(substring-ci?,)302.4 612 Q F1(13)2.75 E +F0(substring-\214ll!,)302.4 627 Q F1(13)2.75 E F0(substring?,)302.4 642 Q F1 +(13)2.75 E F0(suf)302.4 657 Q(\214x, 22, 29)-.275 E(symbol-plist,)302.4 672 Q +F1(15)2.75 E F0(symbol?,)302.4 687 Q F1(15)2.75 E EP +%%Page: 35 35 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(5-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(symbol)72 87 Q/F1 11/Symbol SF(-)A F0(>string,)A/F2 12/Times-Bold@0 +SF(14)2.75 E F0 2.75(,1)C(7)170.196 87 Q/F3 13/Times-Bold@0 SF(T)72 117 Q F0 +(tan,)72 147 Q F2(10)2.75 E F0(the-en)72 162 Q(vironment,)-.44 E F2(16)2.75 E +F0(tilde, 17)72 177 Q(tilde-e)72 192 Q(xpand,)-.165 E F2(18)2.75 E F0(top-le)72 +207 Q -.165(ve)-.275 G(l-control-point,).165 E F2(26)2.75 E F0(truncate,)72 222 +Q F2(9)2.75 E F0(type,)72 237 Q F2(29)2.75 E F3(U)72 267 Q F0(unquote,)72 297 Q +F2(4)2.75 E F0(unquote-splicing,)72 312 Q F2(4)2.75 E F0(unread-char)72 327 Q +(,)-.44 E F2(19)2.75 E F0(unwind-protect, 5)72 342 Q F3(V)72 372 Q F0 -.165(ve) +72 402 S(ctor).165 E(,)-.44 E F2(14)2.75 E F0 -.165(ve)72 417 S(ctor).165 E +(-cop)-.22 E -.715(y,)-.11 G F2(14)3.465 E F0 -.165(ve)72 432 S(ctor).165 E +(-\214ll!,)-.22 E F2(14)2.75 E F0 -.165(ve)72 447 S(ctor).165 E(-length,)-.22 E +F2(14)2.75 E F0 -.165(ve)72 462 S(ctor).165 E(-ref,)-.22 E F2(14)2.75 E F0 +-.165(ve)72 477 S(ctor).165 E(-set!,)-.22 E F2(14)2.75 E F0 -.165(ve)72 492 S +(ctor?,).165 E F2(13)2.75 E F0 -.165(ve)72 507 S(ctor).165 E F1(-)A F0(>list,)A +F2(14)2.75 E F0 -.22(vo)72 522 S(id?,).22 E F2(30)2.75 E F3(W)72 552 Q F0 +(with-input-from-\214le,)72 582 Q F2(17)2.75 E F0(with-interrupts-disabled, 26) +72 597 Q(with-output-to-\214le,)72 612 Q F2(17)2.75 E F0(write,)72 627 Q F2(20) +2.75 E F0(write-char)72 642 Q(,)-.44 E F2(20)2.75 E F3(Z)72 672 Q F0(zero?,)72 +702 Q F2(9)2.75 E EP +%%Page: 36 36 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 13/Times-Bold@0 SF -1.196(Ta)239.127 123 S(ble of Contents)1.196 E/F1 11 +/Times-Roman@0 SF .866(Introduction ..........................................\ +..............................................................................\ +......)72 177.6 R(1)498.5 177.6 Q(Lambda Expressions, Procedures)72 196.2 Q +19.25(........................................................................\ +.................... 1)5.167 F(Local Bindings)72 214.8 Q 19.25(...............\ +..............................................................................\ +............................ 2)4.221 F(Fluid Binding)72 233.4 Q 19.25(........\ +..............................................................................\ +..................................... 2)4.815 F .855(De\214nitions ...........\ +..............................................................................\ +.......................................)72 252 R(3)498.5 252 Q 2.692(Assignmen\ +t ............................................................................\ +..................................................)72 270.6 R(3)498.5 270.6 Q +(Procedure Application)72 289.2 Q 19.25(......................................\ +....................................................................... 3)5.464 +F(Quotation, Quasiquotation)72 307.8 Q 19.25(.................................\ +...................................................................... 3)4.529 +F 1.174(Sequencing ...........................................................\ +....................................................................)72 326.4 R +(4)498.5 326.4 Q 1.768(Conditionals ..........................................\ +..............................................................................\ +.....)72 345 R(4)498.5 345 Q .558(Booleans ...................................\ +..............................................................................\ +..................)72 363.6 R(4)498.5 363.6 Q 1.482(Iteration ................\ +..............................................................................\ +......................................)72 382.2 R(5)498.5 382.2 Q 1.768(Contin\ +uations ......................................................................\ +.....................................................)72 400.8 R(5)498.5 400.8 +Q(Delayed Ev)72 419.4 Q 1.46(aluation ........................................\ +..........................................................................) +-.275 F(6)498.5 419.4 Q(Equi)72 438 Q -.275(va)-.275 G(lence Predicates).275 E +19.25(........................................................................\ +..................................... 6)2.967 F -.165(Pa)72 456.6 S +(irs and Lists).165 E 19.25(..................................................\ +........................................................................ 6) +4.386 F 1.174(Numbers ........................................................\ +...........................................................................)72 +475.2 R(8)498.5 475.2 Q 2.714(Characters .....................................\ +..............................................................................\ +.............)72 493.8 R(11)493 493.8 Q 2.076(Strings ........................\ +..............................................................................\ +................................)72 512.4 R(12)493 512.4 Q -1.221(Ve)72 531 S +.261(ctors ...................................................................\ +...................................................................)1.221 F(13) +493 531 Q .239(Symbols .......................................................\ +.............................................................................) +72 549.6 R(14)493 549.6 Q(En)72 568.2 Q 2.219(vironments .....................\ +..............................................................................\ +........................)-.44 F(16)493 568.2 Q(Ports and Files)72 586.8 Q 13.75 +(.............................................................................\ +............................................. 17)3.605 F 1.779(Input .........\ +..............................................................................\ +..................................................)72 605.4 R(19)493 605.4 Q +2.692(Output .................................................................\ +.....................................................................)72 624 R +(19)493 624 Q(String Ports)72 642.6 Q 13.75(..................................\ +..............................................................................\ +............... 21)2.989 F 2.087(Loading .....................................\ +..............................................................................\ +.................)72 661.2 R(22)493 661.2 Q .261(Macros ......................\ +..............................................................................\ +..................................)72 679.8 R(23)493 679.8 Q +(Error and Exception Handling)72 698.4 Q 13.75(...............................\ +.................................................................. 25)4.859 F +(Garbage Collection)72 717 Q 13.75(...........................................\ +....................................................................... 27) +5.156 F EP +%%Page: 37 37 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 1.482(Features .......................................\ +..............................................................................\ +...............)72 87 R(28)493 87 Q 2.703(Miscellaneous ......................\ +..............................................................................\ +......................)72 105.6 R(29)493 105.6 Q(R)72 124.2 Q/F1 9 +/Times-Roman@0 SF(4)79.337 118.7 Q F0 +(RS Language Features not Implemented by Elk)83.837 124.2 Q 13.75 +(................................................................. 30)4.935 F +(Inde)72 142.8 Q 2.868(x.)-.165 G 13.75(......................................\ +..............................................................................\ +.................... 31)102.5 142.8 R EP +%%Trailer +end +%%EOF diff --git a/doc/man/Makefile b/doc/man/Makefile new file mode 100644 index 0000000..f5854aa --- /dev/null +++ b/doc/man/Makefile @@ -0,0 +1,11 @@ +TROFF= groff -man -t +UNROFF= unroff -man + +elk.ps: elk.1 + $(TROFF) $? > $@ + +elk.1.html: elk.1 + $(UNROFF) $? + +clean: + rm -f elk.ps elk.1.html diff --git a/doc/man/elk.1 b/doc/man/elk.1 new file mode 100644 index 0000000..5a2b391 --- /dev/null +++ b/doc/man/elk.1 @@ -0,0 +1,117 @@ +.pl 11i \" US letter format +.TH ELK 1 "15 January 1991" +.UC 4 +.SH NAME +elk, scheme \- extensible Scheme interpreter +.SH SYNOPSIS +.B scheme +[ +.B \-l \f2file\fP +] [ +.B \-h \f2KBytes\fP +] [ +.B \-p \f2load-path\fP +] [ +.B \-g +] [ +.B \-i +] [ +.B \-v \f2type\fP +] [[ +.B \-\^\- +] \f2args\fP] +.LP +.BR elk .\|.\|. +.SH DESCRIPTION +.I Elk +(Extension Language Kit) is a Scheme implementation designed +as a general extension language for applications +written in C or C++. +Normally, +.I Elk +is linked with the application it serves, but a stand-alone version +of the Scheme interpreter is installed as well (usually under +the name +.BR scheme ). +This interpreter, together with the standard Scheme toplevel, +.I Elk +can be used as an ordinary, stand-alone implementation of the +Scheme language. +.LP +When called without the +.B \-l +option, +.I Elk +loads the standard \*(lqtoplevel\*(rq to start an interactive session. +When called with +.BR "\-l \f2file\fP" , +the contents of the specified file is loaded instead. +If a `\-' is given as a filename argument, +.I Elk +loads from standard input. +.LP +The option +.B \-p \f2load-path\fP +can be used to override the standard \f2load-path\fP. +The argument is a colon-separated list of directories. +If this option is not present and the environment variable +ELK_LOADPATH is defined, the value of this variable is used +to initialize the \f2load-path\fP. +The value of ELK_LOADPATH has the same format as the argument +to the +.B -p +option. +.LP +The +.B \-h \f2KBytes\fP +option is used to specify a non-standard heap size. +The default heap size is 512 KBytes. +.LP +If the option +.B \-i +is specified, symbols are mapped to lower case. +Normally, +.I Elk +is case-sensitive. +.LP +The +.B \-g +option causes the interpreter to run the garbage collector each +time memory is allocated on the heap. +This is useful for writers of extensions who want to test the +garbage collect behavior of an extension. +Running +.I Elk +with the +.B \-g +option is likely to reveal GC-related bugs in extensions (such as not +properly protected local objects), as it triggers a garbage collection +each time an object is allocated on the Scheme heap. +A dot is written to standard output each time a garbage collection is +performed when +.B \-g +has been specified. +.LP +When called with one or more +.B \-v \f2type\fP +(``verbose'') options, the interpreter prints additional +informational messages to standard output, depending on the value +of the \f2type\fP argument. +If \f2type\fP is \f2load\fP, the linker command and options are +printed each time an object file is loaded; if \f2type\fP is +\f2init\fP, the names of extension initialization +and finalization functions are printed as they are called. +.LP +The remaining +.I args +are put into a list of strings, and the Scheme variable +.B command-line-args +is bound to this list in the global environment. +If arguments could be interpreted as options, `\-\^-\' can be +used to indicate the end of the options. +.SH FILES +.nf +$TMPDIR/ldXXXXXX Temporary files +.fi +.SH AUTHOR +Oliver Laumann diff --git a/doc/man/elk.ps b/doc/man/elk.ps new file mode 100644 index 0000000..ebc3f9e --- /dev/null +++ b/doc/man/elk.ps @@ -0,0 +1,277 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Roman +%%+ font Times-Bold +%%+ font Times-Italic +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 1 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Roman +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Times-Italic@0 ENC0/Times-Italic RE +/Times-Bold@0 ENC0/Times-Bold RE/Times-Roman@0 ENC0/Times-Roman RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 403.3(ELK\(1\) ELK\(1\))72 48 R/F1 9/Times-Bold@0 SF +-.18(NA)72 84 S(ME).18 E F0(elk, scheme \255 e)108 96 Q +(xtensible Scheme interpreter)-.15 E F1(SYNOPSIS)72 112.8 Q/F2 10/Times-Bold@0 +SF(scheme)108 124.8 Q F0([)2.5 E F22.5 E/F3 10/Times-Italic@0 SF(\214le) +2.5 E F0 2.5(][)2.5 G F2A F3(KBytes)2.5 E F0 2.5(][)2.5 G F2A F3 +(load-path)2.5 E F0 2.5(][)2.5 G F2A F0 2.5(][)2.5 G F2A F0 2.5(][) +2.5 G F2A F3(type)2.5 E F0 2.5(][)2.5 G([)396.87 124.8 Q F2 .8332.5 +G F0(])1.667 E F3(ar)2.5 E(gs)-.37 E F0(])A F2(elk)108 141.6 Q F0 1.666(...)C +F1(DESCRIPTION)72 158.4 Q F3(Elk)108 170.4 Q F0 1.111 +(\(Extension Language Kit\) is a Scheme implementation designed as a general e) +3.612 F 1.111(xtension language for)-.15 F .68 +(applications written in C or C++.)108 182.4 R(Normally)5.68 E(,)-.65 E F3(Elk) +3.18 E F0 .681(is link)3.181 F .681(ed with the application it serv)-.1 F .681 +(es, b)-.15 F .681(ut a stand-alone)-.2 F -.15(ve)108 194.4 S 1.027 +(rsion of the Scheme interpreter is installed as well \(usually under the name) +.15 F F2(scheme)3.527 E F0 3.527(\). This)B(interpreter)3.527 E(,)-.4 E .412 +(together with the standard Scheme tople)108 206.4 R -.15(ve)-.25 G(l,).15 E F3 +(Elk)2.912 E F0 .412(can be used as an ordinary)2.912 F 2.912(,s)-.65 G .412 +(tand-alone implementation of)420.856 206.4 R(the Scheme language.)108 218.4 Q +.604(When called without the)108 235.2 R F23.104 E F0(option,)3.104 E F3 +(Elk)3.104 E F0 .604(loads the standard \231tople)3.104 F -.15(ve)-.25 G .604 +(l\232 to start an interacti).15 F .903 -.15(ve s)-.25 H 3.103(ession. When).15 +F .644(called with)108 247.2 R F23.144 E F3(\214le)3.144 E F0 3.144(,t)C +.644(he contents of the speci\214ed \214le is loaded instead.)188.216 247.2 R +.644(If a `\255' is gi)5.644 F -.15(ve)-.25 G 3.145(na).15 G 3.145(sa\214) +466.875 247.2 S .645(lename ar)487.055 247.2 R(gu-)-.18 E(ment,)108 259.2 Q F3 +(Elk)2.5 E F0(loads from standard input.)2.5 E .047(The option)108 276 R F2 +2.547 E F3(load-path)2.547 E F0 .046(can be used to o)2.547 F -.15(ve) +-.15 G .046(rride the standard).15 F F3(load-path)2.546 E F0 5.046(.T)C .046 +(he ar)408.366 276 R .046(gument is a colon-separated)-.18 F .56 +(list of directories.)108 288 R .561(If this option is not present and the en) +5.56 F .561(vironment v)-.4 F .561(ariable ELK_LO)-.25 F(ADP)-.35 E -1.11(AT) +-.92 G 3.061(Hi)1.11 G 3.061(sd)501.109 288 S(e\214ned,)513.06 288 Q .583 +(the v)108 300 R .583(alue of this v)-.25 F .583 +(ariable is used to initialize the)-.25 F F3(load-path)3.083 E F0 5.583(.T)C +.583(he v)360.283 300 R .583(alue of ELK_LO)-.25 F(ADP)-.35 E -1.11(AT)-.92 G +3.083(Hh)1.11 G .583(as the same)492.735 300 R(format as the ar)108 312 Q +(gument to the)-.18 E F2(-p)2.5 E F0(option.)2.5 E(The)108 328.8 Q F22.5 +E F3(KBytes)2.5 E F0(option is used to specify a non-standard heap size.)2.5 E +(The def)5 E(ault heap size is 512 KBytes.)-.1 E(If the option)108 345.6 Q F2 +2.5 E F0(is speci\214ed, symbols are mapped to lo)2.5 E(wer case.)-.25 E +(Normally)5 E(,)-.65 E F3(Elk)2.5 E F0(is case-sensiti)2.5 E -.15(ve)-.25 G(.) +.15 E(The)108 362.4 Q F23.875 E F0 1.375 +(option causes the interpreter to run the g)3.875 F 1.376 +(arbage collector each time memory is allocated on the)-.05 F 2.637(heap. This) +108 374.4 R .136(is useful for writers of e)2.637 F .136(xtensions who w)-.15 F +.136(ant to test the g)-.1 F .136(arbage collect beha)-.05 F .136(vior of an e) +-.2 F(xtension.)-.15 E(Running)108 386.4 Q F3(Elk)2.806 E F0 .306(with the) +2.806 F F22.806 E F0 .306(option is lik)2.806 F .307(ely to re)-.1 F -.15 +(ve)-.25 G .307(al GC-related b).15 F .307(ugs in e)-.2 F .307 +(xtensions \(such as not properly pro-)-.15 F .089 +(tected local objects\), as it triggers a g)108 398.4 R .088 +(arbage collection each time an object is allocated on the Scheme heap.)-.05 F +2.625(Ad)108 410.4 S .125(ot is written to standard output each time a g) +122.845 410.4 R .126(arbage collection is performed when)-.05 F F22.626 E +F0 .126(has been speci\214ed.)2.626 F .592(When called with one or more)108 +427.2 R F23.092 E F3(type)3.092 E F0(\(`)3.092 E(`v)-.74 E(erbose')-.15 E +.592('\) options, the interpreter prints additional informational)-.74 F .452 +(messages to standard output, depending on the v)108 439.2 R .453(alue of the) +-.25 F F3(type)2.953 E F0(ar)2.953 E 2.953(gument. If)-.18 F F3(type)2.953 E F0 +(is)2.953 E F3(load)2.953 E F0 2.953(,t)C .453(he link)480.874 439.2 R .453 +(er com-)-.1 F .013 +(mand and options are printed each time an object \214le is loaded; if)108 +451.2 R F3(type)2.512 E F0(is)2.512 E F3(init)2.512 E F0 2.512(,t)C .012 +(he names of e)421.782 451.2 R .012(xtension initial-)-.15 F +(ization and \214nalization functions are printed as the)108 463.2 Q 2.5(ya) +-.15 G(re called.)322.26 463.2 Q .521(The remaining)108 480 R F3(ar)3.021 E(gs) +-.37 E F0 .522(are put into a list of strings, and the Scheme v)3.021 F +(ariable)-.25 E F2(command-line-ar)3.022 E(gs)-.1 E F0 .522(is bound to)3.022 F +.666(this list in the global en)108 492 R 3.166(vironment. If)-.4 F(ar)3.166 E +.666(guments could be interpreted as options, `\255)-.18 F .666 +(-\264 can be used to indi-).833 F(cate the end of the options.)108 504 Q F1 +(FILES)72 520.8 Q F0 25($TMPDIR/ldXXXXXX T)108 532.8 R(emporary \214les)-.7 E +F1 -.45(AU)72 549.6 S(THOR).45 E F0(Oli)108 561.6 Q -.15(ve)-.25 G 2.5(rL).15 G +(aumann)141.76 561.6 Q(15 January 1991)272.95 768 Q(1)535 768 Q EP +%%Trailer +end +%%EOF diff --git a/doc/man/scheme.1 b/doc/man/scheme.1 new file mode 100644 index 0000000..1210cb9 --- /dev/null +++ b/doc/man/scheme.1 @@ -0,0 +1 @@ +.so man1/elk.1 diff --git a/doc/oops/Makefile b/doc/oops/Makefile new file mode 100644 index 0000000..d6af8e9 --- /dev/null +++ b/doc/oops/Makefile @@ -0,0 +1,24 @@ +MANUAL= oops +TROFF= groff -ms -t +UNROFF= unroff -ms + +$(MANUAL).ps: $(MANUAL).ms index.ms + (cat $(MANUAL).ms ../util/tmac.index index.ms; echo ".Tc")\ + | $(TROFF) 2> /dev/null > $(MANUAL).ps + +$(MANUAL).html: $(MANUAL).ms + (cat $?; echo ".Tc") | $(UNROFF) document=$(MANUAL) + +index.ms: $(MANUAL).ms index.raw + sort -f -t# +1 -3 +0n index.raw | awk -f ../util/fixindex.awk\ + | awk -f ../util/block.awk >index.ms + +index.raw: $(MANUAL).ms + $(TROFF) $(MANUAL).ms 2> index.raw >/dev/null + +check: + checknr -c.Ul.Pr.Sy.Va.Sh.Ix.Id.Ch -a.Ss.Se.[[.]] $(MANUAL).ms |\ + grep -v "Empty command" + +clean: + rm -f index.raw index.ms $(MANUAL).ps $(MANUAL).html diff --git a/doc/oops/oops.ms b/doc/oops/oops.ms new file mode 100644 index 0000000..0b23b4e --- /dev/null +++ b/doc/oops/oops.ms @@ -0,0 +1,409 @@ +.so ../util/tmac.scheme +.Ul +.TL +The \s-1OOPS\s0 Package for Elk Scheme +.AU +Oliver Laumann +. +.Ch "Introduction" +. +.PP +The \s-1OOPS\s0 package provides a minimal set of tools that enables +a Scheme programmer to program in an object oriented style. +The functionality of \s-1OOPS\s0 is similar to that of packages like +\s-1CLOS\s0 and \s-1SCOOPS\s0, although the current version does +not support multiple inheritance. +The rest of this memo serves as a reference guide to the +\s-1OOPS\s0 package; the reader is assumed to be familiar with +the terminology of object oriented programming. +. +.Ch "Using \s-1OOPS\s0" +.LP +Programs that make use of the \s-1OOPS\s0 package should include +the line +.Ss +(require 'oops) +.Se +.Ix oops +Since this involves autoloading of an object file, it may be desirable +to dump Scheme after the \s-1OOPS\s0 package has been loaded. +. +.Ch "Defining Classes" +.PP +New classes are defined by means of the +.S define-class +.Id define-class +macro. +The syntax of +.S define-class +is +.Ss +(define-class \f2class-name\fP . \f2options\fP) +.Se +where \f2class-name\fP is a symbol. +\f2options\fP can be of the form +.Ss +(super-class \f2class-name\fP) +.Se +.Id super-class +where \f2class-name\fP is the name of the super-class (a symbol), +or +.Ss +(class-vars . \f2var-specs\fP) +.Se +.Id class-vars +or +.Ss +(instance-vars . \f2var-specs\fP) +.Se +.Id instance-vars +to specify the class variables +.Ix "class variables" +and instance variables +.Ix "instance variables" +of the newly defined class. +Each \f2var-spec\fP is either a symbol (the name of the variable) +or of the form +.Ss +(\f2symbol\fP \f2initializer\fP). +.Se +Variables for which no initializer has been specified are initialized +to the empty list. +The initializers +.Ix initializers +for class variables are evaluated immediately; +initializers for instance variables are evaluated each time an +instance of the newly defined class is created. +Evaluation of initializers is performed in a way that the +initializer of a variable can reference all variables appearing +at the left of the variable being initialized; for instance +.Ss +(define-class foo (class-vars (a 10) (b (* a 2)))) +.Se +would initialize the class variable +.S b +to 20. +.PP +A class inherits all class variables, instance variables, and +methods of its super-class. +When a class and its super-class each have an instance variable +with the same name, the corresponding \f2var-specs\fP must either +both have no initializer or initializers with the same value, +otherwise an ``initializer mismatch'' error is signaled by +.S define-class . +.PP +Each instance of a class has an instance variable named +.S self . +.Id self +The value of +.S self +is the instance with respect to which +.S self +is evaluated. +.S self +can be used by methods as the argument to +.S send +.Ix send +(see below) to invoke another method within the current instance. +.PP +.S define-class +does not have a meaningful return value, +instead it has a side-effect on the environment in which it +is invoked. +. +.Ch "Creating Instances of a Class" +.PP +The macro +.S make-instance +.Id make-instance +is used to create an instance of +a class; it returns the instance as its value. +The syntax is +.Ss +(make-instance \f2class\fP . \f2args\fP) +.Se +where \f2class\fP is the class of which an instance is to +be created. +Each \f2arg\fP of the form +.Ss +(\f2symbol\fP\ \f2initializer\fP) +.Se +where \f2symbol\fP is the name of an instance variable of the class, +is used to initialize the specified instance variable in the +newly created instance. +In this case the \f2initializer\fP supersedes any initializer +specified in the call to +.S define-class . +Thus it is possible to have instance variables with a \f2default +initializer\fP that can be overridden for individual instances. +The initializers are evaluated in the current environment. +.PP +.S make-instance +initializes the newly created instance by +invoking the +.S initialize-instance +.Id initialize-instance +method for the class +and all super-classes in super-class to sub-class order. +That is, the +.S initialize-instance +method of the class specified in the call to +.S make-instance +is called after all other +.S initialize-instance +methods. +The arguments passed to the +.S initialize-instance +method of a class are those arguments of the call to +.S make-instance +that do not represent an initialization form for an instance variable. +These arguments are evaluated in the current environment. +It is not required for a class to have an +.S initialize-instance +method. +.PP +Consider the following example: +.Ss +(require 'oops) +.sp .5 +(define-class c (instance-vars a)) +(define-class d (instance-vars (b 10)) (super-class c)) +.sp .5 +(define-method c (initialize-instance . args) + (print (cons 'c args))) +.sp .5 +(define-method d (initialize-instance . args) + (print (cons 'd args))) +.sp .5 +.Se +In this example evaluation of +.Ss +(define x 99) +(define i (make-instance d (a 20) 'foo (b x) x)) +.Se +would print +.Ss +(c foo 99) +(d foo 99) +.Se +.PP +Note that first the +.S initialize-instance +method of +.S c +is invoked and then that of the class +.S d . +The instance variables +.S a +and +.S b +would be initialized to 20 and 99, respectively. +. +.Ch "Defining Methods" +.PP +A new method can be defined by means of the +.S define-method +.Id define-method +macro. +The syntax is +.Ss +(define-method \f2class\fP \f2lambda-list\fP . \f2body\fP) +.Se +where \f2class\fP is the class to which the method is to be +added, \f2lambda-list\fP is a list specifying the method's +name and formal arguments (having the same syntax as the argument +of +.S define ). +.PP +.S define-method +simply creates a class-variable with the name +of the method, creates a lambda closure using the \f2lambda-list\fP +and the \f2body\fP forms, and binds the resulting procedure to +the newly-created variable. +When a message with the name of the method is sent to an instance +of the class, the method is invoked, and the \f2body\fP is evaluated +in the scope of the instance (so that it can access all instance +and class variables). +. +.Ch "Sending Messages" +.PP +A message can be sent to an instance by means of the function +.S send . +.Id send +The syntax of +.S send +is +.Ss +(send \f2instance\fP \f2message\fP . \f2args\fP) +.Se +where \f2instance\fP is the instance to which the message is +to be sent, \f2message\fP is the name of the method to be +invoked (a symbol), and \f2args\fP are the arguments to be +passed to the method. +Example: +.Ss +(define-class c (instance-vars a) (class-vars (b 10))) +.sp .5 +(define-method c (foo x) + (cons (set! a x) b)) ; set! returns previous value +.sp .5 +(define i (make-instance c (a 99))) +.sp +(send i 'foo 1) \f1returns (99 . 10)\fP +(send i 'foo 2) \f1returns (1 . 10)\fP +.Se +.PP +When a message is sent to an instance for which no method has +been defined, a ``message not understood'' error is signaled. +.PP +The function +.S send-if-handles +.Id send-if-handles +is identical to +.S send , +except that it returns a list of one element, the return value +of the method, or +.S #f +when the message is not understood by the instance. +. +.Ch "Evaluating Expressions within an Instance" +.PP +The macro +.S with-instance +.Id with-instance +can be used to evaluate expressions within the scope of an instance. +The syntax is +.Ss +(with-instance \f2instance\fP . \f2body\fP). +.Se +The \f2body\fP forms are evaluated in the same environment in +which a method of \f2instance\fP would be evaluated, +i.\|e. they can access all and class and instance variables +(including +.S self ). +.S with-instance +returns the value of the last \f2body\fP form. +Example: +.Ss +(define-class c (class-vars (x 5)) (instance-vars y)) +.sp .5 +(define i (make-instance c (y 1))) +.sp .5 +(define x 10) +(with-instance i (cons x y)) \f1returns (5 . 1)\fP +.Se +. +.Ch "Setting Instance and Class Variables" +.PP +Generally class and instance variables are manipulated by methods +or, if applicable, from within a +.S with-instance +form. +In addition, values can be assigned to class and instance variables +without involving a message send by means of the +.S instance-set! +.Id instance-set! +macro. +The syntax of +.S instance-set! +is +.Ss +(instance-set! \f2instance\fP \f2variable\fP \f2value\fP) +.Se +where \f2variable\fP is a symbol, the name of the class or +instance variable. +.S instance-set! +returns the previous value of the variable (like +.S set! ). +.PP +Class variables can be modified without involving an instance +of the class by means of the macro +.S class-set! : +.Id class-set! +.Ss +(class-set! \f2class\fP \f2variable\fP \f2value\fP). +.Se +\f2variable\fP must be the name of a class variable of \f2class\fP. +Note that one difference between +.Ss +(instance-set! i 'var x) +.Se +and +.Ss +(with-instance i (set! var x)) +.Se +is that in the former case +.S x +is evaluated in the current environment while in the latter case +.S x +is evaluated within the scope of the instance (here +.S x +might be a class or instance variable). +. +.Ch "Obtaining Information about Classes and Instances" +.PP +The function +.S class-name +.Id class-name +returns the name of a class (a symbol) or, when applied to an instance, +the name of the class of which it is an instance. +.PP +The predicate +.S method-known? +.Id method-known? +can be used to check whether a method of a given name is known to a class. +The syntax is +.Ss +(method-known? \f2method\fP \f2class\fP) +.Se +where \f2method\fP is a symbol. +.PP +The type predicates +.S class? +.Id class? +and +.S instance? +.Id instance? +can be used to check whether an object is a class or an instance, +respectively. +.PP +The functions +.Ss +(check-class \f2symbol\fP \f2object\fP) +.Se +.Id check-class +and +.Ss +(check-instance \f2symbol\fP \f2object\fP) +.Se +.Id check-instance +check whether \f2object\fP is a class (i.\|e. satisfies the predicate +.S class? ) +or an instance, respectively, and, if not, signal an error; +in this case \f2symbol\fP is used as the first argument to +.S error . +.PP +The functions +.S describe-class +.Id describe-class +and +.S describe-instance +.Id describe-instance +print the components (name, class/instance variables, etc.) of +a class or instance, respectively. +The function +.S describe +.Id describe +has been extended in way that when +.S "(feature? 'oops)" +is true, +.S describe-class +or +.S describe-instance +are called when +.S describe +is applied to an object that satisfies +.S class? +or +.S instance? , +respectively. diff --git a/doc/oops/oops.ps b/doc/oops/oops.ps new file mode 100644 index 0000000..1917e01 --- /dev/null +++ b/doc/oops/oops.ps @@ -0,0 +1,624 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 7 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier@0 ENC0/Courier RE/Times-Roman@0 +ENC0/Times-Roman RE/Times-Italic@0 ENC0/Times-Italic RE/Times-Bold@0 ENC0 +/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(The)198.071 120 Q/F1 11/Times-Bold@0 SF(OOPS)3 E F0 -.12 +(Pa)3 G(ckage f).12 E(or Elk Scheme)-.3 E/F2 10/Times-Italic@0 SF +(Oliver Laumann)255.085 144 Q F1 2.75(1. Intr)72 216 R(oduction)-.198 E/F3 11 +/Times-Roman@0 SF(The)97 234.6 Q/F4 10/Times-Roman@0 SF(OOPS)3.866 E F3 1.116 +(package pro)3.866 F 1.115 +(vides a minimal set of tools that enables a Scheme programmer to)-.165 F .357 +(program in an object oriented style.)72 249.6 R .357(The functionality of) +5.857 F F4(OOPS)3.107 E F3 .357(is similar to that of packages lik)3.107 F(e) +-.11 E F4(CLOS)72 264.6 Q F3(and)3.342 E F4(SCOOPS)3.342 E F3 3.342(,a)C .592 +(lthough the current v)168.894 264.6 R .592 +(ersion does not support multiple inheritance.)-.165 F .592(The rest)6.092 F +.261(of this memo serv)72 279.6 R .261(es as a reference guide to the)-.165 F +F4(OOPS)3.012 E F3 .262(package; the reader is assumed to be f)3.012 F(amil-) +-.11 E(iar with the terminology of object oriented programming.)72 294.6 Q F1 +2.75(2. Using)72 324.6 R/F5 10/Times-Bold@0 SF(OOPS)2.75 E F3 +(Programs that mak)72 343.2 Q 2.75(eu)-.11 G(se of the)168.129 343.2 Q F4(OOPS) +2.75 E F3(package should include the line)2.75 E/F6 10/Courier@0 SF +(\(require 'oops\))100.346 365.703 Q F3 1.178(Since this in)72 387.703 R -.22 +(vo)-.44 G(lv).22 E 1.177(es autoloading of an object \214le, it may be desira\ +ble to dump Scheme after the)-.165 F F4(OOPS)72 402.703 Q F3 +(package has been loaded.)2.75 E F1 2.75(3. De\214ning)72 432.703 R(Classes) +2.75 E F3(Ne)97 451.303 Q 3.323(wc)-.275 G .573 +(lasses are de\214ned by means of the)125.7 451.303 R F6(define-class)3.324 E +F3 3.324(macro. The)6.574 F .574(syntax of)3.324 F F6(define-)3.324 E(class)72 +466.303 Q F3(is)6 E F6(\(define-class)100.346 488.806 Q F2(class-name)6 E F6(.) +6 E F2(options)6 E F6(\))A F3(where)72 510.806 Q/F7 11/Times-Italic@0 SF +(class-name)2.75 E F3(is a symbol.)2.75 E F7(options)5.5 E F3 +(can be of the form)2.75 E F6(\(super-class)100.346 533.309 Q F2(class-name)6 E +F6(\))A F3(where)72 555.309 Q F7(class-name)2.75 E F3(is the name of the super) +2.75 E(-class \(a symbol\), or)-.22 E F6(\(class-vars .)100.346 577.812 Q F2 +(var)6 E(-specs)-.2 E F6(\))A F3(or)72 599.812 Q F6(\(instance-vars .)100.346 +622.315 Q F2(var)6 E(-specs)-.2 E F6(\))A F3 .623(to specify the class v)72 +644.315 R .623(ariables and instance v)-.275 F .622(ariables of the ne)-.275 F +.622(wly de\214ned class.)-.275 F(Each)6.122 E F7(var)3.372 E(-spec)-.22 E F3 +(is)3.372 E(either a symbol \(the name of the v)72 659.315 Q +(ariable\) or of the form)-.275 E F6(\()100.346 681.818 Q F2 3.5 +(symbol initializer)B F6(\).)A F3 -1.221(Va)72 703.818 S .143(riables for whic\ +h no initializer has been speci\214ed are initialized to the empty list.)1.221 +F .143(The initializ-)5.643 F .805(ers for class v)72 718.818 R .805 +(ariables are e)-.275 F -.275(va)-.275 G .804 +(luated immediately; initializers for instance v).275 F .804(ariables are e) +-.275 F -.275(va)-.275 G(luated).275 E .059(each time an instance of the ne)72 +733.818 R .059(wly de\214ned class is created.)-.275 F(Ev)5.559 E .06 +(aluation of initializers is performed)-.275 F EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL 1.161(in a w)72 87 R 1.161(ay that the initializer of a v)-.11 F +1.161(ariable can reference all v)-.275 F 1.161 +(ariables appearing at the left of the)-.275 F -.275(va)72 102 S +(riable being initialized; for instance).275 E/F1 10/Courier@0 SF +(\(define-class foo \(class-vars \(a 10\) \(b \(* a 2\)\)\)\))100.346 124.503 Q +F0 -.11(wo)72 146.503 S(uld initialize the class v).11 E(ariable)-.275 E F1(b) +2.75 E F0(to 20.)6 E 2.979(Ac)97 165.103 S .229(lass inherits all class v) +112.805 165.103 R .229(ariables, instance v)-.275 F .23 +(ariables, and methods of its super)-.275 F 2.98(-class. When)-.22 F 3.342(ac) +72 180.103 S .592(lass and its super)85.11 180.103 R .592(-class each ha)-.22 F +.922 -.165(ve a)-.22 H 3.342(ni).165 G .592(nstance v)253.913 180.103 R .591 +(ariable with the same name, the corresponding)-.275 F/F2 11/Times-Italic@0 SF +(var)72 195.103 Q(-specs)-.22 E F0 1.525(must either both ha)4.275 F 1.855 +-.165(ve n)-.22 H 4.276(oi).165 G 1.526 +(nitializer or initializers with the same v)240.024 195.103 R 1.526 +(alue, otherwise an)-.275 F -.814(``)72 210.103 S(initializer mismatch').814 E +2.75('e)-.814 G(rror is signaled by)180.35 210.103 Q F1(define-class)2.75 E F0 +(.)A 1.038(Each instance of a class has an instance v)97 228.703 R 1.038 +(ariable named)-.275 F F1(self)3.788 E F0 6.538(.T)C 1.038(he v)393.933 228.703 +R 1.038(alue of)-.275 F F1(self)3.788 E F0 1.038(is the)7.038 F 1.072 +(instance with respect to which)72 243.703 R F1(self)3.822 E F0 1.072(is e) +7.072 F -.275(va)-.275 G(luated.).275 E F1(self)6.572 E F0 1.072 +(can be used by methods as the ar)7.072 F(gu-)-.198 E(ment to)72 258.703 Q F1 +(send)2.75 E F0(\(see belo)6 E(w\) to in)-.275 E -.22(vo)-.44 G .22 -.11(ke a) +.22 H(nother method within the current instance.).11 E F1(define-class)97 +277.303 Q F0 .263(does not ha)6.263 F .593 -.165(ve a m)-.22 H .263 +(eaningful return v).165 F .262(alue, instead it has a side-ef)-.275 F .262 +(fect on the)-.275 F(en)72 292.303 Q(vironment in which it is in)-.44 E -.22 +(vo)-.44 G -.11(ke).22 G(d.).11 E/F3 11/Times-Bold@0 SF 2.75(4. Cr)72 322.303 R +(eating Instances of a Class)-.198 E F0 .434(The macro)97 340.903 R F1 +(make-instance)3.184 E F0 .435 +(is used to create an instance of a class; it returns the instance)6.434 F +(as its v)72 355.903 Q 2.75(alue. The)-.275 F(syntax is)2.75 E F1 +(\(make-instance)100.346 378.406 Q/F4 10/Times-Italic@0 SF(class)6 E F1(.)6 E +F4(ar)6 E(gs)-.37 E F1(\))A F0(where)72 400.406 Q F2(class)2.75 E F0 +(is the class of which an instance is to be created.)2.75 E(Each)5.5 E F2(ar) +2.75 E(g)-.407 E F0(of the form)2.75 E F1(\()100.346 422.909 Q F4 3.5 +(symbol initializer)B F1(\))A F0(where)72 444.909 Q F2(symbol)3.81 E F0 1.06 +(is the name of an instance v)3.81 F 1.059 +(ariable of the class, is used to initialize the speci\214ed)-.275 F .532 +(instance v)72 459.909 R .532(ariable in the ne)-.275 F .532 +(wly created instance.)-.275 F .533(In this case the)6.032 F F2(initializer) +3.283 E F0 .533(supersedes an)3.283 F 3.283(yi)-.165 G(nitial-)477.721 459.909 +Q .506(izer speci\214ed in the call to)72 474.909 R F1(define-class)3.256 E F0 +6.006(.T)C .505(hus it is possible to ha)281.049 474.909 R .835 -.165(ve i)-.22 +H .505(nstance v).165 F .505(ariables with a)-.275 F F2 .253 +(default initializer)72 489.909 R F0 .253(that can be o)3.003 F -.165(ve)-.165 +G .254(rridden for indi).165 F .254(vidual instances.)-.275 F .254 +(The initializers are e)5.754 F -.275(va)-.275 G .254(luated in).275 F +(the current en)72 504.909 Q(vironment.)-.44 E F1(make-instance)97 523.509 Q F0 +2.386(initializes the ne)8.386 F 2.385(wly created instance by in)-.275 F -.22 +(vo)-.44 G 2.385(king the).22 F F1(initialize-)5.135 E(instance)72 538.509 Q F0 +.889(method for the class and all super)6.889 F .889(-classes in super)-.22 F +.889(-class to sub-class order)-.22 F 6.39(.T)-.605 G .89(hat is,)476.831 +538.509 R(the)72 553.509 Q F1(initialize-instance)4.183 E F0 1.432 +(method of the class speci\214ed in the call to)7.432 F F1(make-instance)4.182 +E F0(is)7.432 E 2.148(called after all other)72 568.509 R F1 +(initialize-instance)4.899 E F0 4.899(methods. The)8.149 F(ar)4.899 E 2.149 +(guments passed to the)-.198 F F1(ini-)4.899 E(tialize-instance)72 583.509 Q F0 +.115(method of a class are those ar)6.115 F .115(guments of the call to)-.198 F +F1(make-instance)2.864 E F0(that)6.114 E .381 +(do not represent an initialization form for an instance v)72 598.509 R 3.132 +(ariable. These)-.275 F(ar)3.132 E .382(guments are e)-.198 F -.275(va)-.275 G +.382(luated in).275 F 2.601(the current en)72 613.509 R 5.351(vironment. It) +-.44 F 2.6(is not required for a class to ha)5.351 F 2.93 -.165(ve a)-.22 H(n) +.165 E F1(initialize-instance)5.35 E F0(method.)72 628.509 Q +(Consider the follo)97 647.109 Q(wing e)-.275 E(xample:)-.165 E EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(require 'oops\))100.346 94.503 Q +(\(define-class c \(instance-vars a\)\))100.346 115.503 Q +(\(define-class d \(instance-vars \(b 10\)\) \(super-class c\)\))100.346 +129.503 Q(\(define-method c \(initialize-instance . args\))100.346 150.503 Q +(\(print \(cons 'c args\)\)\))112.346 164.503 Q +(\(define-method d \(initialize-instance . args\))100.346 185.503 Q +(\(print \(cons 'd args\)\)\))112.346 199.503 Q F0(In this e)72 228.503 Q +(xample e)-.165 E -.275(va)-.275 G(luation of).275 E F1(\(define x 99\))100.346 +251.006 Q(\(define i \(make-instance d \(a 20\) 'foo \(b x\) x\)\))100.346 +265.006 Q F0 -.11(wo)72 287.006 S(uld print).11 E F1(\(c foo 99\))100.346 +309.509 Q(\(d foo 99\))100.346 323.509 Q F0 1.104(Note that \214rst the)97 +349.109 R F1(initialize-instance)3.854 E F0 1.104(method of)7.104 F F1(c)3.854 +E F0 1.104(is in)7.104 F -.22(vo)-.44 G -.11(ke).22 G 3.854(da).11 G 1.104 +(nd then that of the)419.537 349.109 R(class)72 364.109 Q F1(d)2.75 E F0 5.5 +(.T)C(he instance v)117.105 364.109 Q(ariables)-.275 E F1(a)2.75 E F0(and)6 E +F1(b)2.75 E F0 -.11(wo)6 G(uld be initialized to 20 and 99, respecti).11 E +-.165(ve)-.275 G(ly).165 E(.)-.715 E/F2 11/Times-Bold@0 SF 2.75(5. De\214ning) +72 394.109 R(Methods)2.75 E F0 2.75(An)97 412.709 S .55 -.275(ew m)113.192 +412.709 T(ethod can be de\214ned by means of the).275 E F1(define-method)2.75 E +F0 2.75(macro. The)6 F(syntax is)2.75 E F1(\(define-method)100.346 435.212 Q/F3 +10/Times-Italic@0 SF 3.5(class lambda-list)6 F F1(.)6 E F3(body)6 E F1(\))A F0 +(where)72 457.212 Q/F4 11/Times-Italic@0 SF(class)3.819 E F0 1.068 +(is the class to which the method is to be added,)3.818 F F4(lambda-list)3.818 +E F0 1.068(is a list specifying the)3.818 F(method')72 472.212 Q 2.75(sn)-.605 +G(ame and formal ar)120.587 472.212 Q(guments \(ha)-.198 E +(ving the same syntax as the ar)-.22 E(gument of)-.198 E F1(define)2.75 E F0 +(\).)A F1(define-method)97 490.812 Q F0 1.381(simply creates a class-v)7.381 F +1.381(ariable with the name of the method, creates a)-.275 F .163 +(lambda closure using the)72 505.812 R F4(lambda-list)2.913 E F0 .163(and the) +2.913 F F4(body)2.913 E F0 .162 +(forms, and binds the resulting procedure to the)2.913 F(ne)72 520.812 Q .953 +(wly-created v)-.275 F 3.703(ariable. When)-.275 F 3.703(am)3.703 G .953 +(essage with the name of the method is sent to an instance of)229.207 520.812 R +.504(the class, the method is in)72 535.812 R -.22(vo)-.44 G -.11(ke).22 G .504 +(d, and the).11 F F4(body)3.254 E F0 .504(is e)3.254 F -.275(va)-.275 G .503 +(luated in the scope of the instance \(so that it).275 F +(can access all instance and class v)72 550.812 Q(ariables\).)-.275 E F2 2.75 +(6. Sending)72 580.812 R(Messages)2.75 E F0 3.327(Am)97 599.412 S .577 +(essage can be sent to an instance by means of the function)116.827 599.412 R +F1(send)3.328 E F0 6.078(.T)C .578(he syntax of)421.748 599.412 R F1(send)3.328 +E F0(is)72 614.412 Q F1(\(send)100.346 636.915 Q F3 3.5(instance messa)6 F -.1 +(ge)-.1 G F1(.)6.1 E F3(ar)6 E(gs)-.37 E F1(\))A F0(where)72 658.915 Q F4 +(instance)4.138 E F0 1.388(is the instance to which the message is to be sent,) +4.138 F F4(messa)4.137 E -.11(ge)-.11 G F0 1.387(is the name of the)4.247 F +.332(method to be in)72 673.915 R -.22(vo)-.44 G -.11(ke).22 G 3.082(d\().11 G +3.082(as)174.605 673.915 S .332(ymbol\), and)186.85 673.915 R F4(ar)3.082 E(gs) +-.407 E F0 .332(are the ar)3.082 F .333(guments to be passed to the method.) +-.198 F(Exam-)5.833 E(ple:)72 688.915 Q EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF +(\(define-class c \(instance-vars a\) \(class-vars \(b 10\)\)\))100.346 94.503 +Q(\(define-method c \(foo x\))100.346 115.503 Q(\(cons \(set! a x\) b\)\)) +112.346 129.503 Q 6(;s)262.346 129.503 S(et! returns previous value)280.346 +129.503 Q(\(define i \(make-instance c \(a 99\)\)\))100.346 150.503 Q +(\(send i 'foo 1\))100.346 178.503 Q/F2 10/Times-Roman@0 SF 2.5(returns \(99) +250.346 178.503 R 2.5(.1)2.5 G(0\))308.946 178.503 Q F1(\(send i 'foo 2\)) +100.346 192.503 Q F2 2.5(returns \(1)250.346 192.503 R 2.5(.1)2.5 G(0\))303.946 +192.503 Q F0 .725(When a message is sent to an instance for which no method ha\ +s been de\214ned, a `)97 218.103 R(`message)-.814 E(not understood')72 233.103 +Q 2.75('e)-.814 G(rror is signaled.)151.838 233.103 Q 1.132(The function)97 +251.703 R F1(send-if-handles)3.883 E F0 1.133(is identical to)7.133 F F1(send) +3.883 E F0 3.883(,e)C 1.133(xcept that it returns a list of one)356.446 251.703 +R 2.197(element, the return v)72 266.703 R 2.196(alue of the method, or)-.275 F +F1(#f)4.946 E F0 2.196(when the message is not understood by the)8.196 F +(instance.)72 281.703 Q/F3 11/Times-Bold@0 SF 2.75(7. Ev)72 311.703 R +(aluating Expr)-.11 E(essions within an Instance)-.198 E F0 1.355(The macro)97 +330.303 R F1(with-instance)4.105 E F0 1.355(can be used to e)7.355 F -.275(va) +-.275 G 1.355(luate e).275 F 1.356(xpressions within the scope of an)-.165 F +2.75(instance. The)72 345.303 R(syntax is)2.75 E F1(\(with-instance)100.346 +367.806 Q/F4 10/Times-Italic@0 SF(instance)6 E F1(.)6 E F4(body)6 E F1(\).)A F0 +(The)72 389.806 Q/F5 11/Times-Italic@0 SF(body)3.508 E F0 .758(forms are e) +3.508 F -.275(va)-.275 G .758(luated in the same en).275 F .757 +(vironment in which a method of)-.44 F F5(instance)3.507 E F0 -.11(wo)3.507 G +.757(uld be).11 F -.275(eva)72 404.806 S 2.035(luated, i.).275 F 2.035(e. the) +1.833 F 4.786(yc)-.165 G 2.036(an access all and class and instance v)169.644 +404.806 R 2.036(ariables \(including)-.275 F F1(self)4.786 E F0(\).)A F1(with-) +7.536 E(instance)72 419.806 Q F0(returns the v)6 E(alue of the last)-.275 E F5 +(body)2.75 E F0 2.75(form. Example:)2.75 F F1 +(\(define-class c \(class-vars \(x 5\)\) \(instance-vars y\)\))100.346 442.309 +Q(\(define i \(make-instance c \(y 1\)\)\))100.346 463.309 Q(\(define x 10\)) +100.346 484.309 Q(\(with-instance i \(cons x y\)\))100.346 498.309 Q F2 2.5 +(returns \(5)328.346 498.309 R 2.5(.1)2.5 G(\))381.946 498.309 Q F3 2.75 +(8. Setting)72 535.309 R(Instance and Class V)2.75 E(ariables)-1.012 E F0 1.187 +(Generally class and instance v)97 553.909 R 1.187 +(ariables are manipulated by methods or)-.275 F 3.937(,i)-.44 G 3.937(fa) +423.119 553.909 S 1.187(pplicable, from)435.603 553.909 R .761(within a)72 +568.909 R F1(with-instance)3.511 E F0 3.511(form. In)6.761 F .762(addition, v) +3.511 F .762(alues can be assigned to class and instance v)-.275 F(ari-)-.275 E +.649(ables without in)72 583.909 R -.22(vo)-.44 G .648 +(lving a message send by means of the).22 F F1(instance-set!)3.398 E F0 3.398 +(macro. The)418.389 583.909 R(syntax)3.398 E(of)72 598.909 Q F1(instance-set!) +2.75 E F0(is)173.913 598.909 Q F1(\(instance-set!)100.346 621.412 Q F4 3.5 +(instance variable value)6 F F1(\))A F0(where)72 643.412 Q F5(variable)5.844 E +F0 3.094(is a symbol, the name of the class or instance v)5.844 F(ariable.) +-.275 E F1(instance-set!)8.595 E F0(returns the pre)72 658.412 Q(vious v)-.275 +E(alue of the v)-.275 E(ariable \(lik)-.275 E(e)-.11 E F1(set!)2.75 E F0(\).)A +.697(Class v)97 677.012 R .697(ariables can be modi\214ed without in)-.275 F +-.22(vo)-.44 G .696(lving an instance of the class by means of the).22 F(macro) +72 692.012 Q F1(class-set!)2.75 E F0(:)A EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(class-set!)100.346 94.503 Q/F2 10 +/Times-Italic@0 SF 3.5(class variable value)6 F F1(\).)A/F3 11/Times-Italic@0 +SF(variable)72 116.503 Q F0(must be the name of a class v)2.75 E(ariable of) +-.275 E F3(class)2.75 E F0 5.5(.N)C(ote that one dif)323.152 116.503 Q +(ference between)-.275 E F1(\(instance-set! i 'var x\))100.346 139.006 Q F0 +(and)72 161.006 Q F1(\(with-instance i \(set! var x\)\))100.346 183.509 Q F0 +.735(is that in the former case)72 205.509 R F1(x)3.486 E F0 .736(is e)6.736 F +-.275(va)-.275 G .736(luated in the current en).275 F .736 +(vironment while in the latter case)-.44 F F1(x)3.486 E F0(is)6.736 E -.275 +(eva)72 220.509 S(luated within the scope of the instance \(here).275 E F1(x) +2.75 E F0(might be a class or instance v)6 E(ariable\).)-.275 E/F4 11 +/Times-Bold@0 SF 2.75(9. Obtaining)72 250.509 R(Inf)2.75 E +(ormation about Classes and Instances)-.275 E F0 .951(The function)97 269.109 R +F1(class-name)3.701 E F0 .95(returns the name of a class \(a symbol\) or)6.951 +F 3.7(,w)-.44 G .95(hen applied to an)425.69 269.109 R +(instance, the name of the class of which it is an instance.)72 284.109 Q .615 +(The predicate)97 302.709 R F1(method-known?)3.365 E F0 .615 +(can be used to check whether a method of a gi)251.765 302.709 R -.165(ve)-.275 +G 3.366(nn).165 G(ame)485.674 302.709 Q(is kno)72 317.709 Q(wn to a class.) +-.275 E(The syntax is)5.5 E F1(\(method-known?)100.346 340.212 Q F2 3.5 +(method class)6 F F1(\))A F0(where)72 362.212 Q F3(method)2.75 E F0 +(is a symbol.)2.75 E .244(The type predicates)97 380.812 R F1(class?)2.994 E F0 +(and)234.867 380.812 Q F1(instance?)2.994 E F0 .244 +(can be used to check whether an object is)319.989 380.812 R 2.75(ac)72 395.812 +S(lass or an instance, respecti)84.518 395.812 Q -.165(ve)-.275 G(ly).165 E(.) +-.715 E(The functions)97 414.412 Q F1(\(check-class)100.346 436.915 Q F2 3.5 +(symbol object)6 F F1(\))A F0(and)72 458.915 Q F1(\(check-instance)100.346 +481.418 Q F2 3.5(symbol object)6 F F1(\))A F0 .831(check whether)72 503.418 R +F3(object)3.581 E F0 .831(is a class \(i.)3.581 F .832 +(e. satis\214es the predicate)1.833 F F1(class?)3.582 E F0 3.582(\)o)C 3.582 +(ra)385.663 503.418 S 3.582(ni)397.792 503.418 S .832(nstance, respecti)409.932 +503.418 R -.165(ve)-.275 G(ly).165 E(,)-.715 E +(and, if not, signal an error; in this case)72 518.418 Q F3(symbol)2.75 E F0 +(is used as the \214rst ar)2.75 E(gument to)-.198 E F1(error)2.75 E F0(.)A .119 +(The functions)97 537.018 R F1(describe-class)2.869 E F0(and)6.118 E F1 +(describe-instance)2.868 E F0 .118(print the components \(name,)6.118 F 1.376 +(class/instance v)72 552.018 R 1.376 +(ariables, etc.\) of a class or instance, respecti)-.275 F -.165(ve)-.275 G(ly) +.165 E 6.877(.T)-.715 G 1.377(he function)378.659 552.018 R F1(describe)4.127 E +F0(has)7.377 E 4.931(been e)72 567.018 R 4.931(xtended in w)-.165 F 4.93 +(ay that when)-.11 F F1 4.93(\(feature? 'oops\))7.68 F F0 4.93(is true,)357.355 +567.018 R F1(describe-class)7.68 E F0(or)494.837 567.018 Q F1 +(describe-instance)72 582.018 Q F0 .507(are called when)6.507 F F1(describe) +3.257 E F0 .508(is applied to an object that satis\214es)6.507 F F1(class?) +3.258 E F0(or)72 597.018 Q F1(instance?)2.75 E F0 2.75(,r)C(especti)147.076 +597.018 Q -.165(ve)-.275 G(ly).165 E(.)-.715 E EP +%%Page: 6 6 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 13/Times-Bold@0 SF(Index)272.108 123 Q(C)72 174 Q F0 +(check-class,)72 204 Q/F2 12/Times-Bold@0 SF(5)2.75 E F0(check-instance,)72 219 +Q F2(5)2.75 E F0(class v)72 234 Q(ariables, 1)-.275 E(class-name,)72 249 Q F2 +(5)2.75 E F0(class-set!,)72 264 Q F2(4)2.75 E F0(class-v)72 279 Q(ars,)-.275 E +F2(1)2.75 E F0(class?,)72 294 Q F2(5)2.75 E F1(D)72 324 Q F0(de\214ne-class,)72 +354 Q F2(1)2.75 E F0(de\214ne-method,)72 369 Q F2(3)2.75 E F0(describe,)72 384 +Q F2(5)2.75 E F0(describe-class,)72 399 Q F2(5)2.75 E F0(describe-instance,)72 +414 Q F2(5)2.75 E F1(I)72 444 Q F0(initialize-instance,)72 474 Q F2(2)2.75 E F0 +(initializers, 1)72 489 Q(instance v)72 504 Q(ariables, 1)-.275 E +(instance-set!,)72 519 Q F2(4)2.75 E F0(instance-v)72 534 Q(ars,)-.275 E F2(1) +2.75 E F0(instance?,)72 549 Q F2(5)2.75 E F1(M)72 579 Q F0(mak)72 609 Q +(e-instance,)-.11 E F2(2)2.75 E F0(method-kno)72 624 Q(wn?,)-.275 E F2(5)2.75 E +F1(O)72 654 Q F0(oops, 1)302.4 174 Q F1(S)302.4 204 Q F0(self,)302.4 234 Q F2 +(2)2.75 E F0(send, 2,)302.4 249 Q F2(3)2.75 E F0(send-if-handles,)302.4 264 Q +F2(4)2.75 E F0(super)302.4 279 Q(-class,)-.22 E F2(1)2.75 E F1(W)302.4 309 Q F0 +(with-instance,)302.4 339 Q F2(4)2.75 E EP +%%Page: 7 7 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 13/Times-Bold@0 SF -1.196(Ta)239.127 123 S(ble of Contents)1.196 E/F1 11 +/Times-Roman@0 SF .866(Introduction ..........................................\ +..............................................................................\ +......)72 177.6 R(1)498.5 177.6 Q(Using)72 196.2 Q/F2 10/Times-Roman@0 SF(OOPS) +2.75 E F1 19.25(..............................................................\ +................................................................ 1)3.411 F +(De\214ning Classes)72 214.8 Q 19.25(.........................................\ +..............................................................................\ + 1)3 F(Creating Instances of a Class)72 233.4 Q 19.25(........................\ +........................................................................... 2) +4.551 F(De\214ning Methods)72 252 Q 19.25(....................................\ +..............................................................................\ +... 3)3 F(Sending Messages)72 270.6 Q 19.25(..................................\ +..............................................................................\ +.... 3)3.924 F(Ev)72 289.2 Q(aluating Expressions within an Instance)-.275 E +19.25(........................................................................\ +...... 4)3.297 F(Setting Instance and Class V)72 307.8 Q .272(ariables .......\ +..............................................................................\ +...)-1.221 F(4)498.5 307.8 Q(Obtaining Information about Classes and Instances) +72 326.4 Q 19.25 +(................................................................ 5)3.946 F +(Inde)72 345 Q 2.868(x.)-.165 G 19.25(........................................\ +..............................................................................\ +.................. 6)102.5 345 R EP +%%Trailer +end +%%EOF diff --git a/doc/record/Makefile b/doc/record/Makefile new file mode 100644 index 0000000..a7d8e05 --- /dev/null +++ b/doc/record/Makefile @@ -0,0 +1,24 @@ +MANUAL= record +TROFF= groff -ms -t +UNROFF= unroff -ms + +$(MANUAL).ps: $(MANUAL).ms index.ms + (cat $(MANUAL).ms ../util/tmac.index index.ms; echo ".Tc")\ + | $(TROFF) 2> /dev/null > $(MANUAL).ps + +$(MANUAL).html: $(MANUAL).ms + (cat $?; echo ".Tc") | $(UNROFF) document=$(MANUAL) + +index.ms: $(MANUAL).ms index.raw + sort -f -t# +1 -3 +0n index.raw | awk -f ../util/fixindex.awk\ + | awk -f ../util/block.awk >index.ms + +index.raw: $(MANUAL).ms + $(TROFF) $(MANUAL).ms 2> index.raw >/dev/null + +check: + checknr -c.Ul.Pr.Sy.Va.Sh.Ix.Id.Ch -a.Ss.Se.[[.]] $(MANUAL).ms |\ + grep -v "Empty command" + +clean: + rm -f index.raw index.ms $(MANUAL).ps $(MANUAL).html diff --git a/doc/record/record.ms b/doc/record/record.ms new file mode 100644 index 0000000..cc33cae --- /dev/null +++ b/doc/record/record.ms @@ -0,0 +1,345 @@ +.so ../util/tmac.scheme +.Ul +.TL +Reference Manual for the +.sp .5 +Elk Record Extension +.AU +Oliver Laumann +. +.Ch "Introduction" +. +.PP +The record extension to Elk allows Scheme applications to define +.Ix "record data type" +record data types (similar to, although less powerful than, +Common Lisp +.Ix structures +\f2structures\fP). +.PP +A record type can be instantiated to obtain a new +.Ix record +record (a member of the given record type). +Each record is a collection of named +.Ix fields +fields that can hold arbitrary Scheme objects. +Records are first-class Scheme objects; they are members of the +\f2record\fP data type that is disjoint from all other Scheme types. +Record types are first-class objects as well; each record type is a +member of the \f2record-type\fP Scheme data type. +.PP +The record extension provides facilities to define new record types, +create +.Ix instances +instances of existing record types, define +.Ix accessor +accessor and +.Ix modifier +modifier functions to read and write the fields of records of a +given type, and +.Ix "type predicate" +type predicates for the \f2record\fP and \f2record-type\fP data types. +.PP +In addition, the extension provides +.Ix macros +macros that simplify the definition of +.Ix constructor +constructor, accessor and modifier functions for a newly defined record type. +. +.Ch "Using the Record Extension" +. +.PP +The record extension is loaded by evaluating +.Ss +(require 'record) +.Se +in the interactive toplevel or in a Scheme program. +.PP +This causes the files +.Ix record.scm +\f2record.scm\fP and +.Ix record.o +\f2record.o\fP to be loaded into the interpreter (\f2record.o\fP has to +be linked with the interpreter on platforms that do not support dynamic +loading of object files). +.PP +Loading the record extension causes the +.Ix feature +features \f2record\fP and \f2record.o\fP to be provided. +. +.Ch "Record Types" +. +.Pr make-record-type type-name fields +.LP +\f2make-record-type\fP creates a new +.Ix "record type" +record type. +\f2type-name\fP (a string or a symbol) is the name of the record type; +it is used in the printed representation of the record type and of +records belonging to the new type. +If \f2type-name\fP is a symbol, it is converted into a string first. +.Ix fields +\f2fields\fP is a list of symbols naming the fields of a record of +the new type. +An error is signaled of the list contains duplicate names. +.LP +\f2make-record-type\fP returns the new record type (an object of the +Scheme type \f2record-type\fP). +.LP +Example: +.Ss +(define time-record + (make-record-type 'time '(hours minutes seconds))) +.Se +. +.Pr record-type? obj +.LP +This +.Ix "type predicate" +type predicate returns #t if \f2obj\fP is a \f2record-type\fP +object (i.\|e.\& the return value of a call to \f2make-record-type\fP), +#f otherwise. +. +.Pr record-type-name rt +.LP +This procedure returns the +.Ix "type name" +type name (a string) of the record type \f2rt\fP, +i.\|e.\& the \f2type-name\fP argument that was supplied to the call +to \f2make-record-type\fP that created the record type \f2rt\fP. +. +.Pr record-type-field-names rt +.LP +\f2record-type-field-names\fP returns the list of +.Ix "field names" +field names associated with the record type \f2rt\fP (a list of +symbols), i.\|e.\& the \f2fields\fP argument that was given in the call to +.Ix make-record-type +\f2make-record-type\fP that created \f2rt\fP. +. +.[[ +.Pr record-constructor rt fields +.Pr record-constructor rt +.]] +.LP +\f2record-constructor\fP returns a procedure for creating +.Ix instances +instances of the record type \f2rt\fP. +.LP +The returned procedure accepts as many arguments as there are symbols +in the list \f2fields\fP; these arguments are used as the initial +values of those +.Ix fields +fields in the newly created record instance. +The values of any fields for which no +.Ix "initial value" +initial value is specified (i.\|e. +that are not present in \f2fields\fP) are undefined. +If the \f2fields\fP argument is omitted, the field names that were given +as an argument in the call to +.Ix make-record-type +\f2make-record-type\fP that created the record type \f2rt\fP are used instead. +.LP +Example: +.Ss +(define make-time + (record-constructor time-record)) +(define noon (make-time 12 0 0)) +.sp .5 +(define make-uninitialized-time + (record-constructor time-record '())) +.Se +. +.Pr record-predicate rt +.LP +\f2record-predicate\fP returns a procedure for testing membership +in the record type \f2rt\fP. +The returned procedure accepts one argument and returns #t if the +argument is a member of the record type \f2rt\fP (i.\|e.\& if it +has been created by invoking a constructor returned by calling +.Ix record constructor +\f2record-constructor\fP with \f2rt\fP as an argument), #f otherwise. +. +.Pr record-accessor rt field +.LP +\f2record-accessor\fP returns a procedure for reading the value of the +.Ix field +field named by \f2field\fP of a member of the record type \f2rt\fP. +The returned procedure accepts one argument, which must be a record +of the record type \f2rt\fP; it returns the current value of the +specified field in that record. +\f2field\fP must be a member of the list of field names that was supplied +to the call to +.Ix make-record-type +\f2make-record-type\fP that created \f2rt\fP. +.LP +Example: +.Ss +(define time-hours + (record-accessor time-record 'hours)) +.sp .5 +(define noon ((record-constructor time-record) 12 0 0)) +(time-hours noon) \f2\(-> 12\fP +.Se +. +.Pr record-modifier rt field +.LP +\f2record-modifier\fP returns a procedure for writing the value of the +.Ix field +field named by \f2field\fP of a member of the record type \f2rt\fP. +The returned procedure accepts two arguments: a record +of the record type \f2rt\fP and an arbitrary object; it stores the given +object into the specified field in that record and returns the +previous value of the field. +\f2field\fP must be a member of the list of field names that was supplied +to the call to +.Ix make-record-type +\f2make-record-type\fP that created \f2rt\fP. +.LP +Example +.Ss +(define set-time-hours! + (record-modifier time-record 'hours)) +.Se +. +.Pr describe-record-type rt +.LP +This procedure prints the names of the +.Ix fields +fields associated with the record type \f2rt\fP; it is automatically +invoked by the standard +.Ix describe +\f2describe\fP procedure of Elk if \f2describe\fP is invoked with a +record type. +. +.Ch "Records" +. +.Pr record? obj +.LP +This +.Ix "type predicate" +type predicate returns #t if \f2obj\fP is an object of type \f2record\fP +(i.\|e.\& the return value of a call to a record +.Ix constructor +constructor of any record type), #f otherwise. +. +.Pr record-type-descriptor record +.LP +This procedure returns the +.Ix "record type" +record type representing the type of the given record. +The returned record type object is equal (in the sense of \f2eq?\fP) +to the record type argument that was passed to +.Ix record-constructor +\f2record-constructor\fP in the call that created the constructor +procedure that created \f2record\fP. +.LP +Example: evaluating the expression +.Ss +((record-predicate (record-type-descriptor r)) r) +.Se +always yields #t for any given record \f2r\fP. +. +.Pr record-values record +.LP +\f2record-values\fP returns the current contents of the fields of +\f2record\fP as a +.Ix vector +vector. +The \f2n\fPth element of the vector corresponds to the field with the +name given as the \f2n\fPth element of the \f2fields\fP argument in +the call to +.Ix make-record-type +\f2make-record-type\fP that created the type to which \f2record\fP belongs. +.LP +The returned vector is not a copy of the actual fields; i.\|e.\& modifying +the contents of the vector directly writes the corresponding fields +of the record. +. +.Pr describe-record record +.LP +This procedure prints the names and current values of the +.Ix fields +fields of the given record; it is automatically invoked by the standard +.Ix describe +\f2describe\fP procedure of Elk if \f2describe\fP is invoked with a record. +. +.Ch "Convenience Macros" +.PP +The +.Ix macros +macros described in this section are loaded by evaluating +.Ss +(require 'recordutil) +.Se +after having loaded the record extension. +This causes the file +.Ix recordutil.scm +\f2recordutil.scm\fP to be loaded and defines the +.Ix feature +.Ix recordutil +feature \f2recordutil\fP. +. +.Sy define-record-type name fields +.LP +This macro defines a variable \f2-record\fP, invokes the procedure +.Ix make-record-type +\f2make-record-type\fP with the given \f2name\fP and +\f2fields\fP, and assigns the result to this variable. +In addition, \f2define-record-type\fP defines a +.Ix "type predicate" +type predicate for the new record type as \f2\-record?\fP and a +.Ix constructor +constructor function as \f2make\-\-record\fP. +The constructor function accepts no arguments and returns an +uninitialized record of the newly defined record type. +.LP +Example: +.Ss +(require 'record) +(require 'recordutil) +.sp .5 +(define-record-type + time (hours minutes seconds)) +.sp .3 +(record-type? time-record) \f2\(-> #t\fP +.sp .3 +(define t (make-time-record)) +.sp .3 +(time-record? t) \f2\(-> #t\fP +.Se +. +.[[ +.Sy define-record-accessors rt +.Sy define-record-modifiers rt +.]] +.LP +The macro \f2define-record-accessors\fP (\f2define-record-modifiers\fP) +defines +.Ix accessor +.Ix modifier +accessor (modifier) functions for the fields of the record type \f2rt\fP. +For each field named \f2field\fP, \f2define-record-accessors\fP +(\f2define-record-modifiers\fP) defines a function \f2\-\fP +(\f2set\-\-!\fP), where \f2name\fP is the type name of +the given record type. +Each of the functions is the result of a call to +.Ix record-accessor +.Ix record-modifier +\f2record-accessor\fP (\f2record-modifier\fP) as described above, with +the arguments \f2rt\fP and the name of the field. +.LP +Example: +.Ss +(define-record-type time (hours minutes seconds)) +(define-record-modifiers time-record) +.sp .3 +(define noon (make-time-record)) +(set-time-hours! noon 12) +(set-time-minutes! noon 0) +(set-time-seconds! noon 0) +.sp .5 +(define-record-accessors time-record) +.sp .3 +(time-hours noon) \f2\(-> 12\fP +.Se diff --git a/doc/record/record.ps b/doc/record/record.ps new file mode 100644 index 0000000..64661c0 --- /dev/null +++ b/doc/record/record.ps @@ -0,0 +1,640 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier +%%+ font Symbol +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 7 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier +%%IncludeResource: font Symbol +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier@0 ENC0/Courier RE/Times-Roman@0 +ENC0/Times-Roman RE/Times-Italic@0 ENC0/Times-Italic RE/Times-Bold@0 ENC0 +/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(Refer)222.444 120 Q(ence Manual f)-.216 E(or the)-.3 E +(Elk Record Extension)231.996 138 Q/F1 10/Times-Italic@0 SF(Oliver Laumann) +255.085 162 Q/F2 11/Times-Bold@0 SF 2.75(1. Intr)72 234 R(oduction)-.198 E/F3 +11/Times-Roman@0 SF .345(The record e)97 252.6 R .345(xtension to Elk allo) +-.165 F .344(ws Scheme applications to de\214ne record data types \(similar) +-.275 F(to, although less po)72 267.6 Q(werful than, Common Lisp)-.275 E/F4 11 +/Times-Italic@0 SF(structur)2.75 E(es)-.407 E F3(\).)A 4.329(Ar)97 286.2 S +1.579(ecord type can be instantiated to obtain a ne)112.934 286.2 R 4.329(wr) +-.275 G 1.579(ecord \(a member of the gi)334.297 286.2 R -.165(ve)-.275 G 4.33 +(nr).165 G(ecord)479.569 286.2 Q 5.568(type\). Each)72 301.2 R 2.817(record is\ + a collection of named \214elds that can hold arbitrary Scheme objects.)5.568 F +.819(Records are \214rst-class Scheme objects; the)72 316.2 R 3.57(ya)-.165 G +.82(re members of the)277.764 316.2 R F4 -.407(re)3.57 G(cor).407 E(d)-.407 E +F3 .82(data type that is disjoint)3.57 F 1.072(from all other Scheme types.)72 +331.2 R 1.071 +(Record types are \214rst-class objects as well; each record type is a)6.572 F +(member of the)72 346.2 Q F4 -.407(re)2.75 G(cor).407 E(d-type)-.407 E F3 +(Scheme data type.)2.75 E .075(The record e)97 364.8 R .075(xtension pro)-.165 +F .075(vides f)-.165 F .075(acilities to de\214ne ne)-.11 F 2.825(wr)-.275 G +.076(ecord types, create instances of e)339.446 364.8 R(xist-)-.165 E .002(ing\ + record types, de\214ne accessor and modi\214er functions to read and write th\ +e \214elds of records of a)72 379.8 R(gi)72 394.8 Q -.165(ve)-.275 G 2.75(nt) +.165 G(ype, and type predicates for the)101.81 394.8 Q F4 -.407(re)2.75 G(cor) +.407 E(d)-.407 E F3(and)2.75 E F4 -.407(re)2.75 G(cor).407 E(d-type)-.407 E F3 +(data types.)2.75 E .322(In addition, the e)97 413.4 R .322(xtension pro)-.165 +F .323(vides macros that simplify the de\214nition of constructor)-.165 F 3.073 +(,a)-.44 G(cces-)481.406 413.4 Q(sor and modi\214er functions for a ne)72 428.4 +Q(wly de\214ned record type.)-.275 E F2 2.75(2. Using)72 458.4 R +(the Record Extension)2.75 E F3(The record e)97 477 Q(xtension is loaded by e) +-.165 E -.275(va)-.275 G(luating).275 E/F5 10/Courier@0 SF(\(require 'record\)) +100.346 499.503 Q F3(in the interacti)72 521.503 Q .33 -.165(ve t)-.275 H(ople) +.165 E -.165(ve)-.275 G 2.75(lo).165 G 2.75(ri)191.493 521.503 S 2.75(naS) +200.964 521.503 S(cheme program.)222.964 521.503 Q .551 +(This causes the \214les)97 540.103 R F4 -.407(re)3.301 G(cor).407 E(d.scm) +-.407 E F3(and)3.301 E F4 -.407(re)3.301 G(cor).407 E(d.o)-.407 E F3 .551 +(to be loaded into the interpreter \()3.301 F F4 -.407(re)C(cor).407 E(d.o) +-.407 E F3(has)3.3 E .215(to be link)72 555.103 R .216(ed with the interpreter\ + on platforms that do not support dynamic loading of object \214les\).)-.11 F +(Loading the record e)97 573.703 Q(xtension causes the features)-.165 E F4 +-.407(re)2.75 G(cor).407 E(d)-.407 E F3(and)2.75 E F4 -.407(re)2.75 G(cor).407 +E(d.o)-.407 E F3(to be pro)2.75 E(vided.)-.165 E F2 2.75(3. Record)72 603.703 R +-.814(Ty)2.75 G(pes).814 E(\(mak)72 633.703 Q(e-r)-.11 E(ecord-type)-.198 E F4 +(type-name \214elds)4.583 E F2 216.437(\)p)C -.198(ro)462.244 633.703 S(cedur) +.198 E(e)-.198 E F4(mak)72 652.303 Q(e-r)-.11 E(ecor)-.407 E(d-type)-.407 E F3 +.5(creates a ne)3.25 F 3.25(wr)-.275 G .5(ecord type.)219.398 652.303 R F4 +(type-name)6 E F3 .499(\(a string or a symbol\) is the name of the)3.25 F .379 +(record type; it is used in the printed representation of the record type and \ +of records belonging to)72 667.303 R .731(the ne)72 682.303 R 3.481(wt)-.275 G +3.481(ype. If)113.513 682.303 R F4(type-name)3.481 E F3 .73 +(is a symbol, it is con)3.481 F -.165(ve)-.44 G .73 +(rted into a string \214rst.).165 F F4(\214elds)6.23 E F3 .73 +(is a list of sym-)3.48 F .32(bols naming the \214elds of a record of the ne)72 +697.303 R 3.07(wt)-.275 G 3.07(ype. An)277.171 697.303 R .32 +(error is signaled of the list contains dupli-)3.07 F(cate names.)72 712.303 Q +EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Italic@0 SF(mak)72 87 Q(e-r)-.11 E(ecor)-.407 E(d-type) +-.407 E F0(returns the ne)2.75 E 2.75(wr)-.275 G +(ecord type \(an object of the Scheme type)225.967 87 Q F1 -.407(re)2.75 G(cor) +.407 E(d-type)-.407 E F0(\).)A(Example:)72 105.6 Q/F2 10/Courier@0 SF +(\(define time-record)100.346 128.103 Q +(\(make-record-type 'time '\(hours minutes seconds\)\)\))112.346 142.103 Q/F3 +11/Times-Bold@0 SF(\(r)72 179.103 Q(ecord-type?)-.198 E F1(obj)4.583 E F3 +297.881(\)p)C -.198(ro)462.244 179.103 S(cedur).198 E(e)-.198 E F0 .211 +(This type predicate returns #t if)72 197.703 R F1(obj)2.96 E F0 .21(is a)2.96 +F F1 -.407(re)2.96 G(cor).407 E(d-type)-.407 E F0 .21(object \(i.)2.96 F .21 +(e. the return v)1.833 F .21(alue of a call to)-.275 F F1(mak)2.96 E(e-)-.11 E +-.407(re)72 212.703 S(cor).407 E(d-type)-.407 E F0(\), #f otherwise.)A F3(\(r) +72 242.703 Q(ecord-type-name)-.198 E F1(rt)4.583 E F3 280.776(\)p)C -.198(ro) +462.244 242.703 S(cedur).198 E(e)-.198 E F0 .302 +(This procedure returns the type name \(a string\) of the record type)72 +261.303 R F1(rt)3.052 E F0 3.052(,i)C 1.833(.e)382.021 261.303 S 3.052(.t) +-1.833 G(he)400.348 261.303 Q F1(type-name)3.052 E F0(ar)3.052 E(gument)-.198 E +(that w)72 276.303 Q(as supplied to the call to)-.11 E F1(mak)2.75 E(e-r)-.11 E +(ecor)-.407 E(d-type)-.407 E F0(that created the record type)2.75 E F1(rt)2.75 +E F0(.)A F3(\(r)72 306.303 Q(ecord-type-\214eld-names)-.198 E F1(rt)4.583 E F3 +252.66(\)p)C -.198(ro)462.244 306.303 S(cedur).198 E(e)-.198 E F1 -.407(re)72 +324.903 S(cor).407 E(d-type-\214eld-names)-.407 E F0 .524 +(returns the list of \214eld names associated with the record type)3.275 F F1 +(rt)3.274 E F0 .524(\(a list of)3.274 F(symbols\), i.)72 339.903 Q(e. the)1.833 +E F1(\214elds)2.75 E F0(ar)2.75 E(gument that w)-.198 E(as gi)-.11 E -.165(ve) +-.275 G 2.75(ni).165 G 2.75(nt)290.929 339.903 S(he call to)302.237 339.903 Q +F1(mak)2.75 E(e-r)-.11 E(ecor)-.407 E(d-type)-.407 E F0(that created)2.75 E F1 +(rt)2.75 E F0(.)A F3(\(r)72 369.903 Q(ecord-constructor)-.198 E F1(rt \214elds) +4.583 E F3 249.921(\)p)C -.198(ro)462.244 369.903 S(cedur).198 E(e)-.198 E(\(r) +72 384.903 Q(ecord-constructor)-.198 E F1(rt)4.583 E F3 275.892(\)p)C -.198(ro) +462.244 384.903 S(cedur).198 E(e)-.198 E F1 -.407(re)72 403.503 S(cor).407 E +(d-constructor)-.407 E F0 +(returns a procedure for creating instances of the record type)2.75 E F1(rt) +2.75 E F0(.)A 1.065(The returned procedure accepts as man)72 422.103 R 3.815 +(ya)-.165 G -.198(rg)263.322 422.103 S 1.065 +(uments as there are symbols in the list).198 F F1(\214elds)3.816 E F0 3.816 +(;t)C(hese)484.453 422.103 Q(ar)72 437.103 Q .584 +(guments are used as the initial v)-.198 F .583 +(alues of those \214elds in the ne)-.275 F .583(wly created record instance.) +-.275 F(The)6.083 E -.275(va)72 452.103 S .736(lues of an).275 F 3.486<798c> +-.165 G .736(elds for which no initial v)141.286 452.103 R .736 +(alue is speci\214ed \(i.)-.275 F 3.487(e. that)1.833 F .737 +(are not present in)3.487 F F1(\214elds)3.487 E F0 3.487(\)a)C(re)495.453 +452.103 Q 2.836(unde\214ned. If)72 467.103 R(the)2.836 E F1(\214elds)2.836 E F0 +(ar)2.836 E .085(gument is omitted, the \214eld names that were gi)-.198 F +-.165(ve)-.275 G 2.835(na).165 G 2.835(sa)414.648 467.103 S 2.835(na)426.646 +467.103 S -.198(rg)439.865 467.103 S .085(ument in the).198 F(call to)72 +482.103 Q F1(mak)2.75 E(e-r)-.11 E(ecor)-.407 E(d-type)-.407 E F0 +(that created the record type)2.75 E F1(rt)2.75 E F0(are used instead.)2.75 E +(Example:)72 500.703 Q F2(\(define make-time)100.346 523.206 Q +(\(record-constructor time-record\)\))118.346 537.206 Q +(\(define noon \(make-time 12 0 0\)\))100.346 551.206 Q +(\(define make-uninitialized-time)100.346 572.206 Q +(\(record-constructor time-record '\(\)\)\))118.346 586.206 Q F3(\(r)72 623.206 +Q(ecord-pr)-.198 E(edicate)-.198 E F1(rt)4.583 E F3 286.474(\)p)C -.198(ro) +462.244 623.206 S(cedur).198 E(e)-.198 E F1 -.407(re)72 641.806 S(cor).407 E +(d-pr)-.407 E(edicate)-.407 E F0 .873 +(returns a procedure for testing membership in the record type)3.623 F F1(rt) +3.623 E F0 6.373(.T)C .873(he returned)453.341 641.806 R .584 +(procedure accepts one ar)72 656.806 R .584(gument and returns #t if the ar) +-.198 F .583(gument is a member of the record type)-.198 F F1(rt)3.333 E F0 +-.917(\(i. e.)72 671.806 R .038(if it has been created by in)2.788 F -.22(vo) +-.44 G .038(king a constructor returned by calling).22 F F1 -.407(re)2.789 G +(cor).407 E(d-constructor)-.407 E F0(with)2.789 E F1(rt)2.789 E F0(as an ar)72 +686.806 Q(gument\), #f otherwise.)-.198 E EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(r)72 87 Q(ecord-accessor)-.198 E/F2 11 +/Times-Italic@0 SF(rt \214eld)4.583 E F1 269.479(\)p)C -.198(ro)462.244 87 S +(cedur).198 E(e)-.198 E F2 -.407(re)72 105.6 S(cor).407 E(d-accessor)-.407 E F0 +.225(returns a procedure for reading the v)2.975 F .225 +(alue of the \214eld named by)-.275 F F2(\214eld)2.974 E F0 .224(of a member) +2.974 F .914(of the record type)72 120.6 R F2(rt)3.664 E F0 6.414(.T)C .914 +(he returned procedure accepts one ar)179.519 120.6 R .914 +(gument, which must be a record of)-.198 F .45(the record type)72 135.6 R F2 +(rt)3.2 E F0 3.2(;i)C 3.2(tr)158.731 135.6 S .45(eturns the current v)168.652 +135.6 R .45(alue of the speci\214ed \214eld in that record.)-.275 F F2(\214eld) +5.949 E F0 .449(must be a)3.199 F .205 +(member of the list of \214eld names that w)72 150.6 R .206 +(as supplied to the call to)-.11 F F2(mak)2.956 E(e-r)-.11 E(ecor)-.407 E +(d-type)-.407 E F0 .206(that created)2.956 F F2(rt)2.956 E F0(.)A(Example:)72 +169.2 Q/F3 10/Courier@0 SF(\(define time-hours)100.346 191.703 Q +(\(record-accessor time-record 'hours\)\))112.346 205.703 Q +(\(define noon \(\(record-constructor time-record\) 12 0 0\)\))100.346 226.703 +Q(\(time-hours noon\))100.346 240.703 Q/F4 10/Symbol SF214.346 240.703 Q/F5 +10/Times-Italic@0 SF(12)2.5 E F1(\(r)72 277.703 Q(ecord-modi\214er)-.198 E F2 +(rt \214eld)4.583 E F1 268.852(\)p)C -.198(ro)462.244 277.703 S(cedur).198 E(e) +-.198 E F2 -.407(re)72 296.303 S(cor).407 E(d-modi\214er)-.407 E F0 .415 +(returns a procedure for writing the v)3.165 F .414 +(alue of the \214eld named by)-.275 F F2(\214eld)3.164 E F0 .414(of a member) +3.164 F .482(of the record type)72 311.303 R F2(rt)3.232 E F0 5.982(.T)C .482 +(he returned procedure accepts tw)177.359 311.303 R 3.233(oa)-.11 G -.198(rg) +338.181 311.303 S .483(uments: a record of the record type).198 F F2(rt)72 +326.303 Q F0 1.734(and an arbitrary object; it stores the gi)4.484 F -.165(ve) +-.275 G 4.483(no).165 G 1.733 +(bject into the speci\214ed \214eld in that record and)288.495 326.303 R .468 +(returns the pre)72 341.303 R .468(vious v)-.275 F .469(alue of the \214eld.) +-.275 F F2(\214eld)5.969 E F0 .469 +(must be a member of the list of \214eld names that w)3.219 F(as)-.11 E +(supplied to the call to)72 356.303 Q F2(mak)2.75 E(e-r)-.11 E(ecor)-.407 E +(d-type)-.407 E F0(that created)2.75 E F2(rt)2.75 E F0(.)A(Example)72 374.903 Q +F3(\(define set-time-hours!)100.346 397.406 Q +(\(record-modifier time-record 'hours\)\))112.346 411.406 Q F1(\(describe-r)72 +448.406 Q(ecord-type)-.198 E F2(rt)4.583 E F1 267.334(\)p)C -.198(ro)462.244 +448.406 S(cedur).198 E(e)-.198 E F0 .153(This procedure prints the names of th\ +e \214elds associated with the record type)72 467.006 R F2(rt)2.902 E F0 2.902 +(;i)C 2.902(ti)427.917 467.006 S 2.902(sa)436.935 467.006 S(utomatically)449 +467.006 Q(in)72 482.006 Q -.22(vo)-.44 G -.11(ke).22 G 2.75(db).11 G 2.75(yt) +114.922 482.006 S(he standard)126.23 482.006 Q F2(describe)2.75 E F0 +(procedure of Elk if)2.75 E F2(describe)2.75 E F0(is in)2.75 E -.22(vo)-.44 G +-.11(ke).22 G 2.75(dw).11 G(ith a record type.)401.01 482.006 Q F1 2.75 +(4. Records)72 512.006 R(\(r)72 542.006 Q(ecord?)-.198 E F2(obj)4.583 E F1 +321.707(\)p)C -.198(ro)462.244 542.006 S(cedur).198 E(e)-.198 E F0 .417 +(This type predicate returns #t if)72 560.606 R F2(obj)3.167 E F0 .417 +(is an object of type)3.167 F F2 -.407(re)3.167 G(cor).407 E(d)-.407 E F0 -.917 +(\(i. e.)3.167 F .417(the return v)3.167 F .417(alue of a call to a)-.275 F +(record constructor of an)72 575.606 Q 2.75(yr)-.165 G +(ecord type\), #f otherwise.)189.128 575.606 Q F1(\(r)72 605.606 Q +(ecord-type-descriptor)-.198 E F2 -.407(re)4.583 G(cor).407 E(d)-.407 E F1 +236.996(\)p)C -.198(ro)462.244 605.606 S(cedur).198 E(e)-.198 E F0 1.302 +(This procedure returns the record type representing the type of the gi)72 +624.206 R -.165(ve)-.275 G 4.051(nr).165 G 4.051(ecord. The)412.21 624.206 R +(returned)4.051 E .817(record type object is equal \(in the sense of)72 639.206 +R F2(eq?)3.567 E F0 6.317(\)t)C 3.567(ot)296.758 639.206 S .817 +(he record type ar)308.883 639.206 R .817(gument that w)-.198 F .817 +(as passed to)-.11 F F2 -.407(re)72 654.206 S(cor).407 E(d-constructor)-.407 E +F0(in the call that created the constructor procedure that created)2.75 E F2 +-.407(re)2.75 G(cor).407 E(d)-.407 E F0(.)A(Example: e)72 672.806 Q -.275(va) +-.275 G(luating the e).275 E(xpression)-.165 E F3 +(\(\(record-predicate \(record-type-descriptor r\)\) r\))100.346 695.309 Q F0 +(al)72 717.309 Q -.11(wa)-.11 G(ys yields #t for an).11 E 2.75(yg)-.165 G +-2.365 -.275(iv e)184.959 717.309 T 2.75(nr).275 G(ecord)209.874 717.309 Q F2 +(r)2.75 E F0(.)A EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(r)72 87 Q(ecord-v)-.198 E(alues)-.11 E/F2 +11/Times-Italic@0 SF -.407(re)4.583 G(cor).407 E(d)-.407 E F1 279.863(\)p)C +-.198(ro)462.244 87 S(cedur).198 E(e)-.198 E F2 -.407(re)72 105.6 S(cor).407 E +(d-values)-.407 E F0 .649(returns the current contents of the \214elds of)3.399 +F F2 -.407(re)3.399 G(cor).407 E(d)-.407 E F0 .649(as a v)3.399 F(ector)-.165 E +6.149(.T)-.605 G(he)425.375 105.6 Q F2(n)3.398 E F0 .648(th element of)B .604 +(the v)72 120.6 R .605(ector corresponds to the \214eld with the name gi)-.165 +F -.165(ve)-.275 G 3.355(na).165 G 3.355(st)326.735 120.6 S(he)337.427 120.6 Q +F2(n)3.355 E F0 .605(th element of the)B F2(\214elds)3.355 E F0(ar)3.355 E +(gument)-.198 E(in the call to)72 135.6 Q F2(mak)2.75 E(e-r)-.11 E(ecor)-.407 E +(d-type)-.407 E F0(that created the type to which)2.75 E F2 -.407(re)2.75 G +(cor).407 E(d)-.407 E F0(belongs.)2.75 E 1.159(The returned v)72 154.2 R 1.159 +(ector is not a cop)-.165 F 3.909(yo)-.11 G 3.909(ft)233.497 154.2 S 1.159 +(he actual \214elds; i.)244.127 154.2 R 1.159 +(e. modifying the contents of the v)1.833 F(ector)-.165 E +(directly writes the corresponding \214elds of the record.)72 169.2 Q F1 +(\(describe-r)72 199.2 Q(ecord)-.198 E F2 -.407(re)4.583 G(cor).407 E(d)-.407 E +F1 269.985(\)p)C -.198(ro)462.244 199.2 S(cedur).198 E(e)-.198 E F0 .025 +(This procedure prints the names and current v)72 217.8 R .025 +(alues of the \214elds of the gi)-.275 F -.165(ve)-.275 G 2.775(nr).165 G .025 +(ecord; it is automati-)412.569 217.8 R(cally in)72 232.8 Q -.22(vo)-.44 G -.11 +(ke).22 G 2.75(db).11 G 2.75(yt)139.056 232.8 S(he standard)150.364 232.8 Q F2 +(describe)2.75 E F0(procedure of Elk if)2.75 E F2(describe)2.75 E F0(is in)2.75 +E -.22(vo)-.44 G -.11(ke).22 G 2.75(dw).11 G(ith a record.)425.144 232.8 Q F1 +2.75(5. Con)72 262.8 R -.11(ve)-.44 G(nience Macr).11 E(os)-.198 E F0 +(The macros described in this section are loaded by e)97 281.4 Q -.275(va)-.275 +G(luating).275 E/F3 10/Courier@0 SF(\(require 'recordutil\))100.346 303.903 Q +F0 1.594(after ha)72 325.903 R 1.594(ving loaded the record e)-.22 F 4.343 +(xtension. This)-.165 F 1.593(causes the \214le)4.343 F F2 -.407(re)4.343 G +(cor).407 E(dutil.scm)-.407 E F0 1.593(to be loaded and)4.343 F +(de\214nes the feature)72 340.903 Q F2 -.407(re)2.75 G(cor).407 E(dutil)-.407 E +F0(.)A F1(\(de\214ne-r)72 370.903 Q(ecord-type)-.198 E F2(name \214elds)4.583 E +F1 253.177(\)s)C(yntax)477.721 370.903 Q F0 .796(This macro de\214nes a v)72 +389.503 R(ariable)-.275 E F2(-r)3.547 E(ecor)-.407 E(d)-.407 E F0 3.547 +(,i)C -2.09 -.44(nv o)288.188 389.503 T -.11(ke).44 G 3.547(st).11 G .797 +(he procedure)325.186 389.503 R F2(mak)3.547 E(e-r)-.11 E(ecor)-.407 E(d-type) +-.407 E F0 .797(with the)3.547 F(gi)72 404.503 Q -.165(ve)-.275 G(n).165 E F2 +(name)4.866 E F0(and)4.866 E F2(\214elds)4.866 E F0 4.866(,a)C 2.116 +(nd assigns the result to this v)186.031 404.503 R 4.866(ariable. In)-.275 F +(addition,)4.866 E F2(de\214ne-r)4.866 E(ecor)-.407 E(d-type)-.407 E F0 .76 +(de\214nes a type predicate for the ne)72 419.503 R 3.51(wr)-.275 G .76 +(ecord type as)239.856 419.503 R F2(\255r)3.511 E(ecor)-.407 E(d?)-.407 E +F0 .761(and a constructor function)3.511 F(as)72 434.503 Q F2(mak)3.35 E +(e\255\255r)-.11 E(ecor)-.407 E(d)-.407 E F0 6.1(.T)C .6 +(he constructor function accepts no ar)205.222 434.503 R .599 +(guments and returns an unini-)-.198 F(tialized record of the ne)72 449.503 Q +(wly de\214ned record type.)-.275 E(Example:)72 468.103 Q F3 +(\(require 'record\))100.346 490.606 Q(\(require 'recordutil\))100.346 504.606 +Q(\(define-record-type)100.346 525.606 Q(time \(hours minutes seconds\)\)) +112.346 539.606 Q(\(record-type? time-record\))100.346 557.806 Q/F4 10/Symbol +SF268.346 557.806 Q/F5 10/Times-Italic@0 SF(#t)2.5 E F3 +(\(define t \(make-time-record\)\))100.346 576.006 Q(\(time-record? t\))100.346 +594.206 Q F4208.346 594.206 Q F5(#t)2.5 E F1(\(de\214ne-r)72 631.206 Q +(ecord-accessors)-.198 E F2(rt)4.583 E F1 272.427(\)s)C(yntax)477.721 631.206 Q +(\(de\214ne-r)72 646.206 Q(ecord-modi\214ers)-.198 E F2(rt)4.583 E F1 271.8 +(\)s)C(yntax)477.721 646.206 Q F0 2.413(The macro)72 664.806 R F2(de\214ne-r) +5.163 E(ecor)-.407 E(d-accessor)-.407 E(s)-.11 E F0(\()5.163 E F2(de\214ne-r)A +(ecor)-.407 E(d-modi\214er)-.407 E(s)-.11 E F0 5.163(\)d)C 2.414 +(e\214nes accessor \(modi\214er\) func-)357.774 664.806 R 2.066 +(tions for the \214elds of the record type)72 679.806 R F2(rt)4.815 E F0 7.565 +(.F)C 2.065(or each \214eld named)275.27 679.806 R F2(\214eld)4.815 E F0(,)A F2 +(de\214ne-r)4.815 E(ecor)-.407 E(d-accessor)-.407 E(s)-.11 E F0(\()72 694.806 Q +F2(de\214ne-r)A(ecor)-.407 E(d-modi\214er)-.407 E(s)-.11 E F0 4.83(\)d)C 2.08 +(e\214nes a function)192.594 694.806 R F2(\255<\214eld>)4.83 E F0(\() +4.831 E F2(set\255\255<\214eld>!)A F0 2.081(\), where)B F2(name)72 +709.806 Q F0 1.062(is the type name of the gi)3.812 F -.165(ve)-.275 G 3.812 +(nr).165 G 1.062(ecord type.)240.139 709.806 R 1.062 +(Each of the functions is the result of a call to)6.562 F F2 -.407(re)72 +724.806 S(cor).407 E(d-accessor)-.407 E F0(\()3.342 E F2 -.407(re)C(cor).407 E +(d-modi\214er)-.407 E F0 3.342(\)a)C 3.342(sd)230.396 724.806 S .592 +(escribed abo)243.517 724.806 R -.165(ve)-.165 G 3.342(,w).165 G .592 +(ith the ar)323.483 724.806 R(guments)-.198 E F2(rt)3.342 E F0 .592 +(and the name of the)3.342 F EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(\214eld.)72 87 Q(Example:)72 105.6 Q/F1 10/Courier@0 SF +(\(define-record-type time \(hours minutes seconds\)\))100.346 128.103 Q +(\(define-record-modifiers time-record\))100.346 142.103 Q +(\(define noon \(make-time-record\)\))100.346 160.303 Q +(\(set-time-hours! noon 12\))100.346 174.303 Q(\(set-time-minutes! noon 0\)) +100.346 188.303 Q(\(set-time-seconds! noon 0\))100.346 202.303 Q +(\(define-record-accessors time-record\))100.346 223.303 Q(\(time-hours noon\)) +100.346 241.503 Q/F2 10/Symbol SF214.346 241.503 Q/F3 10/Times-Italic@0 SF +(12)2.5 E EP +%%Page: 6 6 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 13/Times-Bold@0 SF(Index)272.108 123 Q(A)72 174 Q F0(accessor)72 +204 Q 2.75(,1)-.44 G 2.75(,4)119.817 204 S F1(C)72 234 Q F0(constructor)72 264 +Q 2.75(,1)-.44 G 2.75(,3)132.049 264 S 2.75(,4)143.049 264 S F1(D)72 294 Q F0 +(de\214ne-record-accessors,)72 324 Q/F2 12/Times-Bold@0 SF(4)2.75 E F0 +(de\214ne-record-modi\214ers,)72 339 Q F2(4)2.75 E F0(de\214ne-record-type,)72 +354 Q F2(4)2.75 E F0(describe, 3, 4)72 369 Q(describe-record,)72 384 Q F2(4) +2.75 E F0(describe-record-type,)72 399 Q F2(3)2.75 E F1(F)72 429 Q F0 +(feature, 1, 4)72 459 Q(\214eld names, 2)72 474 Q(\214eld, 3)72 489 Q +(\214elds, 1, 2, 3, 4)72 504 Q F1(I)72 534 Q F0(initial v)72 564 Q(alue, 2) +-.275 E(instances, 1, 2)72 579 Q F1(M)72 609 Q F0(macros, 1, 4)72 639 Q(mak)72 +654 Q(e-record-type,)-.11 E F2(1)2.75 E F0 2.75(,2)C 2.75(,3)172.578 654 S 2.75 +(,4)183.578 654 S(modi\214er)302.4 174 Q 2.75(,1)-.44 G 2.75(,4)350.239 174 S +F1(R)302.4 204 Q F0(record data type, 1)302.4 234 Q(record type, 1, 3)302.4 249 +Q(record, 1)302.4 264 Q(constructor)310.65 279 Q 2.75(,2)-.44 G +(record-accessor)302.4 294 Q(,)-.44 E F2(3)2.75 E F0 2.75(,4)C +(record-constructor)302.4 309 Q(,)-.44 E F2(2)2.75 E F0 2.75(,3)C +(record-modi\214er)302.4 324 Q(,)-.44 E F2(3)2.75 E F0 2.75(,4)C +(record-predicate,)302.4 339 Q F2(2)2.75 E F0(record-type-descriptor)302.4 354 +Q(,)-.44 E F2(3)2.75 E F0(record-type-\214eld-names,)302.4 369 Q F2(2)2.75 E F0 +(record-type-name,)302.4 384 Q F2(2)2.75 E F0(record-type?,)302.4 399 Q F2(2) +2.75 E F0(record-v)302.4 414 Q(alues,)-.275 E F2(4)2.75 E F0(record.o, 1)302.4 +429 Q(record.scm, 1)302.4 444 Q(record?,)302.4 459 Q F2(3)2.75 E F0 +(recordutil, 4)302.4 474 Q(recordutil.scm, 4)302.4 489 Q F1(S)302.4 519 Q F0 +(structures, 1)302.4 549 Q F1(T)302.4 579 Q F0(type name, 2)302.4 609 Q +(type predicate, 1, 2, 3, 4)302.4 624 Q F1(V)302.4 654 Q F0 -.165(ve)302.4 684 +S(ctor).165 E 2.75(,4)-.44 G EP +%%Page: 7 7 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 13/Times-Bold@0 SF -1.196(Ta)239.127 123 S(ble of Contents)1.196 E/F1 11 +/Times-Roman@0 SF .866(Introduction ..........................................\ +..............................................................................\ +......)72 177.6 R(1)498.5 177.6 Q(Using the Record Extension)72 196.2 Q 19.25(\ +..............................................................................\ +....................... 1)3.011 F(Record T)72 214.8 Q .228(ypes ..............\ +..............................................................................\ +................................)-.88 F(1)498.5 214.8 Q 2.703(Records ........\ +..............................................................................\ +..............................................)72 233.4 R(3)498.5 233.4 Q(Con) +72 252 Q -.165(ve)-.44 G(nience Macros).165 E 19.25(..........................\ +..............................................................................\ +........ 4)3.935 F(Inde)72 270.6 Q 2.868(x.)-.165 G 19.25(....................\ +..............................................................................\ +...................................... 6)102.5 270.6 R EP +%%Trailer +end +%%EOF diff --git a/doc/regexp/Makefile b/doc/regexp/Makefile new file mode 100644 index 0000000..497f08f --- /dev/null +++ b/doc/regexp/Makefile @@ -0,0 +1,24 @@ +MANUAL= regexp +TROFF= groff -ms -t +UNROFF= unroff -ms + +$(MANUAL).ps: $(MANUAL).ms index.ms + (cat $(MANUAL).ms ../util/tmac.index index.ms; echo ".Tc")\ + | $(TROFF) 2> /dev/null > $(MANUAL).ps + +$(MANUAL).html: $(MANUAL).ms + (cat $?; echo ".Tc") | $(UNROFF) document=$(MANUAL) + +index.ms: $(MANUAL).ms index.raw + sort -f -t# +1 -3 +0n index.raw | awk -f ../util/fixindex.awk\ + | awk -f ../util/block.awk >index.ms + +index.raw: $(MANUAL).ms + $(TROFF) $(MANUAL).ms 2> index.raw >/dev/null + +check: + checknr -c.Ul.Pr.Sy.Va.Sh.Ix.Id.Ch -a.Ss.Se.[[.]] $(MANUAL).ms |\ + grep -v "Empty command" + +clean: + rm -f index.raw index.ms $(MANUAL).ps $(MANUAL).html diff --git a/doc/regexp/regexp.ms b/doc/regexp/regexp.ms new file mode 100644 index 0000000..67a69d0 --- /dev/null +++ b/doc/regexp/regexp.ms @@ -0,0 +1,181 @@ +.so ../util/tmac.scheme +.Ul +.TL +Reference Manual for the +.sp .5 +Elk Regular Expression Extension +.AU +Oliver Laumann +. +.Ch "Introduction" +. +.PP +The regular expression extension defines Scheme language bindings +for the +.Ix POSIX +POSIX regular expression functions that are provided by most +modern +.Ix UNIX +UNIX +versions (\f2regcomp()\fP and \f2regexec()\fP). +You may want to refer to your UNIX system's +.Ix regcomp +\f2regcomp(3)\fP manual for details. +The Scheme interface to the regular expression functions makes +the entire functionality of the usual C language interface +available to the Scheme programmer. +To load the regular expression extension, evaluate the expression +.Ss +(require 'regexp) +.Se +.PP +This causes the files +.Ix regexp.scm +\f2regexp.scm\fP and +.Ix regexp.o +\f2regexp.o\fP to be loaded (\f2regexp.o\fP must be statically +linked with the interpreter on platforms that do not support dynamic +loading of object files). +.PP +Loading the extension provides the +.Ix feature +features \f2regexp\fP and \f2regexp.o\fP. +On systems that do not support the regular expression library +functions, loading the extension succeeds, but no further primitives +or features are defined. +Otherwise, the additional feature +.Ix :regular-expressions +\f2:regular-expressions\fP is provided, so that the expression +.Ss +(feature? ':regular-expressions) +.Se +can be used in Scheme programs to check whether regular +expressions are available on the local platform. +. +.Ch "Creating Regular Expressions" +. +.[[ +.Pr make-regexp pattern +.Pr make-regexp pattern flags +.]] +.LP +\f2make-regexp\fP returns an object of the new Scheme type \f2regexp\fP +representing the regular expression specified by the string +argument \f2pattern\fP. +An error is signaled if the underlying call to the C library function +.Ix regcomp +\f2regcomp(3)\fP fails. +The optional +.Ix flags +\f2flags\fP argument is a list of zero or more of the +symbols \f2extended, ignore-case, no-subexpr,\fP and \f2newline\fP; +these correspond to the C constants \s-1\f2REG_EXTENDED, REG_ICASE, +REG_NOSUB,\fP\s0 and \s-1\f2REG_NEWLINE\fP\s0. +.PP +.Ix equality +Two objects of the type \f2regexp\fP are equal in the sense of +\f2equal?\fP if their flags are identical and if their patterns +are equal in the sense of \f2string=?\fP. +Two regular expressions are \f2eq?\fP if their flags are identical +and if they share the same pattern string. +. +.Pr regexp? obj +.LP +This +.Ix "type predicate" +type predicate returns #t if \f2obj\fP is a regular expression, #f otherwise. +. +.[[ +.Pr regexp-pattern regexp +.Pr regexp-flags regexp +.]] +.LP +These primitives return the pattern (or +.Ix flags +flags, respectively) specified +in the call to +.Ix make-regexp +\f2make-regexp\fP that has created the regular expression object. +. +.Ch "Matching Regular Expressions" +. +.[[ +.Pr regexp-exec regexp string offset +.Pr regexp-exec regexp string offset flags +.]] +.LP +This primitive applies the specified regular expression to the +given string starting at the given offset. +\f2offset\fP is an integer larger than or equal to zero and less than +or equal to the length of \f2string\fP. +If the match succeeds, \f2regexp-exec\fP returns an object of the +new Scheme type +.Ix regexp-match +\f2regexp-match\fP, otherwise #f. +The optional +.Ix flags +\f2flags\fP argument is a list of zero or more of the symbols +\f2not-bol\fP and \f2not-eol\fP which correspond to the constants +\s-1\f2REG_NOTBOL\fP\s0 and \s-1\f2NOT_EOL\fP\s0 in the C language +interface. +. +.Pr regexp-match? obj +.LP +This +.Ix "type predicate" +type predicate returns #t if \f2obj\fP is a regular expression match +(that is, the return value of a successful call to \f2regexp-match\fP), +#f otherwise. +. +.Pr regexp-match-number match +.LP +This primitive returns the number of substrings that matched parenthetic +.Ix subexpression +subexpressions in the original pattern when the given match was created, +plus one (the first substring corresponds to the entire regular +expression rather than a subexpression; see +.Ix regexec +\f2regexec(3)\fP for details). +A value of zero is returned if the match has been created by applying +a regular expression with the +.Ix no-subexpr +\f2no-subexpr\fP flag set. +. +.[[ +.Pr regexp-match-start match number +.Pr regexp-match-end match number +.]] +.LP +These primitives return the start offset (or end offset, respectively) +of the substring denoted by the integer \f2number\fP. +A \f2number\fP argument of zero refers to the substring corresponding to +the entire pattern. +The offsets returned by these primitives can be directly used as +arguments to the +.Ix "substring primitive" +\f2\%substring\fP primitive of Elk. +. +.KS +.Ch "Example" +. +.PP +The following program demonstrates a simple Scheme procedure +\f2matches\fP that returns a list of substrings of a given +string that match a given pattern. +An error message is displayed if regular expressions are +not supported by the local platform. +.Ss +.in +(require 'regexp) +.sp .4 +(define (matches str pat) + (let loop ((r (make-regexp pat '(extended))) (result '()) (from 0)) + (let ((m (regexp-exec r str from))) + (if (regexp-match? m) + (loop r (cons (substring str (+ from (regexp-match-start m 0)) + (+ from (regexp-match-end m 0))) + result) + (+ from (regexp-match-end m 0))) + (reverse result))))) +.Se +.KE diff --git a/doc/regexp/regexp.ps b/doc/regexp/regexp.ps new file mode 100644 index 0000000..bfd9911 --- /dev/null +++ b/doc/regexp/regexp.ps @@ -0,0 +1,460 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 5 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier@0 ENC0/Courier RE/Times-Roman@0 +ENC0/Times-Roman RE/Times-Italic@0 ENC0/Times-Italic RE/Times-Bold@0 ENC0 +/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(Refer)222.444 120 Q(ence Manual f)-.216 E(or the)-.3 E +(Elk Regular Expr)200.262 138 Q(ession Extension)-.216 E/F1 10/Times-Italic@0 +SF(Oliver Laumann)255.085 162 Q/F2 11/Times-Bold@0 SF 2.75(1. Intr)72 234 R +(oduction)-.198 E/F3 11/Times-Roman@0 SF .65(The re)97 252.6 R .65(gular e) +-.165 F .65(xpression e)-.165 F .65 +(xtension de\214nes Scheme language bindings for the POSIX re)-.165 F(gular) +-.165 E -.165(ex)72 267.6 S .086(pression functions that are pro).165 F .087 +(vided by most modern UNIX v)-.165 F .087(ersions \()-.165 F/F4 11 +/Times-Italic@0 SF -.407(re)C(gcomp\(\))-.033 E F3(and)2.837 E F4 -.407(re) +2.837 G -.11(ge)-.033 G(xec\(\))-.11 E F3(\).)A -1.21(Yo)72 282.6 S 3.014(um) +1.21 G .263(ay w)101.304 282.6 R .263(ant to refer to your UNIX system')-.11 F +(s)-.605 E F4 -.407(re)3.013 G(gcomp\(3\))-.033 E F3 .263(manual for details.) +3.013 F .263(The Scheme inter)5.763 F(-)-.22 E -.11(fa)72 297.6 S 1.35 +(ce to the re).11 F 1.35(gular e)-.165 F 1.35(xpression functions mak)-.165 F +1.351(es the entire functionality of the usual C language)-.11 F(interf)72 +312.6 Q .24(ace a)-.11 F -.275(va)-.22 G .24(ilable to the Scheme programmer) +.275 F 5.74(.T)-.605 G 2.99(ol)289.458 312.6 S .24(oad the re)301.006 312.6 R +.24(gular e)-.165 F .24(xpression e)-.165 F .239(xtension, e)-.165 F -.275(va) +-.275 G(luate).275 E(the e)72 327.6 Q(xpression)-.165 E/F5 10/Courier@0 SF +(\(require 'regexp\))100.346 350.103 Q F3 2.251(This causes the \214les)97 +375.703 R F4 -.407(re)5.001 G -.11(ge)-.033 G(xp.scm)-.11 E F3(and)5.001 E F4 +-.407(re)5.002 G -.11(ge)-.033 G(xp.o)-.11 E F3 2.252(to be loaded \()5.002 F +F4 -.407(re)C -.11(ge)-.033 G(xp.o)-.11 E F3 2.252(must be statically)5.002 F +(link)72 390.703 Q(ed with the interpreter on platforms that do not support dy\ +namic loading of object \214les\).)-.11 E 1.246(Loading the e)97 409.303 R +1.246(xtension pro)-.165 F 1.246(vides the features)-.165 F F4 -.407(re)3.996 G +-.11(ge)-.033 G(xp)-.11 E F3(and)3.996 E F4 -.407(re)3.995 G -.11(ge)-.033 G +(xp.o)-.11 E F3 6.745(.O)C 3.995(ns)406.125 409.303 S 1.245(ystems that do not) +419.899 409.303 R 1.384(support the re)72 424.303 R 1.385(gular e)-.165 F 1.385 +(xpression library functions, loading the e)-.165 F 1.385(xtension succeeds, b) +-.165 F 1.385(ut no further)-.22 F(primiti)72 439.303 Q -.165(ve)-.275 G 3.725 +(so).165 G 3.725(rf)125.401 439.303 S .975(eatures are de\214ned.)136.452 +439.303 R .975(Otherwise, the additional feature)6.475 F F4(:r)3.724 E -.44(eg) +-.407 G(ular).44 E(-e)-.22 E(xpr)-.22 E(essions)-.407 E F3 .974(is pro-)3.724 F +(vided, so that the e)72 454.303 Q(xpression)-.165 E F5 +(\(feature? ':regular-expressions\))100.346 476.806 Q F3 .649 +(can be used in Scheme programs to check whether re)72 498.806 R .65(gular e) +-.165 F .65(xpressions are a)-.165 F -.275(va)-.22 G .65(ilable on the local) +.275 F(platform.)72 513.806 Q F2 2.75(2. Cr)72 543.806 R(eating Regular Expr) +-.198 E(essions)-.198 E(\(mak)72 573.806 Q(e-r)-.11 E(egexp)-.198 E F4(pattern) +4.583 E F2 279.654(\)p)C -.198(ro)462.244 573.806 S(cedur).198 E(e)-.198 E +(\(mak)72 588.806 Q(e-r)-.11 E(egexp)-.198 E F4(pattern \215a)4.583 E(gs)-.11 E +F2 256.235(\)p)C -.198(ro)462.244 588.806 S(cedur).198 E(e)-.198 E F4(mak)72 +607.406 Q(e-r)-.11 E -1.98 -.44(eg e)-.407 H(xp).22 E F3 .312 +(returns an object of the ne)3.062 F 3.062(wS)-.275 G .312(cheme type)263.538 +607.406 R F4 -.407(re)3.062 G -.11(ge)-.033 G(xp)-.11 E F3 .312 +(representing the re)3.062 F .312(gular e)-.165 F(xpression)-.165 E 1.806 +(speci\214ed by the string ar)72 622.406 R(gument)-.198 E F4(pattern)4.556 E F3 +7.306(.A)C 4.556(ne)274.511 622.406 S 1.807 +(rror is signaled if the underlying call to the C)289.451 622.406 R 1.494 +(library function)72 637.406 R F4 -.407(re)4.243 G(gcomp\(3\))-.033 E F3 -.11 +(fa)4.243 G 4.243(ils. The).11 F(optional)4.243 E F4<8d61>4.243 E(gs)-.11 E F3 +(ar)4.243 E 1.493(gument is a list of zero or more of the)-.198 F(symbols)72 +652.406 Q F4 -.22(ex)4.907 G 2.157(tended, ignor).22 F(e-case)-.407 E 4.907(,n) +-.11 G(o-sube)224.683 652.406 Q(xpr)-.22 E(,)-1.221 E F3(and)4.908 E F4(ne) +4.908 E(wline)-.165 E F3 4.908(;t)C 2.158(hese correspond to the C constants) +340.761 652.406 R F1(REG_EXTENDED, REG_ICASE, REG_NOSUB,)72 667.406 Q F3(and) +2.75 E F1(REG_NEWLINE)2.75 E F3(.)A -1.1 -.88(Tw o)97 686.006 T 1.085 +(objects of the type)4.716 F F4 -.407(re)3.835 G -.11(ge)-.033 G(xp)-.11 E F3 +1.085(are equal in the sense of)3.835 F F4(equal?)3.835 E F3 1.085 +(if their \215ags are identical)3.835 F .811 +(and if their patterns are equal in the sense of)72 701.006 R F4(string=?)3.561 +E F3 6.311(.T)C 1.031 -.11(wo r)330.951 701.006 T -.165(eg).11 G .811(ular e) +.165 F .812(xpressions are)-.165 F F4(eq?)3.562 E F3 .812(if their)3.562 F +(\215ags are identical and if the)72 716.006 Q 2.75(ys)-.165 G +(hare the same pattern string.)206.255 716.006 Q EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(r)72 87 Q(egexp?)-.198 E/F2 11 +/Times-Italic@0 SF(obj)4.583 E F1 321.091(\)p)C -.198(ro)462.244 87 S(cedur) +.198 E(e)-.198 E F0(This type predicate returns #t if)72 105.6 Q F2(obj)2.75 E +F0(is a re)2.75 E(gular e)-.165 E(xpression, #f otherwise.)-.165 E F1(\(r)72 +135.6 Q(egexp-patter)-.198 E(n)-.165 E F2 -.407(re)4.583 G -.11(ge)-.033 G(xp) +-.11 E F1 273.571(\)p)C -.198(ro)462.244 135.6 S(cedur).198 E(e)-.198 E(\(r)72 +150.6 Q(egexp-\215ags)-.198 E F2 -.407(re)4.583 G -.11(ge)-.033 G(xp)-.11 E F1 +286.837(\)p)C -.198(ro)462.244 150.6 S(cedur).198 E(e)-.198 E F0 .179 +(These primiti)72 169.2 R -.165(ve)-.275 G 2.929(sr).165 G .179 +(eturn the pattern \(or \215ags, respecti)151.965 169.2 R -.165(ve)-.275 G .179 +(ly\) speci\214ed in the call to).165 F F2(mak)2.929 E(e-r)-.11 E -1.98 -.44 +(eg e)-.407 H(xp).22 E F0(that)2.928 E(has created the re)72 184.2 Q(gular e) +-.165 E(xpression object.)-.165 E F1 2.75(3. Matching)72 214.2 R(Regular Expr) +2.75 E(essions)-.198 E(\(r)72 244.2 Q(egexp-exec)-.198 E F2 -.407(re)4.583 G +-.11(ge)-.033 G(xp string of)-.11 E(fset)-.198 E F1 233.267(\)p)C -.198(ro) +462.244 244.2 S(cedur).198 E(e)-.198 E(\(r)72 259.2 Q(egexp-exec)-.198 E F2 +-.407(re)4.583 G -.11(ge)-.033 G(xp string of)-.11 E(fset \215a)-.198 E(gs)-.11 +E F1 209.848(\)p)C -.198(ro)462.244 259.2 S(cedur).198 E(e)-.198 E F0 .27 +(This primiti)72 277.8 R .6 -.165(ve a)-.275 H .27(pplies the speci\214ed re) +.165 F .27(gular e)-.165 F .27(xpression to the gi)-.165 F -.165(ve)-.275 G +3.021(ns).165 G .271(tring starting at the gi)373.516 277.8 R -.165(ve)-.275 G +3.021(no).165 G -.275(ff)493.286 277.8 S(-).275 E(set.)72 292.8 Q F2(of)6.064 E +(fset)-.198 E F0 .563(is an inte)3.313 F .563(ger lar)-.165 F .563 +(ger than or equal to zero and less than or equal to the length of)-.198 F F2 +(string)3.313 E F0(.)A .149(If the match succeeds,)72 307.8 R F2 -.407(re)2.9 G +-.11(ge)-.033 G(xp-e)-.11 E(xec)-.22 E F0 .15(returns an object of the ne)2.9 F +2.9(wS)-.275 G .15(cheme type)359.714 307.8 R F2 -.407(re)2.9 G -.11(ge)-.033 G +(xp-matc)-.11 E(h)-.165 E F0 2.9(,o)C(ther)483.452 307.8 Q(-)-.22 E .492 +(wise #f.)72 322.8 R .492(The optional)5.992 F F2<8d61>3.242 E(gs)-.11 E F0(ar) +3.242 E .492(gument is a list of zero or more of the symbols)-.198 F F2 +(not-bol)3.241 E F0(and)3.241 E F2(not-eol)3.241 E F0 +(which correspond to the constants)72 337.8 Q/F3 10/Times-Italic@0 SF(REG_NO) +2.75 E(TBOL)-.4 E F0(and)2.75 E F3(NO)2.75 E(T_EOL)-.4 E F0 +(in the C language interf)2.75 E(ace.)-.11 E F1(\(r)72 367.8 Q(egexp-match?) +-.198 E F2(obj)4.583 E F1 288.102(\)p)C -.198(ro)462.244 367.8 S(cedur).198 E +(e)-.198 E F0 1.07(This type predicate returns #t if)72 386.4 R F2(obj)3.82 E +F0 1.07(is a re)3.82 F 1.071(gular e)-.165 F 1.071 +(xpression match \(that is, the return v)-.165 F 1.071(alue of a)-.275 F +(successful call to)72 401.4 Q F2 -.407(re)2.75 G -.11(ge)-.033 G(xp-matc)-.11 +E(h)-.165 E F0(\), #f otherwise.)A F1(\(r)72 431.4 Q(egexp-match-number)-.198 E +F2(matc)4.583 E(h)-.165 E F1 239.999(\)p)C -.198(ro)462.244 431.4 S(cedur).198 +E(e)-.198 E F0 1.425(This primiti)72 450 R 1.755 -.165(ve r)-.275 H 1.424 +(eturns the number of substrings that matched parenthetic sube).165 F 1.424 +(xpressions in the)-.165 F .159(original pattern when the gi)72 465 R -.165(ve) +-.275 G 2.909(nm).165 G .16(atch w)221.141 465 R .16 +(as created, plus one \(the \214rst substring corresponds to the)-.11 F .407 +(entire re)72 480 R .407(gular e)-.165 F .407(xpression rather than a sube) +-.165 F .407(xpression; see)-.165 F F2 -.407(re)3.157 G -.11(ge)-.033 G +(xec\(3\))-.11 E F0 .407(for details\).)3.157 F 3.156(Av)5.907 G .406 +(alue of zero)451.268 480 R 1.2 +(is returned if the match has been created by applying a re)72 495 R 1.201 +(gular e)-.165 F 1.201(xpression with the)-.165 F F2(no-sube)3.951 E(xpr)-.22 E +F0(\215ag set.)72 510 Q F1(\(r)72 540 Q(egexp-match-start)-.198 E F2(matc)4.583 +E 2.75(hn)-.165 G(umber)205.426 540 Q F1 218.934(\)p)C -.198(ro)462.244 540 S +(cedur).198 E(e)-.198 E(\(r)72 555 Q(egexp-match-end)-.198 E F2(matc)4.583 E +2.75(hn)-.165 G(umber)200.553 555 Q F1 223.807(\)p)C -.198(ro)462.244 555 S +(cedur).198 E(e)-.198 E F0 .138(These primiti)72 573.6 R -.165(ve)-.275 G 2.888 +(sr).165 G .138(eturn the start of)151.883 573.6 R .138(fset \(or end of)-.275 +F .138(fset, respecti)-.275 F -.165(ve)-.275 G .137 +(ly\) of the substring denoted by the).165 F(inte)72 588.6 Q(ger)-.165 E F2 +(number)3.869 E F0 6.619(.A)C F2(number)161.036 588.6 Q F0(ar)3.869 E 1.12 +(gument of zero refers to the substring corresponding to the entire)-.198 F +5.654(pattern. The)72 603.6 R(of)5.654 E 2.904(fsets returned by these primiti) +-.275 F -.165(ve)-.275 G 5.654(sc).165 G 2.904(an be directly used as ar) +313.098 603.6 R 2.903(guments to the)-.198 F F2(substring)72 618.6 Q F0 +(primiti)2.75 E .33 -.165(ve o)-.275 H 2.75(fE).165 G(lk.)176.984 618.6 Q EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(4. Example)72 102 R F0 .398(The follo)97 +120.6 R .399(wing program demonstrates a simple Scheme procedure)-.275 F/F2 11 +/Times-Italic@0 SF(matc)3.149 E(hes)-.165 E F0 .399(that returns a list)3.149 F +.045(of substrings of a gi)72 135.6 R -.165(ve)-.275 G 2.795(ns).165 G .045 +(tring that match a gi)182.082 135.6 R -.165(ve)-.275 G 2.794(np).165 G 2.794 +(attern. An)294.604 135.6 R .044(error message is displayed if re)2.794 F +(gular)-.165 E -.165(ex)72 149.6 S +(pressions are not supported by the local platform.).165 E/F3 10/Courier@0 SF +(\(require 'regexp\))72 172.103 Q(\(define \(matches str pat\))72 191.703 Q(\(\ +let loop \(\(r \(make-regexp pat '\(extended\)\)\) \(result '\(\)\) \(from 0\)\ +\))84 205.703 Q(\(let \(\(m \(regexp-exec r str from\)\)\))114 219.703 Q +(\(if \(regexp-match? m\))126 233.703 Q +(\(loop r \(cons \(substring str \(+ from \(regexp-match-start m 0\)\))150 +247.703 Q(\(+ from \(regexp-match-end m 0\)\)\))324 261.703 Q(result\))234 +275.703 Q(\(+ from \(regexp-match-end m 0\)\)\))186 289.703 Q +(\(reverse result\)\)\)\)\))150 303.703 Q EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 13/Times-Bold@0 SF(Index)272.108 123 Q(:)72 174 Q F0(:re)72 204 +Q(gular)-.165 E(-e)-.22 E(xpressions, 1)-.165 E F1(E)72 234 Q F0(equality)72 +264 Q 2.75(,1)-.715 G F1(F)72 294 Q F0(feature, 1)72 324 Q(\215ags, 1, 2)72 339 +Q F1(M)72 369 Q F0(mak)72 399 Q(e-re)-.11 E(ge)-.165 E(xp,)-.165 E/F2 12 +/Times-Bold@0 SF(1)2.75 E F0 2.75(,2)C F1(N)72 429 Q F0(no-sube)72 459 Q(xpr) +-.165 E 2.75(,2)-.44 G F1(P)72 489 Q F0(POSIX, 1)72 519 Q F1(R)72 549 Q F0(re) +72 579 Q(gcomp, 1)-.165 E(re)72 594 Q(ge)-.165 E -.165(xe)-.165 G(c, 2).165 E +(re)72 609 Q(ge)-.165 E(xp-e)-.165 E -.165(xe)-.165 G(c,).165 E F2(2)2.75 E F0 +(re)72 624 Q(ge)-.165 E(xp-\215ags,)-.165 E F2(2)2.75 E F0(re)72 639 Q(ge)-.165 +E(xp-match, 2)-.165 E(re)72 654 Q(ge)-.165 E(xp-match-end,)-.165 E F2(2)2.75 E +F0(re)72 669 Q(ge)-.165 E(xp-match-number)-.165 E(,)-.44 E F2(2)2.75 E F0(re)72 +684 Q(ge)-.165 E(xp-match-start,)-.165 E F2(2)2.75 E F0(re)72 699 Q(ge)-.165 E +(xp-match?,)-.165 E F2(2)2.75 E F0(re)72 714 Q(ge)-.165 E(xp-pattern,)-.165 E +F2(2)2.75 E F0(re)72 729 Q(ge)-.165 E(xp.o, 1)-.165 E(re)302.4 174 Q(ge)-.165 E +(xp.scm, 1)-.165 E(re)302.4 189 Q(ge)-.165 E(xp?,)-.165 E F2(2)2.75 E F1(S) +302.4 219 Q F0(sube)302.4 249 Q(xpression, 2)-.165 E(substring primiti)302.4 +264 Q -.165(ve)-.275 G 2.75(,2).165 G F1(T)302.4 294 Q F0(type predicate, 2) +302.4 324 Q F1(U)302.4 354 Q F0(UNIX, 1)302.4 384 Q EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 13/Times-Bold@0 SF -1.196(Ta)239.127 123 S(ble of Contents)1.196 E/F1 11 +/Times-Roman@0 SF .866(Introduction ..........................................\ +..............................................................................\ +......)72 177.6 R(1)498.5 177.6 Q(Creating Re)72 196.2 Q(gular Expressions) +-.165 E 19.25(................................................................\ +.................................. 1)3.792 F(Matching Re)72 214.8 Q +(gular Expressions)-.165 E 19.25(.............................................\ +................................................... 2)5.013 F 2.395(Example ..\ +..............................................................................\ +...................................................)72 233.4 R(2)498.5 233.4 Q +(Inde)72 252 Q 2.868(x.)-.165 G 19.25(........................................\ +..............................................................................\ +.................. 4)102.5 252 R EP +%%Trailer +end +%%EOF diff --git a/doc/unix/Makefile b/doc/unix/Makefile new file mode 100644 index 0000000..411a2ff --- /dev/null +++ b/doc/unix/Makefile @@ -0,0 +1,24 @@ +MANUAL= unix +TROFF= groff -ms -t +UNROFF= unroff -ms + +$(MANUAL).ps: $(MANUAL).ms index.ms + (cat $(MANUAL).ms ../util/tmac.index index.ms; echo ".Tc")\ + | $(TROFF) 2> /dev/null > $(MANUAL).ps + +$(MANUAL).html: $(MANUAL).ms + (cat $?; echo ".Tc") | $(UNROFF) document=$(MANUAL) + +index.ms: $(MANUAL).ms index.raw + sort -f -t# +1 -3 +0n index.raw | awk -f ../util/fixindex.awk\ + | awk -f ../util/block.awk >index.ms + +index.raw: $(MANUAL).ms + $(TROFF) $(MANUAL).ms 2> index.raw >/dev/null + +check: + checknr -c.Ul.Pr.Sy.Va.Sh.Ix.Id.Ch -a.Ss.Se.[[.]] $(MANUAL).ms |\ + grep -v "Empty command" + +clean: + rm -f index.raw index.ms $(MANUAL).ps $(MANUAL).html diff --git a/doc/unix/unix.ms b/doc/unix/unix.ms new file mode 100644 index 0000000..4122cc3 --- /dev/null +++ b/doc/unix/unix.ms @@ -0,0 +1,1661 @@ +.so ../util/tmac.scheme +.Ul +.TL +Reference Manual for the +.sp .5 +Elk UNIX Extension +.AU +Oliver Laumann +. +.Ch "Introduction" +. +.PP +This reference manual describes the primitive procedures and record types +defined by the UNIX extension to Elk. +.PP +The UNIX extension provides easy access to most widely available +UNIX system calls and C library functions from within Scheme programs. +The extension supports a wide range of different UNIX platforms without +restricting its functionality to the lowest common denominator or the +.Ix POSIX +POSIX 1003.1 functions. +To simplify writing portable Scheme programs, the extension +attempts to hide differences between the types of supported UNIX flavors. +For example, programmers do not have to deal with the idiosyncrasies +of the \f2wait()\fP, \f2waitpid()\fP, \f2wait3()\fP, and \f2wait4()\fP +system calls or the \f2mktemp()\fP, \f2tmpnam()\fP, and \f2tempnam()\fP +functions. +.PP +The UNIX extension defines procedures for low-level, +file-descriptor-based I/O; creation of pipes; file/record locking; file +and directory system calls; process creation and control; signal +handling; error handling; and obtaining information about date, time, +users, limits, process resources, etc. +Terminal control is not yet supported by the current version. +.PP +The reference manual assumes that you are familiar with the most common +UNIX system calls and C library functions; this document does not +attempt to duplicate the contents of the standard UNIX documentation. +Detailed descriptions are provided for functions that differ from +the standard UNIX semantics. +. +.Ch "Using the UNIX Extension" +. +.PP +The UNIX extension is loaded by evaluating +.Ss +(require 'unix) +.Se +in the interactive toplevel or in a Scheme program. +.PP +This causes the files \f2unix.scm\fP and \f2unix.o\fP to be loaded +into the interpreter (\f2unix.o\fP has to be linked with the +interpreter on platforms that do not support dynamic loading of +object files). +In addition, the +.Ix "record extension" +\f2record\fP extension is automatically loaded if it is not yet present. +The record extension is documented in a separate reference manual. +.PP +Loading the UNIX extension causes the +.Ix features +features \f2unix\fP and \f2unix.o\fP to be provided. +Optionally, one or more of the following features (described below) may +be provided by the extension to indicate that certain UNIX features +are available: +.Ss +unix:wait-options +unix:wait-process +unix:record-locks +unix:file-locking +unix:symlinks +unix:reliable-signals +.Se +.Ix unix:wait-options +.Ix unix:wait-process +.Ix unix:record-locks +.Ix unix:file-locking +.Ix unix:symlinks +.Ix unix:reliable-signals +. +.Ch "Record Types" +. +.PP +Several procedures return their results as Scheme +.Ix records +records. +All record types defined by the UNIX extension are stored in variables +with names of the form \f2-record\fP (such as +\f2system-record\fP or \f2passwd-record\fP). +In addition, a type predicate, a record constructor, and accessor functions +.Ix "type predicate" +.Ix "record constructor" +.Ix "accessor functions" +for all record fields are defined for each record type. +For example, a \f2system\fP record type with the fields \f2hostname\fP, +\f2sysname\fP, and \f2osname\fP is defined, resulting in variable +\f2system-record\fP holding the record type descriptor, and the functions +.Ss +(system-record? obj) +(make-system-record) +.sp .5 +(system-hostname system-record) +(system-sysname system-record) +(system-osname system-record) +.Se +Use \f2define-record-modifiers\fP if you need the +.Ix "modifier functions" +modifier functions for any of the records as well (see the record +extension reference manual for details). +.LP +The following +.Ix "record types" +record types are defined by the UNIX extension: +.sp .5 +.KS +.TS +allbox, tab(~); +c c +lf5 lf5. +Record Type~Fields +_ +stat~type mode ino dev nlink uid gid size atime mtime ctime +time~T{ +seconds minutes hours day-of-month month year weekday +.br +day-of-year dst +T} +nanotime~nanoseconds minuteswest dst +system~hostname sysname osname +passwd~name password uid gid gecos homedir shell +group~name password gid members +resources~user-time system-time (...) +lock~exclusive? whence start length +wait~pid status code core-dump? resources +.TE +.KE +.Ix stat-record +.Ix time-record +.Ix nanotime-record +.Ix system-record +.Ix passwd-record +.Ix group-record +.Ix resources-record +.Ix lock-record +.Ix wait-record +. +.Ch "Error Handling" +. +.PP +The default error behavior of the primitive procedures defined by +the UNIX extension is to invoke the standard Scheme +.Ix "error handler" +error handler if a UNIX system call or library function fails. +As an alternative, if a specific error action is to be performed +by the application, a primitive procedure can be invoked under +control of the +.Ix unix-errval +\f2unix-errval\fP form. +In this case, a unique +.Ix "error object" +\f2error object\fP is returned if a UNIX function signals an error. +The standard UNIX system error message and the UNIX error number +are made available to the application in any case. +Details of the error handling facilities are described in the +section ``Error Functions'' below. +. +.Ch "Conventions" +. +.PP +In the following sections, the names of procedure arguments can +dictate that the arguments are of specific types. +If an argument name is also the name of a Scheme data +type, the argument must be an object of that type. +For example, a procedure with an argument named \f2string\fP must +be invoked with a string. +File descriptor arguments (named \f2fdescr\fP, or \f2fdescr\*1\fP, +\f2fdescr\*2\fP, etc.) and arguments named \f2length\fP are always +non-negative integers; +filename arguments (\f2filename\fP) are strings or symbols; +and arguments with the suffix ``?'' are booleans. +. +.Ch "Low-Level I/O, File Descriptors" +. +.Pr unix-close fdescr +.LP +.Ix close +The UNIX \f2close()\fP system call. +\f2unix-close\fP returns the non-printing object. +. +.[[ +.Pr unix-dup fdescr +.Pr unix-dup fdescr\*1 fdescr\*2 +.]] +.LP +.Ix dup +.Ix dup2 +\f2unix-dup\fP invokes the \f2dup()\fP (first form) or \f2dup2()\fP +(second form) system call. +The result is a new file descriptor (an integer). +. +.[[ +.Pr unix-open filename flags +.Pr unix-open filename flags mode +.]] +.LP +.Ix open +The UNIX \f2open()\fP system call. +\f2flags\fP is a list of one or more symbols specifying the bitmask +argument of the \f2open()\fP system call. +.LP +At least the flag symbols \f2read\fP, \f2write\fP, \f2append\fP, +\f2create\fP, \f2truncate\fP, and \f2exclusive\fP are supported; +additional symbols (such as \f2ndelay\fP) may be permitted on +certain platforms. +The procedure \f2unix-list-open-modes\fP can be used to obtain the list +of flag symbols that are supported (see below). +If \f2create\fP is present in the \f2flags\fP argument, the \f2mode\fP +argument (an integer) must be supplied. +At least one of the symbols \f2read\fP or \f2write\fP must be present +in \f2flags\fP. +.LP +\f2unix-open\fP returns a new file descriptor (an integer). +.LP +Example: +.Ss +(let ((f1 (unix-open "/etc/passwd" '(read)) + (f2 (unix-open "temp" '(read write create truncate) #o666)))) + ...) +.Se +. +.Pr unix-list-open-modes +.LP +This procedure returns the list of \f2flag\fP symbols for the +\f2unix-open\fP procedure that are supported on the local platform. +. +.Pr unix-lseek fdescr offset whence +.LP +.Ix lseek +The UNIX \f2lseek()\fP system call. +\f2offset\fP is an integer; \f2whence\fP is one of +the symbols \f2set\fP, \f2current\fP, and \f2end\fP. +\f2unix-lseek\fP returns the new file position as an integer. +. +.Pr unix-pipe +.LP +.Ix pipe +The \f2pipe()\fP system call. +\f2unix-pipe\fP returns two file descriptors as a pair of integers. +. +.[[ +.Pr unix-read-string-fill! fdescr string +.Pr unix-read-string-fill! fdescr string length +.]] +.LP +.Ix read +The \f2read()\fP system call. +\f2unix-read-string-fill\fP invokes \f2read()\fP +with the Scheme string as input buffer and the length of the string +argument (first form) or the length supplied as a third argument +(second form). +If \f2length\fP is specified, it must be an integer between 0 and +the length of \f2string\fP. +.LP +\f2unix-read-string-fill!\fP destructively overwrites the contents of the +\f2string\fP argument. +It returns the number of characters actually read (0 on EOF). +. +.[[ +.Pr unix-write fdescr string +.Pr unix-write fdescr string length +.]] +.LP +.Ix write +The \f2write()\fP system call. +For a description of the arguments see \f2unix-read-string-fill!\fP above. +\f2unix-write\fP returns the number of characters actually written. +. +.[[ +.Pr unix-close-on-exec fdescr +.Pr unix-close-on-exec fdescr on? +.]] +.LP +\f2unix-close-on-exec\fP returns the value of the +.Ix close-on-exec +\f2close-on-exec\fP flag for the given file descriptor as a boolean. +If invoked with a second argument, the procedure sets the +\f2close-on-exec\fP flag to the specified value and returns the +previous value. +. +.[[ +.Pr unix-filedescriptor-flags fdescr +.Pr unix-filedescriptor-flags fdescr flags +.]] +.LP +\f2unix-file-descriptor-flags\fP obtains the flags currently active +for the given file descriptor (by means of the +.Ix fcntl +\f2fcntl()\fP system call) and returns them as a list of symbols. +If invoked with a second arguments (a list of symbols), the procedure +sets the flags to that argument and returns the previous value. +.LP +At least the flag symbol \f2append\fP is supported; +additional symbols (such as \f2ndelay\fP or \f2sync\fP) may be permitted on +certain platforms. +The procedure \f2unix-list-filedescriptor-flags\fP can be used to obtain +the list of file descriptor flags that are supported (see below). +.LP +Example: +.Ss +;;; Enable non-blocking I/O for file descriptor (assumes POSIX) +.sp .4 +(define (set-non-blocking fd) + (let ((flags (unix-filedescriptor-flags fd))) + (unix-filedescriptor-flags fd (cons 'nonblock flags)))) +.Se +. +.Pr unix-list-filedescriptor-flags +.LP +This procedure returns the list of file descriptor \f2flag\fP symbols +that can be returned and set by \f2unix-filedescriptor-flags\fP +on the local platform. +. +.Pr unix-num-filedescriptors +.LP +\f2unix-num-filedescriptors\fP returns the maximum number of file +descriptors per process in the local system. +Depending on the UNIX flavor, the procedure invokes +.Ix getdtablesize +.Ix sysconf +\f2getdtablesize()\fP or \f2sysconf()\fP or uses a static (compile-time) +limit. +. +.Pr unix-isatty? fdescr +.LP +Returns #t if the specified file descriptor points to a terminal +device, #f otherwise (the UNIX +.Ix isatty +\f2isatty()\fP library function). +. +.Pr unix-ttyname fdescr +.LP +.Ix ttyname +The UNIX \f2ttyname()\fP function. +Returns the name of a terminal device as a string, or #f if the +file descriptor is not associated with a terminal. +. +.Pr unix-port-filedescriptor port +.LP +This procedure returns the file descriptor associated with the +.Ix "file pointer" +file pointer conveyed in the specified Scheme port. +An error is signaled if the port has already been closed or if it +is a string port. +\f2unix-port-filedescriptor\fP invokes the UNIX +.Ix fileno +\f2fileno()\fP library function. +.LP +Manipulating a file descriptor obtained by \f2unix-port-filedescriptor\fP +can cause unexpected interactions with the standard Scheme I/O functions +and with the stdio buffering mechanism. +In particular, it is not a good idea to close the file descriptor +associated with the Scheme system's current input port or current +output port. +.LP +Example: +.Ss +(let ((stdout-fileno + (unix-port-filedescriptor (current-output-port)))) + (if (unix-isatty? stdout-fileno) + (begin + (display (unix-ttyname stdout-fileno)) + (newline)))) +.Se +. +.Pr unix-filedescriptor\(mi>port fdescr type +.LP +Creates a Scheme port with a file pointer containing the specified +file descriptor. +\f2unix-filedescriptor\(mi>port\fP is based on the +.Ix fdopen +\f2fdopen()\fP stdio function. +\f2type\fP is a string and is used as the second argument for +\f2fdopen()\fP. +.LP +The type of the newly created Scheme port is determined by the +\f2type\fP argument. +If \f2type\fP begins with the character #\\r, an input port is created; +#\\w and #\\a indicate an output port. +If the second character of \f2type\fP is #\\+ (\f2update\fP), an +input-output (bidirectional) port is created. +.LP +No filename is associated with a Scheme port created by a call +to \f2unix-filedescriptor\(mi>port\fP. +Instead, the string \f2unix-filedescriptor[%d]\fP (where \f2%d\fP is +replaced by the numerical value of the file descriptor) will be +returned by calls to \f2port-file-name\fP and displayed when printing +the port. +.LP +Note that the file descriptor is closed by the +.Ix "garbage collector" +garbage collector when the Scheme port becomes inaccessible. +. +.Ch "Files and Directories" +. +.Pr unix-stat file +.LP +.Ix stat +.Ix fstat +The UNIX \f2stat()\fP/\f2fstat()\fP system call. +\f2file\fP is either a filename or a file descriptor. +.LP +\f2unix-stat\fP returns a +.Ix stat-record +\f2stat-record\fP with the following fields: +.sp .5 +.KS +.TS +allbox, tab(~); +c c c +lf5 l l. +Field~Type~Contents +_ +type~symbol~file type +mode~integer~file access mode +ino~integer~inode number +dev~integer~device number +nlink~integer~number of links to file +uid~integer~file owner's user-ID +gid~integer~file owner's group-ID +size~integer~file size +atime~integer~last access time +mtime~integer~last modified time +ctime~integer~last inode change time +.TE +.KE +.LP +The file type is one of the symbols \f2directory\fP, +\f2character-special\fP, \f2block-special\fP, \f2regular\fP, +\f2symlink\fP, \f2socket\fP, \f2fifo\fP, or \f2unknown\fP. +. +.Pr unix-access? filename mode +.LP +\f2unix-access?\fP is based on the +.Ix access +\f2access()\fP system call. +\f2mode\fP is a list of zero or more of the symbols \f2read\fP, +\f2write\fP, and \f2execute\fP. +The empty list can be used to test for existence of the file. +The procedure returns #t if the specified access is granted, #f otherwise. +. +.Pr unix-chdir filename +.LP +.Ix chdir +The UNIX \f2chdir()\fP system call. +\f2unix-chdir\fP returns the non-printing object. +. +.Pr unix-chmod filename mode +.LP +.Ix chmod +The UNIX \f2chmod()\fP system call. +\f2mode\fP is an integer. +\f2unix-chmod\fP returns the non-printing object. +. +.Pr unix-chown filename uid gid +.LP +.Ix chown +The UNIX \f2chown()\fP system call. +\f2uid\fP and \f2gid\fP are integers. +\f2unix-chown\fP returns the non-printing object. +. +.Pr unix-unlink filename +.LP +.Ix unlink +The UNIX \f2unlink()\fP system call. +\f2unix-unlink\fP returns the non-printing object. +. +.Pr unix-link filename\*1 filename\*2 +.LP +.Ix link +The UNIX \f2link()\fP system call. +\f2unix-link\fP returns the non-printing object. +. +.Pr unix-rename filename\*1 filename\*2 +.LP +.Ix rename +The UNIX \f2rename()\fP system call. +\f2unix-rename\fP returns the non-printing object. +.LP +On platforms where the \f2rename()\fP function is not available, +the operation is performed by the equivalent sequence of +.Ix link +.Ix unlink +\f2link()\fP and \f2unlink()\fP calls with interrupts disabled +(certain restrictions apply in this case, e.\|g.\& directories cannot +be renamed). +. +.Pr unix-mkdir filename mode +.LP +.Ix mkdir +The UNIX \f2mkdir()\fP system call. +\f2mode\fP is an integer. +\f2unix-mkdir\fP returns the non-printing object. +. +.Pr unix-rmdir filename +.LP +.Ix rmdir +The UNIX \f2rmdir()\fP system call. +\f2unix-rmdir\fP returns the non-printing object. +. +.[[ +.Pr unix-utime filename +.Pr unix-utime filename atime mtime +.]] +.LP +.Ix utime +The UNIX \f2utime()\fP function. +\f2unix-utime\fP sets the last access and last modification time of +the given file to the current time (first form) or to the specified +times (second form). +\f2atime\fP and \f2mtime\fP are integers. +\f2unix-utime\fP returns the non-printing object. +. +.Pr unix-read-directory filename +.LP +This procedure returns the contents of the specified directory +as a list of filenames (strings). +\f2filename\fP must be the name of a directory. +\f2unix-read-directory\fP is based on the +.Ix opendir +.Ix readdir +.Ix closedir +\f2opendir()\fP, \f2readdir()\fP, and \f2closedir()\fP functions. +.LP +Example: +.Ss +;;; Return directory contents as list of (filename . filetype) pairs +.sp .4 +(define (get-files-and-types directory) + (map + (lambda (file) + (cons file (stat-type (unix-stat file)))) + (unix-read-directory directory))) +.sp .6 +(pp (get-files-and-types ".")) +.Se +. +.KS +.[[ +.Pr unix-tempname +.Pr unix-tempname directory +.Pr unix-tempname directory prefix +.]] +.KE +.LP +\f2unix-tempname\fP returns a pathname that can be used as the name of a +.Ix "temporary file" +temporary file (typically in +.Ix /tmp +.Ix /usr/tmp +/tmp or /usr/tmp). +The newly created pathname is not the name of an existing file. +.LP +\f2directory\fP (a string or symbol) can be used to specify the +directory component of the pathname; +\f2prefix\fP (string or symbol), if present, may be used as a prefix +for the filename component of the pathname. +However, both arguments may be ignored by \f2unix-tempname\fP. +.LP +\f2unix-tempname\fP is based on one of the UNIX functions +.Ix tempnam +.Ix mktemp +.Ix tmpnam +\f2tempnam()\fP, \f2mktemp()\fP, and \f2tmpnam()\fP (in that order); +if none of these functions is available, an algorithm similar to +the one employed by UNIX \f2mktemp()\fP is used. +. +.Ch "Symbolic Links" +. +.PP +The following procedures are only defined on platforms that support +.Ix "symbolic links" +symbolic links. +In this case, the feature +.Ix unix:symlinks +\f2unix:symlinks\fP is provided when the UNIX extension is loaded. +. +.Pr unix-lstat filename +.LP +.Ix lstat +The UNIX \f2lstat()\fP system call. +\f2unix-lstat\fP returns a +.Ix stat-record +\f2stat-record\fP (see \f2unix-stat\fP above). +. +.Pr unix-readlink filename +.LP +.Ix readlink +The UNIX \f2readlink()\fP system call. +\f2unix-readlink\fP returns the contents of specified symbolic +link as a string. +. +.Pr unix-symlink filename\*1 filename\*2 +.LP +.Ix symlink +The UNIX \f2symlink()\fP system call. +\f2unix-symlink\fP returns the non-printing object. +. +.Ch "File and Record Locking" +. +.PP +The procedures described in this section are only defined if some form +of file-based +.Ix locking +locking is available on the local system (either locking of entire files, or +.Ix "record locking" +record locking). +In this case, the feature +.Ix unix:file-locking +\f2unix:file-locking\fP is provided at the time the UNIX extension is loaded. +If the local system supports locking of individual file segments, +the feature +.Ix unix:record-locks +\f2unix:record-locks\fP is provided as well, and the locking +primitives are based on the +.Ix fcntl +\f2fcntl()\fP system call +(otherwise the +.Ix flock +\f2flock()\fP system call is used). +. +.Pr unix-set-lock fdescr lock wait? +.LP +The \f2lock\fP argument is a +.Ix lock-record +\f2lock-record\fP with these fields: +.sp .5 +.KS +.TS +allbox, tab(~); +c c c +lf5 l l. +Field~Type~Contents +_ +exclusive?~boolean~T{ +.nf +exclusive lock (write lock) if #t, +shared lock (read lock) otherwise +T} +whence~symbol~T{ +.nf +\f2set\fP, \f2current\fP, or \f2end\fP: +interpretation of \f2start\fP (see \f2unix-lseek\fP) +T} +start~integer~relative offset in bytes +length~integer~T{ +.nf +length in bytes +(0 means lock to EOF) +T} +.TE +.KE +.LP +.Ix "record locks" +If record locks are supported, the fields \f2whence\fP, \f2start\fP, +and \f2length\fP specify a segment in the file referred to +by \f2fdescr\fP that is to be locked or unlocked. +If only entire files can be locked, the contents of these fields are +ignored by the lock procedures. +.LP +An arbitrary number of +.Ix "shared lock" +shared locks for a file or file segment +may be active at a given time, but more than one +.Ix "exclusive lock" +exclusive lock, +or both shared and exclusive locks, cannot be set at the same time. +\f2fdescr\fP must be opened for reading to be able to set a +shared lock; it must be opened with write access for an exclusive lock. +A shared lock may be upgraded to an exclusive lock, and vice versa. +Mandatory locking may or may not be supported by the local system. +.LP +If the \f2wait?\fP argument is #t and the specified lock cannot be +applied, \f2unix-set-lock\fP blocks until the lock becomes available. +.LP +\f2unix-set-lock\fP returns #t if the specified lock could be applied, +#f otherwise. +. +.Pr unix-remove-lock fdescr lock +.LP +This procedure removes the specified file lock or record lock from +the file pointed to by \f2fdescr\fP. +\f2lock\fP is a \f2lock-record\fP; see \f2unix-set-lock\fP above for +a description. +\f2unix-remove-lock\fP returns the non-printing object. +. +.Pr unix-query-lock fdescr lock +.LP +If record locks are not supported, this procedure always returns #f. +If record locks are supported, \f2unix-query-lock\fP returns +information about the first lock that would cause a call to +\f2unix-set-lock\fP with \f2lock\fP to fail or block, or #f if no +such lock exists (i.\|e.\& if claiming the specified lock would succeed). +Information about the lock is returned as a pair; the car is an +integer (the process-ID of the the process that owns the lock), +the cdr is a \f2lock-record\fP. +The process-ID may be meaningless in a network environment. +. +.Ch "Obtaining Password and Group File Entries" +. +.PP +The procedures defined in this section are used to obtain entries +from the system's +.Ix "passwd database" +.Ix "group database" +\f2passwd\fP and \f2group\fP databases. +. +.[[ +.Pr unix-get-passwd +.Pr unix-get-passwd user +.]] +.LP +If invoked without an argument, this procedure returns the next +entry from the \f2passwd\fP database. +Successive calls to \f2unix-get-passwd\fP return entries in a random +order. +The \f2user\fP argument, if present, is either the login name of a user +(a string or symbol) or a numeric user-ID (an integer). +In this case, the \f2passwd\fP entry for this user is returned. +.LP +\f2unix-get-passwd\fP returns a +.Ix passwd-record +\f2passwd-record\fP with the following fields: +.sp .5 +.KS +.TS +allbox, tab(~); +c c c +lf5 l l. +Field~Type~Contents +_ +name~string~login name +password~string~login password +uid~integer~numeric user-ID +gid~integer~numeric primary group-ID +gecos~string~contents of GECOS field +homedir~string~home directory of user +shell~string~login shell of user +.TE +.KE +.LP +\f2unix-get-passwd\fP is based on the UNIX +.Ix getpwent +.Ix getpwuid +.Ix getpwnam +\f2getpwent()\fP, \f2getpwuid()\fP, and \f2getpwnam()\fP functions. +. +.[[ +.Pr unix-get-group +.Pr unix-get-group group +.]] +.LP +\f2unix-get-group\fP is identical to +.Ix unix-get-passwd +\f2unix-get-passwd\fP (see above), except that the system's \f2group\fP +database is used instead of the \f2passwd\fP database. +.LP +The result value is a +.Ix group-record +\f2group-record\fP with these fields: +.sp .5 +.KS +.TS +allbox, tab(~); +c c c +lf5 l l. +Field~Type~Contents +name~string~group's name +password~string~group's password +gid~integer~numeric group-ID +members~list of symbols~group members +.TE +.KE +.LP +\f2unix-get-group\fP is based on the UNIX +.Ix getgrent +.Ix getgrnam +.Ix getgrgid +\f2getgrent()\fP, \f2getgrgid()\fP, and \f2getgrnam()\fP functions. +. +.[[ +.Pr unix-rewind-passwd +.Pr unix-rewind-group +.]] +.LP +These procedures rewind the \f2passwd\fP and \f2group\fP files +by calling the +.Ix setpwent +.Ix setgrent +\f2setpwent()\fP and \f2setgrent()\fP UNIX functions. +. +.[[ +.Pr unix-end-passwd +.Pr unix-end-group +.]] +.LP +\f2unix-end-passwd\fP and \f2unix-end-group\fP close the \f2passwd\fP +and \f2group\fP files by calling the UNIX functions +.Ix endpwent +.Ix endgrent +\f2endpwent()\fP and \f2endgrent()\fP. +. +.Ch "Process Creation and Control" +. +.Pr unix-system string +.LP +\f2unix-system\fP starts +.Ix /bin/sh +``/bin/sh'' as a child process with \f2string\fP as input and waits until the +.Ix shell +shell terminates. +All file descriptors except standard input, standard output, and standard +error output are closed in the child process. +\f2unix-system\fP returns the +.Ix "exit code" +exit code of the shell as an integer or, if the shell was interrupted +by a signal, the +.Ix "termination status" +termination status as a list of one integer element. +If the shell could not be executed, exit code 127 is returned. +. +.[[ +.Pr unix-open-input-pipe string +.Pr unix-open-output-pipe string +.]] +.LP +.Ix popen +The UNIX \f2popen()\fP function. +Both procedures create a +.Ix pipe +pipe between the caller and a +.Ix shell +shell executing the command \f2string\fP; they return a Scheme port +containing the file pointer associated with the pipe. +Closing the Scheme port, or running the garbage collector after the +port has become unused, causes the pipe to be closed by a call to the +.Ix pclose +\f2pclose()\fP function. +.LP +\f2unix-open-input-pipe\fP returns an input port that can be used +to read from the standard output of the specified command; +\f2unix-open-output-pipe\fP returns an output port that accepts +input to be sent to the standard input of the command. +. +.Pr unix-fork +.LP +.Ix fork +The UNIX \f2fork()\fP system call. +\f2unix-fork\fP returns the process-ID of the newly created process +as an integer in the parent process, and the integer 0 in the child process. +.LP +The child process, as its first action, invokes the +.Ix "onfork handlers" +\f2onfork handlers\fP that may have been registered by other Elk extensions +that are currently active (one purpose of \f2onfork\fP handlers is to +make new links to +.Ix "temporary files" +temporary files in the newly created child process). +. +.KS +.[[ +.Pr unix-exec filename arguments +.Pr unix-exec filename arguments environment +.sp .5 +.Pr unix-exec-path filename arguments +.Pr unix-exec-path filename arguments environment +.]] +.KE +.LP +These procedures are based on the UNIX +.Ix execv +\f2execv()\fP family of system calls and library functions. +The first argument is the name of the file to be executed. +\f2arguments\fP is a list of strings to be passed to the program +as arguments. +The \f2environment\fP argument, if present, is a list of +.Ix environment +environment variable definitions to be used as the new program's +environment. +Each element of the list is pair of strings; the car of an element is +the name of an environment variable, the cdr is the variable's value +(the +.Ix unix-environ +\f2unix-environ\fP primitive can be used to obtain the current +environment of the running program). +.LP +\f2unix-exec-path\fP searches the specified filename in a list +of directories obtained from the calling program's +.Ix PATH +PATH environment variable. +The variant of \f2unix-exec-path\fP that accepts an \f2environment\fP +argument is not available on the currently supported platforms (the +reason is that there is no \f2execvpe()\fP variant of the +\f2execvp()\fP function, although \f2execve()\fP/\f2execle()\fP +variants of \f2execv()\fP and \f2execl()\fP usually exist in UNIX). +.LP +\f2unix-exec\fP and \f2unix-exec-path\fP remove the temporary files used +by the dynamic loading module of the interpreter kernel and invoke +the finalization functions that may have been registered by extensions. +As a result, attempting to load an object file after a call to +\f2unix-exec\fP or \f2unix-exec-path\fP has returned (i.\|e.\& failed) +may not work correctly. +The finalization functions are only invoked once. +. +.KS +.[[ +.Pr unix-wait +.Pr unix-wait options +.sp .5 +.Pr unix-wait-process pid +.Pr unix-wait-process pid options +.]] +.KE +.LP +\f2unix-wait\fP and \f2unix-wait-process\fP are based on the UNIX +.Ix wait +\f2wait()\fP family of system calls and library functions. +Both procedures return a +.Ix wait-record +\f2wait-record\fP with the following fields: +.sp .5 +.KS +.TS +allbox, tab(~); +c c c +lf5 l l. +Field~Type~Contents +pid~integer~process-ID of the terminated child process +status~symbol~reason for process termination +code~integer~exit code or termination status (signal) +core-dump?~boolean~#t if a core-dump was produced +resources~resources-record~resources of terminated process +.TE +.KE +.LP +See \f2unix-process-resources\fP below for a description of the +\f2resources-record\fP type. +.LP +The \f2wait-record\fP result holds the process-ID and termination +status of one of the terminated (or stopped) children of the calling +process. +The value of the \f2status\fP is one of the symbols \f2stopped\fP +(if the child process has been stopped), \f2signaled\fP (child +process is terminated due to a signal), or \f2exited\fP (child +process has invoked \f2exit()\fP). +\f2code\fP holds the exit code (if \f2status\fP is \f2exited\fP), +or a signal number (if \f2status\fP is either \f2stopped\fP or +\f2signaled\fP). +The \f2resources\fP field holds the user and system time consumed +by the child process and its children in nanoseconds (additional +resources may be supplied in future versions). +The fields of the \f2resources\fP record are #f on platforms that +do not support the +.Ix wait3 +.Ix wait4 +\f2wait3()\fP or \f2wait4()\fP system call. +.LP +\f2unix-wait-process\fP allows to collect the termination status +of an individual process or a group of processes specified by the +integer \f2pid\fP argument. +This procedure is only defined on platforms where the +.Ix waitpid +.Ix wait4 +\f2waitpid()\fP or \f2wait4()\fP system call is available. +In this case, the feature +.Ix unix:wait-process +\f2unix:wait-process\fP is provided when the UNIX extension is loaded. +.LP +If no child process is available (or, in case of +\f2unix-wait-process\fP, no process as specified by the \f2pid\fP +argument), the \f2pid\fP field in the result is set to -1, and the +\f2status\fP field is set to the symbol \f2none\fP. +.LP +The \f2options\fP argument, if present, is a list of one or more +of the symbols \f2nohang\fP and \f2untraced\fP. +Options are only supported if the feature +.Ix unix:wait-options +\f2unix:wait-options\fP is provided. +. +.Pr unix-process-resources +.LP +This procedure is based on the UNIX +.Ix times +\f2times()\fP library function. +\f2unix-process-resources\fP returns the +.Ix "resource usage" +resource usage of the calling process and its terminated children as +a pair of +.Ix resources-record +\f2resources-records\fP. +Each \f2resources-record\fP has the following fields: +.sp .5 +.KS +.TS +allbox, tab(~); +c c c +lf5 l l. +Field~Type~Contents +user-time~integer~user time in nanoseconds +system-time~integer~system time in nanoseconds +.TE +.KE +.LP +Addition fields may be supplied in future versions. +. +.Pr unix-environ +.LP +\f2unix-environ\fP returns the program's +.Ix environment +environment as a list of pairs. +The car of each element is the name of an environment variable +(a string), the cdr is the value of that variable (a string). +. +.Pr unix-getenv string +.LP +This procedure returns the value of the environment variable with +the name \f2string\fP as a string, or #f if the specified variable +is not defined. +. +.Pr unix-working-directory +.LP +\f2unix-working-directory\fP +returns the calling program's current +.Ix "working directory" +working directory as a string. +The procedure is based on the +.Ix getcwd +.Ix getwd +\f2getcwd()\fP or \f2getwd()\fP function if any of these is available +and invokes the +.Ix pwd +``pwd'' command otherwise. +. +.Pr unix-getlogin +.LP +\f2unix-getlogin\fP returns the +.Ix "login name" +login name as a string (obtained by the UNIX +.Ix getlogin +\f2getlogin()\fP library function). +. +.[[ +.Pr unix-getuids +.Pr unix-getgids +.]] +.LP +\f2unix-getuids\fP (\f2unix-getgids\fP) returns the calling program's +.Ix "real user-ID" +.Ix "effective user-ID" +.Ix "real group-ID" +.Ix "effective group-ID" +real and effective user-IDs (group-IDs) as a pair of integers. +. +.Pr unix-getpids +.LP +\f2unix-getpids\fP returns the +.Ix process-ID +process-ID of the calling process and the +.Ix "parent process-ID" +parent process-ID as a pair of integers. +. +.Pr unix-getgroups +.LP +\f2unix-getgroups\fP returns the current +.Ix "supplementary group-IDs" +supplementary group-IDs of the process as a list of integers. +.LP +Example: +.Ss +;;; Get list of names of supplementary group-IDs +.sp .4 +(define (get-group-names) + (map + (lambda (gid) + (group-name (unix-get-group gid))) + (unix-getgroups))) +.Se +. +.Pr unix-umask mask +.LP +.Ix umask +The UNIX \f2umask()\fP system call. +\f2mask\fP is an integer. +The procedure returns the previous value of the umask. +. +.Pr unix-nice incr +.LP +.Ix nice +The UNIX \f2nice()\fP function. +\f2incr\fP is an integer. +\f2unix-nice\fP returns the new nice value (or zero on some platforms). +. +.Pr unix-sleep seconds +.LP +.Ix sleep +The UNIX \f2sleep()\fP function. +\f2seconds\fP is a positive integer. +The procedure returns the non-printing object. +. +.Ch "Obtaining System Information" +. +.Pr unix-system-info +.LP +This procedure returns a +.Ix system-record +\f2system-record\fP with these fields: +.sp .5 +.KS +.TS +allbox, tab(~); +c c c +lf5 l l. +Field~Type~Contents +hostname~string~the system's hostname +sysname~string~type of hardware platform +osname~string~operating system type and version +.TE +.KE +.LP +The hostname is determined by a call to the UNIX +.Ix gethostname +.Ix uname +\f2gethostname()\fP or \f2uname()\fP function; the system name and OS +name are obtained from the configuration file that has been used to +configure and install Elk. +. +.Pr unix-file-limit limit file +.LP +\f2unix-file-limit\fP can be used to query various system +.Ix limits +limits and options associated with files. +\f2limit\fP is a symbol identifying the type of limit; +\f2file\fP is a filename or file descriptor. +.LP +At least the following limits and options can be queried: +.sp .5 +.KS +.TS +allbox, tab(~); +c c +lf5 l. +Limit/Option~Meaning +_ +max-links~maximum number of links to a file or directory +max-name~maximum length of a filename +max-path~maximum length of a pathname +pipe-buf~pipe buffer size +no-trunc~T{ +.nf +filename exceeding maximum length causes error +instead of being silently truncated +T} +.TE +.KE +.LP +Additional limits may be present on some platforms. +The list of limits actually supported by this procedure can +be obtained by a call to +.Ix unix-list-file-limits +\f2unix-list-file-limits\fP (see below). +.LP +If present, the +.Ix POSIX +.Ix pathconf +.Ix fpathconf +POSIX \f2pathconf()\fP/\f2fpathconf()\fP function is +used to query a limit; in this case the specified filename or file +descriptor is supplied as an argument to \f2pathconf()\fP or +\f2fpathconf()\fP. +If \f2pathconf()\fP is not available, or if calling it is not +appropriate for the type of limit, a static (compile-time) value +is returned. +.LP +The result type of \f2unix-file-limit\fP depends on the type of the +specified limit (boolean in case of \f2no-trunc\fP, integer otherwise). +. +.Pr unix-list-file-limits +.LP +This procedure returns the list of limit symbols that can be supplied +as arguments to +.Ix unix-file-limit +\f2unix-file-limit\fP (see above). +. +.Pr unix-job-control? +.LP +This predicate returns #t if UNIX job control is available on the local +system, #f otherwise. +In a +.Ix POSIX +POSIX environment, this procedure may call +.Ix sysconf +\f2sysconf()\fP. +. +.Ch "Date and Time" +. +.Pr unix-time +.LP +.Ix time +The UNIX \f2time()\fP function. +\f2unix-time\fP returns the number of seconds elapsed since +midnight\ UTC,\ January\ 1,\ 1970 (\f2The Epoch\fP) as an integer. +. +.Pr unix-nanotime +.LP +This procedure returns the number of nanoseconds elapsed since +The Epoch as an integer. +\f2unix-nanotime\fP invokes one of the UNIX functions +.Ix gettimeofday +.Ix ftime +.Ix time +\f2gettimeofday()\fP, \f2ftime()\fP, \f2time()\fP (in that order, +depending on which of these function is available), thus +providing up to microsecond resolution. +. +.[[ +.Pr unix-decode-localtime time +.Pr unix-decode-utc time +.]] +.LP +Both procedures convert the specified time (a number of seconds as +returned by \f2unix-time\fP) into a +.Ix time-record +\f2time-record\fP; \f2unix-decode-localtime\fP corrects for the +local time zone and DST adjustment (based on the UNIX +.Ix localtime +.Ix gmtime +\f2localtime()\fP and \f2gmtime()\fP functions). +.LP +A \f2time-record\fP has the following fields: +.sp .5 +.KS +.TS +allbox, tab(~); +c c c +lf5 l l. +Field~Type~Range +_ +seconds~integer~0..61 +minutes~integer~0..59 +hours~integer~0..23 +day-of-month~integer~1..31 +month~integer~0..11 +year~integer~(year - 1900) +weekday~integer~0..6 +day-of-year~integer~0..365 +dst~integer~1 if DST in effect +.TE +.KE +.LP +Example: +.Ss +;;; Return date as a string of the form "Nov 3, 1993" +.sp .4 +(define (date-string) + (let* ((months "JanFebMarAprMayJunJulAugSepOctNovDec") + (time (unix-decode-localtime (unix-time))) + (month-inx (* 3 (time-month time)))) +.sp .4 + (format #f "~a ~a, ~a" + (substring months month-inx (+ 3 month-inx)) + (time-day-of-month time) (+ 1900 (time-year time))))) +.Se +. +.Pr unix-time->string time +.LP +This procedure converts the specified time into a string; +it is based on the +.Ix ctime +.Ix asctime +\f2ctime()\fP and \f2asctime()\fP UNIX functions. +\f2time\fP is either an integer (number of seconds) or a +\f2time-record\fP. +. +.Ch "Signals" +. +.PP +The procedures described in this section (except \f2unix-kill\fP, +\f2unix-list-signals\fP, and \f2unix-pause\fP) +are only defined if the local system supports +.Ix "reliable signals" +reliable signals (either +.Ix BSD +BSD-style or +.Ix POSIX +POSIX signals). +In this case, the feature +.Ix unix:reliable-signals +\f2unix:reliable-signals\fP is provided when the UNIX extension +is loaded. +. +.Pr unix-kill pid signal +.LP +.Ix kill +The UNIX \f2kill()\fP system call. +\f2pid\fP is an integer; \f2sig\fP is either an integer (a signal +number) or a symbol (a +.Ix "signal name" +signal name). +At least the following signal names are supported: +.sp .5 +.KS +.TS +box, tab(~); +c s s +lf5 lf5 lf5. +Signal names +_ +sigalrm~sigbus~sigfpe +sighup~sigill~sigint +sigkill~sigpipe~sigquit +sigsegv~sigterm~ +.TE +.KE +.LP +The list of signal names actually supported by the local system +can be obtained by calling +.Ix unix-list-signals +\f2unix-list-signals\fP (see below). +.LP +\f2unix-kill\fP returns the non-printing object. +. +.Pr unix-list-signals +.LP +This procedure returns a list of +.Ix "signal name" +signal names (symbols) that are supported by the system. +. +.Pr alarm seconds +.LP +.Ix alarm +The UNIX \f2alarm()\fP function. +\f2seconds\fP is a positive integer. +\f2unix-alarm\fP returns the number of seconds remaining from the +previously set alarm. +. +.Pr unix-pause +.LP +.Ix pause +The UNIX \f2pause()\fP function. +This procedure does not return. +. +.[[ +.Pr unix-signal sig action +.Pr unix-signal sig +.]] +.LP +\f2unix-signal\fP defines or queries the action to be performed when a +.Ix signal +signal is delivered to the program. +If an \f2action\fP argument is specified, this action is associated +with the signal \f2sig\fP, and the previous action for this +signal is returned. +If no action is given (second form), \f2unix-signal\fP just returns +the action currently associated with \f2sig\fP. +.LP +\f2sig\fP is the name of a signal (see \f2unix-kill\fP for a +description). +The action associated with \f2sigbus\fP, \f2sigfpe\fP, \f2sigill\fP, +\f2sigint\fP, \f2sigkill\fP, \f2sigsegv\fP, and \f2sigabrt\fP (if +supported) cannot be altered; either because UNIX does not permit +this (\f2sigkill\fP), or because the signal can be generated as +the result of an internal fatal error (\f2sigbus\fP etc.), or +because it is used by the interpreter internally (\f2sigsegv\fP is +used by the incremental garbage collector). +The action associated with the +.Ix "interrupt signal" +\f2interrupt\fP signal can be controlled by redefining the standard Elk +.Ix interrupt-handler +\f2interrupt-handler\fP (see the Elk reference manual for details). +.LP +\f2action\fP can be one of the following: +.RS +.IP "the symbol \f2ignore\fP +the specified signal is ignored +.IP "the symbol \f2default\fP +the default action for this signal is established +.IP "the symbol \f2exit\fP +cleanup and exit: if the signal is delivered, the interpreter's +.Ix "temporary files" +temporary files are removed, the +.Ix "finalization functions" +finalization functions and static C++ destructors of dynamically loaded +extensions are invoked, and \f2exit()\fP is called with an exit code of 1 +.IP "a compound procedure" +the procedure +.Ix "signal handler" +(signal handler) is invoked on delivery of the specified signal. +.IP +.RE +.LP +The procedure specified as a signal handler must accept one or more +arguments. +When the signal is delivered, the procedure is invoked with the signal +name (a symbol) as an argument. +Signal handlers must not return (i.\|e.\& they must either exit or +call a continuation). +If a signal handler returns, a message is displayed and the +.Ix reset +\f2reset\fP primitive is called. +.LP +The signal specified as an argument to \f2unix-signal\fP is added to +(removed from) the +.Ix "signal mask" +signal mask maintained by the interpreter, i.\|e.\& calls to the +.Ix disable-interrupts +\f2disable-interrupts\fP primitive block the signal from delivery. +.LP +\f2unix-signal\fP returns the previous (current) action for the +specified signal (a procedure or \f2ignore\fP, \f2default\fP, or +\f2exit\fP) or the symbol \f2handler\fP to indicate that the +signal is handled internally by the interpreter. +. +.Ch "Miscellaneous Functions" +. +.Pr unix-getpass string +.LP +\f2unix-getpass\fP displays \f2string\fP on standard output, reads a +.Ix password +password, and returns the password as a string. +The procedure invokes the UNIX +.Ix getpass +\f2getpass()\fP function. +. +.Ch "Error Functions" +. +.Sy unix-errval expression +.LP +Normally, a Scheme error is signaled by the UNIX extension whenever a +UNIX system call or library function invoked by any of the above +primitives fails. +The macro \f2unix-errval\fP allows an application to handle an error +condition in a specific way without the need to redefine the standard +.Ix "error handler" +error handler of Elk. +.LP +\f2unix-errval\fP evaluates the specified expression and returns +the result of the evaluation. +If, during evaluation of the expression, an error is signaled due +to failure of a UNIX function, the corresponding primitive +procedure returns a unique +.Ix "error object" +\f2error object\fP instead of performing normal error handling. +.LP +For example, evaluating the expression +.Ss +(unix-close 1000) ; close a bad file descriptor +.Se +would invoke the standard Scheme error handler in the normal way, +whereas evaluating +.Ss +(unix-errval (unix-close 1000)) +.Se +would return an error object to allow the application to handle +the error locally. +Note that evaluation of the enclosing expression is not interrupted +when an error is signaled, i.\|e.\& the expression +.Ss +(unix-errval (begin (unix-close 1000) 5)) +.Se +would return the integer 5. +. +.Pr unix-error? obj +.LP +This procedure returns #t if \f2obj\fP is the \f2error object\fP, +#f otherwise. +\f2unix-error?\fP is typically used to check whether a primitive +invoked under control of \f2unix-errval\fP has signaled an error. +. +.Pr unix-errno +.LP +.Ix errno +Returns the UNIX \f2errno\fP set by the last system call that has +failed. +.Ix "error codes" +Error codes are represented as symbols corresponding to the names of the +standard UNIX error numbers with letters converted to lower case, i.\|e. +\f2enomem\fP, \f2ebadf\fP, etc. +The exact set of error codes that can be returned is platform-dependent. +.LP +The value returned by \f2unix-errno\fP is not reset when a UNIX system +call executes successfully. +However, value of \f2unix-errno\fP is also affected by functions +from the Elk kernel (such as \f2open-input-file\fP) and possibly +other extensions that make use of system calls. +. +.Pr unix-perror string +.LP +\f2unix-perror\fP writes \f2string\fP followed by a colon and a short +message describing the last UNIX error encountered to the current +output port. +\f2unix-perror\fP makes use of the ``~E'' format specifier of the +.Ix format +format primitive. +. +.bp +.Ch "Examples" +.LP +.Ix examples +This program implements a simple program interface to the UNIX +.Ix dc +\f2dc\fP desktop calculator command. +The procedure +.Ix calc-open +\f2calc-open\fP starts the \f2dc\fP command and establishes two +.Ix pipe +pipes to/from the child process; the procedure +.Ix calc +\f2calc\fP sends its argument (a \f2dc\fP expression as a string) +as input to \f2dc\fP; +.Ix calc-close +\f2calc-close\fP closes the pipes and waits for the subprocess to +terminate. +.Ss +(require 'unix) +.sp .4 +(define calc-from-dc) ; input port: standard output of dc command +(define calc-to-dc) ; output port: standard input of dc command +(define calc-dc-pid) ; process-ID of child process running dc +.sp .4 +(define calc-dc-command "/bin/dc") +.sp .4 +(define (calc-open) + (let* ((from (unix-pipe)) + (to (unix-pipe)) + (redirect-fd (lambda (a b) + (unix-dup a b) (unix-close a)))) + (set! calc-dc-pid (unix-fork)) + (if (zero? calc-dc-pid) + (begin + (unix-close (car from)) + (unix-close (cdr to)) + (redirect-fd (car to) 0) + (redirect-fd (cdr from) 1) + (unix-exec calc-dc-command '("dc"))) + (begin + (unix-close (cdr from)) + (unix-close (car to)) + (set! calc-to-dc (unix-filedescriptor->port (cdr to) "w")) + (set! calc-from-dc (unix-filedescriptor->port (car from) "r")))))) +.sp .4 +(define (calc expr) + (format calc-to-dc "~a~%" expr) + (flush-output-port calc-to-dc) + (read-string calc-from-dc)) +.sp .4 +(define (calc-close) + (close-output-port calc-to-dc) + (close-input-port calc-from-dc) + (unix-wait-process calc-dc-pid)) + +;;; Test -- print sqrt(2): +.sp .4 +(calc-open) +(display (calc "10k 2v p")) (newline) +(calc-close) +.Se +.bp +.LP +The following procedure copies a file; the arguments are the source and +target file names. +The second argument may name a directory, in this case the file is +copied into the directory. +The target file must not yet exist. +.Ix copy-file +\f2copy-file\fP preserves the access mode of the source file. +.Ss +(require 'unix) +.sp .4 +(define copy-buffer-size 8192) +.sp .4 +(define (copy-file from to) + (let ((from-stat (unix-stat from)) + (to-stat (unix-errval (unix-stat to)))) +.sp .3 + (if (eq? (stat-type from-stat) 'directory) ; complain if "from" + (error 'copy-file "~s is a directory" from)) ; is a directory +.sp .3 + (if (and (not (unix-error? to-stat)) ; destination exists + (eq? (stat-type to-stat) 'directory)) ; and is a directory? + (set! to (format #f "~a/~a" to from))) +.sp .3 + (let* ((to-fd (unix-open to '(write create exclusive) + (stat-mode from-stat))) + (from-fd (unix-open from '(read))) + (buf (make-string copy-buffer-size))) + + (let loop ((num-chars (unix-read-string-fill! from-fd buf))) + (if (positive? num-chars) + (begin + (unix-write to-fd buf num-chars) + (loop (unix-read-string-fill! from-fd buf))))) +.sp .3 + (unix-close from-fd) + (unix-close to-fd)))) +.Se +.bp +.LP +\f2lock-vi\fP starts the +.Ix vi +.Ix editor +\f2vi\fP editor with the specified file name. +It provides exclusive access to the file during the editing session by +applying a write lock to the file and removing it when the editor finishes. +A message is displayed periodically if the lock is held by somebody else. +.Ss +(require 'unix) +.sp .4 +(define (lock-vi file) + (let* ((fd (unix-open file '(read write))) + (lock ((record-constructor lock-record) #t 'set 0 0))) +.sp .4 + (let loop () + (if (not (unix-set-lock fd lock #f)) + (begin + (format #t "Someone else is editing ~s...~%" file) + (unix-sleep 10) + (loop)))) +.sp .4 + (unix-system (format #f "vi ~a" file)) + (unix-remove-lock fd lock))) +.Se +.sp +.LP +\f2pipe-size\fP attempts to determine the capacity of a +.Ix pipe +pipe. +It creates a pipe, places the write end of the pipe into +.Ix "non-blocking I/O" +non-blocking I/O mode and writes into the pipe until it is full, +counting the characters successfully written. +.Ss +(require 'unix) +.sp .4 +(define (pipe-size) + (let* ((pipe (unix-pipe)) + (flags (unix-filedescriptor-flags (cdr pipe))) + (len 32) ; assumes capacity is multiple of len + (noise (make-string len))) +.sp .4 + ;; enable non-blocking I/O for write side of pipe: + (unix-filedescriptor-flags (cdr pipe) (cons 'ndelay flags)) +.sp .4 + (unwind-protect + (let loop ((size 0)) + (if (unix-error? (unix-errval (unix-write (cdr pipe) noise))) + (if (memq (unix-errno) '(eagain ewouldblock)) + size + (error 'pipe-size "~E")) + (loop (+ size 32)))) + (unix-close (car pipe)) + (unix-close (cdr pipe))))) +.Se diff --git a/doc/unix/unix.ps b/doc/unix/unix.ps new file mode 100644 index 0000000..b37705b --- /dev/null +++ b/doc/unix/unix.ps @@ -0,0 +1,2235 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier +%%+ font Symbol +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 27 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier +%%IncludeResource: font Symbol +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier@0 ENC0/Courier RE/Times-Roman@0 +ENC0/Times-Roman RE/Times-Italic@0 ENC0/Times-Italic RE/Times-Bold@0 ENC0 +/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(Refer)222.444 120 Q(ence Manual f)-.216 E(or the)-.3 E +(Elk UNIX Extension)235.326 138 Q/F1 10/Times-Italic@0 SF(Oliver Laumann) +255.085 162 Q/F2 11/Times-Bold@0 SF 2.75(1. Intr)72 234 R(oduction)-.198 E/F3 +11/Times-Roman@0 SF 1.217(This reference manual describes the primiti)97 252.6 +R 1.546 -.165(ve p)-.275 H 1.216(rocedures and record types de\214ned by the) +.165 F(UNIX e)72 267.6 Q(xtension to Elk.)-.165 E .468(The UNIX e)97 286.2 R +.468(xtension pro)-.165 F .469(vides easy access to most widely a)-.165 F -.275 +(va)-.22 G .469(ilable UNIX system calls and).275 F 2.799(Cl)72 301.2 S .049 +(ibrary functions from within Scheme programs.)85.194 301.2 R .048(The e)5.549 +F .048(xtension supports a wide range of dif)-.165 F(fer)-.275 E(-)-.22 E .089 +(ent UNIX platforms without restricting its functionality to the lo)72 316.2 R +.09(west common denominator or the)-.275 F .509(POSIX 1003.1 functions.)72 +331.2 R 2.269 -.88(To s)6.009 H .509 +(implify writing portable Scheme programs, the e).88 F .508(xtension attempts) +-.165 F .553(to hide dif)72 346.2 R .553 +(ferences between the types of supported UNIX \215a)-.275 F -.22(vo)-.22 G +3.303(rs. F).22 F .553(or e)-.165 F .554(xample, programmers do)-.165 F .431 +(not ha)72 361.2 R .761 -.165(ve t)-.22 H 3.181(od).165 G .431 +(eal with the idiosyncrasies of the)130.042 361.2 R/F4 11/Times-Italic@0 SF +(wait\(\))3.181 E F3(,)A F4(waitpid\(\))3.181 E F3(,)A F4(wait3\(\))3.181 E F3 +3.181(,a)C(nd)400.957 361.2 Q F4(wait4\(\))3.181 E F3 .431(system calls)3.181 F +(or the)72 376.2 Q F4(mktemp\(\))2.75 E F3(,)A F4(tmpnam\(\))2.75 E F3 2.75(,a) +C(nd)200.293 376.2 Q F4(tempnam\(\))2.75 E F3(functions.)2.75 E .456 +(The UNIX e)97 394.8 R .456(xtension de\214nes procedures for lo)-.165 F(w-le) +-.275 E -.165(ve)-.275 G .457(l, \214le-descriptor).165 F .457 +(-based I/O; creation of)-.22 F .071(pipes; \214le/record locking; \214le and \ +directory system calls; process creation and control; signal han-)72 409.8 R +.228(dling; error handling; and obtaining information about date, time, users,\ + limits, process resources,)72 424.8 R 2.75(etc. T)72 439.8 R +(erminal control is not yet supported by the current v)-.77 E(ersion.)-.165 E +.931(The reference manual assumes that you are f)97 458.4 R .931 +(amiliar with the most common UNIX system)-.11 F .113(calls and C library func\ +tions; this document does not attempt to duplicate the contents of the stan-)72 +473.4 R .753(dard UNIX documentation.)72 488.4 R .752 +(Detailed descriptions are pro)6.253 F .752(vided for functions that dif)-.165 +F .752(fer from the)-.275 F(standard UNIX semantics.)72 503.4 Q F2 2.75 +(2. Using)72 533.4 R(the UNIX Extension)2.75 E F3(The UNIX e)97 552 Q +(xtension is loaded by e)-.165 E -.275(va)-.275 G(luating).275 E/F5 10 +/Courier@0 SF(\(require 'unix\))100.346 574.503 Q F3(in the interacti)72 +596.503 Q .33 -.165(ve t)-.275 H(ople).165 E -.165(ve)-.275 G 2.75(lo).165 G +2.75(ri)191.493 596.503 S 2.75(naS)200.964 596.503 S(cheme program.)222.964 +596.503 Q .748(This causes the \214les)97 615.103 R F4(unix.scm)3.498 E F3(and) +3.498 E F4(unix.o)3.499 E F3 .749(to be loaded into the interpreter \()3.499 F +F4(unix.o)A F3 .749(has to be)3.499 F(link)72 630.103 Q .882(ed with the inter\ +preter on platforms that do not support dynamic loading of object \214les\).) +-.11 F(In)6.382 E .931(addition, the)72 645.103 R F4 -.407(re)3.681 G(cor).407 +E(d)-.407 E F3 -.165(ex)3.682 G .932 +(tension is automatically loaded if it is not yet present.).165 F .932 +(The record e)6.432 F(xten-)-.165 E +(sion is documented in a separate reference manual.)72 660.103 Q .016 +(Loading the UNIX e)97 678.703 R .015(xtension causes the features)-.165 F F4 +(unix)2.765 E F3(and)2.765 E F4(unix.o)2.765 E F3 .015(to be pro)2.765 F 2.765 +(vided. Optionally)-.165 F(,)-.715 E .018(one or more of the follo)72 693.703 R +.018(wing features \(described belo)-.275 F .018(w\) may be pro)-.275 F .019 +(vided by the e)-.165 F .019(xtension to indi-)-.165 F +(cate that certain UNIX features are a)72 708.703 Q -.275(va)-.22 G(ilable:) +.275 E EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(unix:wait-options)100.346 94.503 Q +(unix:wait-process)100.346 108.503 Q(unix:record-locks)100.346 122.503 Q +(unix:file-locking)100.346 136.503 Q(unix:symlinks)100.346 150.503 Q +(unix:reliable-signals)100.346 164.503 Q/F2 11/Times-Bold@0 SF 2.75(3. Record) +72 201.503 R -.814(Ty)2.75 G(pes).814 E F0(Se)97 220.103 Q -.165(ve)-.275 G +.864(ral procedures return their results as Scheme records.).165 F .864 +(All record types de\214ned by the)6.364 F .122(UNIX e)72 235.103 R .122 +(xtension are stored in v)-.165 F .122(ariables with names of the form)-.275 F +/F3 11/Times-Italic@0 SF(-r)2.873 E(ecor)-.407 E(d)-.407 E F0 .123 +(\(such as)2.873 F F3(sys-)2.873 E(tem-r)72 250.103 Q(ecor)-.407 E(d)-.407 E F0 +(or)4.023 E F3(passwd-r)4.022 E(ecor)-.407 E(d)-.407 E F0 4.022(\). In)B 1.272 +(addition, a type predicate, a record constructor)4.022 F 4.022(,a)-.44 G 1.272 +(nd accessor)451.721 250.103 R .235 +(functions for all record \214elds are de\214ned for each record type.)72 +265.103 R -.165(Fo)5.735 G 2.985(re).165 G .235(xample, a)375.68 265.103 R F3 +(system)2.985 E F0 .235(record type)2.985 F 1.797(with the \214elds)72 280.103 +R F3(hostname)4.547 E F0(,)A F3(sysname)4.547 E F0 4.547(,a)C(nd)241.387 +280.103 Q F3(osname)4.546 E F0 1.796(is de\214ned, resulting in v)4.546 F +(ariable)-.275 E F3(system-r)4.546 E(ecor)-.407 E(d)-.407 E F0 +(holding the record type descriptor)72 295.103 Q 2.75(,a)-.44 G +(nd the functions)231.027 295.103 Q F1(\(system-record? obj\))100.346 317.606 Q +(\(make-system-record\))100.346 331.606 Q(\(system-hostname system-record\)) +100.346 352.606 Q(\(system-sysname system-record\))100.346 366.606 Q +(\(system-osname system-record\))100.346 380.606 Q F0(Use)72 402.606 Q F3 +(de\214ne-r)3.131 E(ecor)-.407 E(d-modi\214er)-.407 E(s)-.11 E F0 .381 +(if you need the modi\214er functions for an)3.131 F 3.131(yo)-.165 G 3.131(ft) +393.05 402.606 S .381(he records as well \(see)402.902 402.606 R(the record e) +72 417.606 Q(xtension reference manual for details\).)-.165 E(The follo)72 +436.206 Q(wing record types are de\214ned by the UNIX e)-.275 E(xtension:)-.165 +E 515.3 455.956 72 455.956 DL(Record T)79.078 468.206 Q 180.081(ype Fields)-.88 +F 515.3 472.956 72 472.956 DL 515.3 474.956 72 474.956 DL/F4 11/Courier@0 SF +42.9(stat type)77.5 487.206 R +(mode ino dev nlink uid gid size atime mtime ctime)6.6 E 515.3 491.956 72 +491.956 DL(time)77.5 504.206 Q +(seconds minutes hours day-of-month month year weekday)153.4 504.206 Q +(day-of-year dst)153.4 519.206 Q 515.3 523.956 72 523.956 DL 16.5 +(nanotime nanoseconds)77.5 536.206 R(minuteswest dst)6.6 E 515.3 540.956 72 +540.956 DL 29.7(system hostname)77.5 553.206 R(sysname osname)6.6 E 515.3 +557.956 72 557.956 DL 29.7(passwd name)77.5 570.206 R +(password uid gid gecos homedir shell)6.6 E 515.3 574.956 72 574.956 DL 36.3 +(group name)77.5 587.206 R(password gid members)6.6 E 515.3 591.956 72 591.956 +DL 9.9(resources user-time)77.5 604.206 R(system-time \(...\))6.6 E 515.3 +608.956 72 608.956 DL 42.9(lock exclusive?)77.5 621.206 R(whence start length) +6.6 E 515.3 625.956 72 625.956 DL 42.9(wait pid)77.5 638.206 R +(status code core-dump? resources)6.6 E 515.3 642.956 72 642.956 DL 515.3 +455.956 515.3 642.956 DL 72 455.956 72 642.956 DL 145.15 455.956 145.15 642.956 +DL EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(4. Err)72 87 R(or Handling)-.198 E F0 +.597(The def)97 105.6 R .597(ault error beha)-.11 F .597(vior of the primiti) +-.22 F .926 -.165(ve p)-.275 H .596(rocedures de\214ned by the UNIX e).165 F +.596(xtension is to)-.165 F(in)72 120.6 Q -.22(vo)-.44 G .926 -.11(ke t).22 H +.707 +(he standard Scheme error handler if a UNIX system call or library function f) +.11 F 3.457(ails. As)-.11 F(an)3.457 E(alternati)72 135.6 Q -.165(ve)-.275 G +3.525(,i).165 G 3.525(fas)127.324 135.6 S .774 +(peci\214c error action is to be performed by the application, a primiti)147.2 +135.6 R 1.104 -.165(ve p)-.275 H(rocedure).165 E 2.123(can be in)72 150.6 R +-.22(vo)-.44 G -.11(ke).22 G 4.873(du).11 G 2.123(nder control of the)152.443 +150.6 R/F2 11/Times-Italic@0 SF(unix-errval)4.873 E F0 4.874(form. In)4.873 F +2.124(this case, a unique)4.874 F F2(err)4.874 E 2.124(or object)-.495 F F0(is) +4.874 E .717(returned if a UNIX function signals an error)72 165.6 R 6.216(.T) +-.605 G .716(he standard UNIX system error message and the)286.072 165.6 R .923 +(UNIX error number are made a)72 180.6 R -.275(va)-.22 G .924 +(ilable to the application in an).275 F 3.674(yc)-.165 G 3.674(ase. Details) +371.395 180.6 R .924(of the error han-)3.674 F(dling f)72 195.6 Q +(acilities are described in the section `)-.11 E(`Error Functions')-.814 E 2.75 +('b)-.814 G(elo)351.015 195.6 Q -.715(w.)-.275 G F1 2.75(5. Con)72 225.6 R -.11 +(ve)-.44 G(ntions).11 E F0 .575(In the follo)97 244.2 R .575 +(wing sections, the names of procedure ar)-.275 F .574 +(guments can dictate that the ar)-.198 F(guments)-.198 E .482 +(are of speci\214c types.)72 259.2 R .482(If an ar)5.982 F .483 +(gument name is also the name of a Scheme data type, the ar)-.198 F(gument) +-.198 E .247(must be an object of that type.)72 274.2 R -.165(Fo)5.747 G 2.997 +(re).165 G .247(xample, a procedure with an ar)234.961 274.2 R .247 +(gument named)-.198 F F2(string)2.997 E F0 .247(must be)2.997 F(in)72 289.2 Q +-.22(vo)-.44 G -.11(ke).22 G 4.57(dw).11 G 1.82(ith a string.)119.184 289.2 R +1.82(File descriptor ar)7.32 F 1.821(guments \(named)-.198 F F2(fdescr)4.571 E +F0 4.571(,o)C(r)377.662 289.2 Q F2(fdescr)4.571 E/F3 10/Times-Italic@0 SF(1)3.3 +I F0(,)-3.3 I F2(fdescr)4.571 E F3(2)3.3 I F0 4.571(,e)-3.3 K 1.821(tc.\) and) +469.19 289.2 R(ar)72 304.2 Q 2.227(guments named)-.198 F F2(length)4.976 E F0 +2.226(are al)4.976 F -.11(wa)-.11 G 2.226(ys non-ne).11 F -.055(ga)-.165 G(ti) +.055 E 2.556 -.165(ve i)-.275 H(nte).165 E 2.226(gers; \214lename ar)-.165 F +2.226(guments \()-.198 F F2(\214lename)A F0 4.976(\)a)C(re)495.453 304.2 Q +(strings or symbols; and ar)72 319.2 Q(guments with the suf)-.198 E(\214x `) +-.275 E(`?')-.814 E 2.75('a)-.814 G(re booleans.)317.069 319.2 Q F1 2.75(6. Lo) +72 349.2 R(w-Le)-.11 E -.11(ve)-.165 G 2.75(lI).11 G(/O, File Descriptors) +142.499 349.2 Q(\(unix-close)72 379.2 Q F2(fdescr)4.583 E F1 298.277(\)p)C +-.198(ro)462.244 379.2 S(cedur).198 E(e)-.198 E F0(The UNIX)72 397.8 Q F2 +(close\(\))2.75 E F0(system call.)2.75 E F2(unix-close)5.5 E F0 +(returns the non-printing object.)2.75 E F1(\(unix-dup)72 427.8 Q F2(fdescr) +4.583 E F1 302.534(\)p)C -.198(ro)462.244 427.8 S(cedur).198 E(e)-.198 E +(\(unix-dup)72 442.8 Q F2(fdescr)4.583 E F3(1)3.3 I F2(fdescr)2.75 -3.3 M F3(2) +3.3 I F1 262.9(\)p)-3.3 K -.198(ro)462.244 442.8 S(cedur).198 E(e)-.198 E F2 +(unix-dup)72 461.4 Q F0(in)3.427 E -.22(vo)-.44 G -.11(ke).22 G 3.427(st).11 G +(he)154.468 461.4 Q F2(dup\(\))3.427 E F0 .677(\(\214rst form\) or)3.427 F F2 +(dup2\(\))3.428 E F0 .678(\(second form\) system call.)3.428 F .678 +(The result is a ne)6.178 F(w)-.275 E(\214le descriptor \(an inte)72 476.4 Q +(ger\).)-.165 E F1(\(unix-open)72 506.4 Q F2(\214lename \215a)4.583 E(gs)-.11 E +F1 264.463(\)p)C -.198(ro)462.244 506.4 S(cedur).198 E(e)-.198 E(\(unix-open)72 +521.4 Q F2(\214lename \215a)4.583 E(gs mode)-.11 E F1 237.887(\)p)C -.198(ro) +462.244 521.4 S(cedur).198 E(e)-.198 E F0 .18(The UNIX)72 540 R F2(open\(\)) +2.93 E F0 .18(system call.)2.93 F F2<8d61>5.68 E(gs)-.11 E F0 .18 +(is a list of one or more symbols specifying the bitmask ar)2.93 F(gu-)-.198 E +(ment of the)72 555 Q F2(open\(\))2.75 E F0(system call.)2.75 E .358 +(At least the \215ag symbols)72 573.6 R F2 -.407(re)3.108 G(ad).407 E F0(,)A F2 +(write)3.108 E F0(,)A F2(append)3.108 E F0(,)A F2(cr)3.108 E(eate)-.407 E F0(,) +A F2(truncate)3.108 E F0 3.108(,a)C(nd)357.994 573.6 Q F2 -.22(ex)3.108 G +(clusive).22 E F0 .358(are supported; addi-)3.108 F .589 +(tional symbols \(such as)72 588.6 R F2(ndelay)3.339 E F0 3.339(\)m)C .589 +(ay be permitted on certain platforms.)224.963 588.6 R .588(The procedure)6.088 +F F2(unix-list-)3.338 E(open-modes)72 603.6 Q F0 .563(can be used to obtain th\ +e list of \215ag symbols that are supported \(see belo)3.312 F 3.313(w\). If) +-.275 F F2(cr)3.313 E(e-)-.407 E(ate)72 618.6 Q F0 1.016(is present in the) +3.766 F F2<8d61>3.766 E(gs)-.11 E F0(ar)3.766 E 1.016(gument, the)-.198 F F2 +(mode)3.766 E F0(ar)3.766 E 1.016(gument \(an inte)-.198 F 1.016 +(ger\) must be supplied.)-.165 F 1.015(At least)6.516 F(one of the symbols)72 +633.6 Q F2 -.407(re)2.75 G(ad).407 E F0(or)2.75 E F2(write)2.75 E F0 +(must be present in)2.75 E F2<8d61>2.75 E(gs)-.11 E F0(.)A F2(unix-open)72 +652.2 Q F0(returns a ne)2.75 E 2.75<778c>-.275 G(le descriptor \(an inte) +186.587 652.2 Q(ger\).)-.165 E(Example:)72 670.8 Q EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF +(\(let \(\(f1 \(unix-open "/etc/passwd" '\(read\)\))100.346 94.503 Q +(\(f2 \(unix-open "temp" '\(read write create truncate\) #o666\)\)\)\))136.346 +108.503 Q(...\))112.346 122.503 Q/F2 11/Times-Bold@0 SF -.917 +(\(unix-list-open-modes \))72 159.503 R(pr)456.128 159.503 Q(ocedur)-.198 E(e) +-.198 E F0 .599(This procedure returns the list of)72 178.103 R/F3 11 +/Times-Italic@0 SF<8d61>3.35 E(g)-.11 E F0 .6(symbols for the)3.35 F F3 +(unix-open)3.35 E F0 .6(procedure that are supported on)3.35 F +(the local platform.)72 193.103 Q F2(\(unix-lseek)72 223.103 Q F3(fdescr of) +4.583 E(fset whence)-.198 E F2 235.533(\)p)C -.198(ro)462.244 223.103 S(cedur) +.198 E(e)-.198 E F0 .208(The UNIX)72 241.703 R F3(lseek\(\))2.958 E F0 .208 +(system call.)2.958 F F3(of)5.708 E(fset)-.198 E F0 .208(is an inte)2.958 F +(ger;)-.165 E F3(whence)2.958 E F0 .207(is one of the symbols)2.957 F F3(set) +2.957 E F0(,)A F3(curr)2.957 E(ent)-.407 E F0 2.957(,a)C(nd)493 241.703 Q F3 +(end)72 256.703 Q F0(.)A F3(unix-lseek)5.5 E F0(returns the ne)2.75 E 2.75 +<778c>-.275 G(le position as an inte)219.884 256.703 Q(ger)-.165 E(.)-.605 E F2 +-.917(\(unix-pipe \))72 286.703 R(pr)456.128 286.703 Q(ocedur)-.198 E(e)-.198 E +F0(The)72 305.303 Q F3(pipe\(\))2.75 E F0(system call.)2.75 E F3(unix-pipe)5.5 +E F0(returns tw)2.75 E 2.75<6f8c>-.11 G(le descriptors as a pair of inte) +281.165 305.303 Q(gers.)-.165 E F2(\(unix-r)72 335.303 Q(ead-string-\214ll!) +-.198 E F3(fdescr string)4.583 E F2 220.551(\)p)C -.198(ro)462.244 335.303 S +(cedur).198 E(e)-.198 E(\(unix-r)72 350.303 Q(ead-string-\214ll!)-.198 E F3 +(fdescr string length)4.583 E F2 190.301(\)p)C -.198(ro)462.244 350.303 S +(cedur).198 E(e)-.198 E F0(The)72 368.903 Q F3 -.407(re)2.87 G(ad\(\)).407 E F0 +.12(system call.)2.87 F F3(unix-r)5.621 E(ead-string-\214ll)-.407 E F0(in)2.871 +E -.22(vo)-.44 G -.11(ke).22 G(s).11 E F3 -.407(re)2.871 G(ad\(\)).407 E F0 +.121(with the Scheme string as input b)2.871 F(uf)-.22 E(fer)-.275 E .509 +(and the length of the string ar)72 383.903 R .509 +(gument \(\214rst form\) or the length supplied as a third ar)-.198 F .509 +(gument \(sec-)-.198 F(ond form\).)72 398.903 Q(If)5.5 E F3(length)2.75 E F0 +(is speci\214ed, it must be an inte)2.75 E(ger between 0 and the length of) +-.165 E F3(string)2.75 E F0(.)A F3(unix-r)72 417.503 Q(ead-string-\214ll!)-.407 +E F0(destructi)3.902 E -.165(ve)-.275 G 1.152(ly o).165 F -.165(ve)-.165 G +1.153(rwrites the contents of the).165 F F3(string)3.903 E F0(ar)3.903 E 3.903 +(gument. It)-.198 F 1.153(returns the)3.903 F +(number of characters actually read \(0 on EOF\).)72 432.503 Q F2(\(unix-write) +72 462.503 Q F3(fdescr string)4.583 E F2 268.027(\)p)C -.198(ro)462.244 462.503 +S(cedur).198 E(e)-.198 E(\(unix-write)72 477.503 Q F3(fdescr string length) +4.583 E F2 237.777(\)p)C -.198(ro)462.244 477.503 S(cedur).198 E(e)-.198 E F0 +(The)72 496.103 Q F3(write\(\))2.859 E F0 .109(system call.)2.859 F -.165(Fo) +5.609 G 2.859(rad).165 G .109(escription of the ar)213.641 496.103 R .109 +(guments see)-.198 F F3(unix-r)2.859 E(ead-string-\214ll!)-.407 E F0(abo)2.859 +E -.165(ve)-.165 G(.).165 E F3(unix-)5.608 E(write)72 511.103 Q F0 +(returns the number of characters actually written.)2.75 E F2 +(\(unix-close-on-exec)72 541.103 Q F3(fdescr)4.583 E F2 259.183(\)p)C -.198(ro) +462.244 541.103 S(cedur).198 E(e)-.198 E(\(unix-close-on-exec)72 556.103 Q F3 +(fdescr on?)4.583 E F2 239.933(\)p)C -.198(ro)462.244 556.103 S(cedur).198 E(e) +-.198 E F3(unix-close-on-e)72 574.703 Q(xec)-.22 E F0 1.528(returns the v)4.278 +F 1.528(alue of the)-.275 F F3(close-on-e)4.278 E(xec)-.22 E F0 1.528 +(\215ag for the gi)4.278 F -.165(ve)-.275 G 4.278<6e8c>.165 G 1.528 +(le descriptor as a)425.188 574.703 R 2.752(boolean. If)72 589.703 R(in)2.752 E +-.22(vo)-.44 G -.11(ke).22 G 2.752(dw).11 G .001(ith a second ar)170.522 +589.703 R .001(gument, the procedure sets the)-.198 F F3(close-on-e)2.751 E +(xec)-.22 E F0 .001(\215ag to the spec-)2.751 F(i\214ed v)72 604.703 Q +(alue and returns the pre)-.275 E(vious v)-.275 E(alue.)-.275 E F2 +(\(unix-\214ledescriptor)72 634.703 Q(-\215ags)-.407 E F3(fdescr)4.583 E F2 +233.905(\)p)C -.198(ro)462.244 634.703 S(cedur).198 E(e)-.198 E +(\(unix-\214ledescriptor)72 649.703 Q(-\215ags)-.407 E F3(fdescr \215a)4.583 E +(gs)-.11 E F2 210.486(\)p)C -.198(ro)462.244 649.703 S(cedur).198 E(e)-.198 E +F3(unix-\214le-descriptor)72 668.303 Q(-\215a)-.22 E(gs)-.11 E F0 .611 +(obtains the \215ags currently acti)3.361 F .941 -.165(ve f)-.275 H .611 +(or the gi).165 F -.165(ve)-.275 G 3.361<6e8c>.165 G .612 +(le descriptor \(by means)399.216 668.303 R .869(of the)72 683.303 R F3 +(fcntl\(\))3.619 E F0 .869 +(system call\) and returns them as a list of symbols.)3.619 F .869(If in)6.369 +F -.22(vo)-.44 G -.11(ke).22 G 3.619(dw).11 G .868(ith a second ar)423.087 +683.303 R(gu-)-.198 E .965 +(ments \(a list of symbols\), the procedure sets the \215ags to that ar)72 +698.303 R .965(gument and returns the pre)-.198 F(vious)-.275 E -.275(va)72 +713.303 S(lue.).275 E EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL .228(At least the \215ag symbol)72 87 R/F1 11/Times-Italic@0 SF +(append)2.978 E F0 .228(is supported; additional symbols \(such as)2.978 F F1 +(ndelay)2.978 E F0(or)2.978 E F1(sync)2.978 E F0 2.978(\)m)C .228(ay be)480.254 +87 R .503(permitted on certain platforms.)72 102 R .504(The procedure)6.004 F +F1(unix-list-\214ledescriptor)3.254 E(-\215a)-.22 E(gs)-.11 E F0 .504 +(can be used to obtain)3.254 F +(the list of \214le descriptor \215ags that are supported \(see belo)72 117 Q +(w\).)-.275 E(Example:)72 135.6 Q/F2 10/Courier@0 SF +(;;; Enable non-blocking I/O for file descriptor \(assumes POSIX\))100.346 +158.103 Q(\(define \(set-non-blocking fd\))100.346 177.703 Q +(\(let \(\(flags \(unix-filedescriptor-flags fd\)\)\))112.346 191.703 Q +(\(unix-filedescriptor-flags fd \(cons 'nonblock flags\)\)\)\))124.346 205.703 +Q/F3 11/Times-Bold@0 SF(\(unix-list-\214ledescriptor)72 242.703 Q -.917 +(-\215ags \))-.407 F(pr)456.128 242.703 Q(ocedur)-.198 E(e)-.198 E F0 .205 +(This procedure returns the list of \214le descriptor)72 261.303 R F1<8d61> +2.955 E(g)-.11 E F0 .205(symbols that can be returned and set by)2.955 F F1 +(unix-)2.954 E(\214ledescriptor)72 276.303 Q(-\215a)-.22 E(gs)-.11 E F0 +(on the local platform.)2.75 E F3 -.917(\(unix-num-\214ledescriptors \))72 +306.303 R(pr)456.128 306.303 Q(ocedur)-.198 E(e)-.198 E F1 +(unix-num-\214ledescriptor)72 324.903 Q(s)-.11 E F0 .57 +(returns the maximum number of \214le descriptors per process in the local) +3.319 F 4.554(system. Depending)72 339.903 R 1.804(on the UNIX \215a)4.554 F +-.22(vo)-.22 G 2.684 -.44(r, t).22 H 1.804(he procedure in).44 F -.22(vo)-.44 G +-.11(ke).22 G(s).11 E F1 -.11(ge)4.554 G(tdtablesize\(\)).11 E F0(or)4.553 E F1 +(sysconf\(\))4.553 E F0(or)4.553 E(uses a static \(compile-time\) limit.)72 +354.903 Q F3(\(unix-isatty?)72 384.903 Q F1(fdescr)4.583 E F3 289.719(\)p)C +-.198(ro)462.244 384.903 S(cedur).198 E(e)-.198 E F0 1.73 +(Returns #t if the speci\214ed \214le descriptor points to a terminal de)72 +403.503 R 1.73(vice, #f otherwise \(the UNIX)-.275 F F1(isatty\(\))72 418.503 Q +F0(library function\).)2.75 E F3(\(unix-ttyname)72 448.503 Q F1(fdescr)4.583 E +F3 282.393(\)p)C -.198(ro)462.244 448.503 S(cedur).198 E(e)-.198 E F0 .476 +(The UNIX)72 467.103 R F1(ttyname\(\))3.226 E F0 3.226(function. Returns)3.226 +F .475(the name of a terminal de)3.226 F .475 +(vice as a string, or #f if the \214le)-.275 F +(descriptor is not associated with a terminal.)72 482.103 Q F3 +(\(unix-port-\214ledescriptor)72 512.103 Q F1(port)4.583 E F3 243.277(\)p)C +-.198(ro)462.244 512.103 S(cedur).198 E(e)-.198 E F0 .143(This procedure retur\ +ns the \214le descriptor associated with the \214le pointer con)72 530.703 R +-.165(vey)-.44 G .144(ed in the speci\214ed).165 F .062(Scheme port.)72 545.703 +R .062(An error is signaled if the port has already been closed or if it is a \ +string port.)5.562 F F1(unix-)5.562 E(port-\214ledescriptor)72 560.703 Q F0(in) +2.75 E -.22(vo)-.44 G -.11(ke).22 G 2.75(st).11 G(he UNIX)194.672 560.703 Q F1 +(\214leno\(\))2.75 E F0(library function.)2.75 E .691 +(Manipulating a \214le descriptor obtained by)72 579.303 R F1 +(unix-port-\214ledescriptor)3.442 E F0 .692(can cause une)3.442 F .692 +(xpected interac-)-.165 F .122 +(tions with the standard Scheme I/O functions and with the stdio b)72 594.303 R +(uf)-.22 E .122(fering mechanism.)-.275 F .122(In particu-)5.622 F(lar)72 +609.303 Q 3.566(,i)-.44 G 3.566(ti)92.539 609.303 S 3.566(sn)102.221 609.303 S +.816(ot a good idea to close the \214le descriptor associated with the Scheme \ +system')115.566 609.303 R 3.567(sc)-.605 G(urrent)477.732 609.303 Q +(input port or current output port.)72 624.303 Q(Example:)72 642.903 Q EP +%%Page: 6 6 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(let \(\(stdout-fileno)100.346 94.503 Q +(\(unix-port-filedescriptor \(current-output-port\)\)\)\))148.346 108.503 Q +(\(if \(unix-isatty? stdout-fileno\))112.346 122.503 Q(\(begin)136.346 136.503 +Q(\(display \(unix-ttyname stdout-fileno\)\))148.346 150.503 Q +(\(newline\)\)\)\))148.346 164.503 Q/F2 11/Times-Bold@0 SF +(\(unix-\214ledescriptor)72 201.503 Q/F3 11/Symbol SF(-)A F2(>port)A/F4 11 +/Times-Italic@0 SF(fdescr type)4.583 E F2 205.008(\)p)C -.198(ro)462.244 +201.503 S(cedur).198 E(e)-.198 E F0 3.972(Creates a Scheme port with a \214le \ +pointer containing the speci\214ed \214le descriptor)72 220.103 R(.)-.605 E F4 +(unix-)9.471 E(\214ledescriptor)72 235.103 Q F3(-)A F4(>port)A F0 1.143 +(is based on the)3.893 F F4(fdopen\(\))3.893 E F0 1.143(stdio function.)3.893 F +F4(type)6.643 E F0 1.143(is a string and is used as the)3.893 F(second ar)72 +250.103 Q(gument for)-.198 E F4(fdopen\(\))2.75 E F0(.)A 1.112 +(The type of the ne)72 268.703 R 1.112 +(wly created Scheme port is determined by the)-.275 F F4(type)3.861 E F0(ar) +3.861 E 3.861(gument. If)-.198 F F4(type)3.861 E F0(be)3.861 E(gins)-.165 E .45 +(with the character #\\r)72 283.703 R 3.2(,a)-.44 G 3.2(ni)177.519 283.703 S +.45(nput port is created; #\\w and #\\a indicate an output port.)189.277 +283.703 R .451(If the second)5.951 F(character of)72 298.703 Q F4(type)2.75 E +F0(is #\\+ \()2.75 E F4(update)A F0 +(\), an input-output \(bidirectional\) port is created.)A 2.114 +(No \214lename is associated with a Scheme port created by a call to)72 317.303 +R F4(unix-\214ledescriptor)4.864 E F3(-)A F4(>port)A F0(.)A 1.104 +(Instead, the string)72 332.303 R F4(unix-\214ledescriptor[%d])3.855 E F0 +(\(where)3.855 E F4(%d)3.855 E F0 1.105(is replaced by the numerical v)3.855 F +1.105(alue of the)-.275 F(\214le descriptor\) will be returned by calls to)72 +347.303 Q F4(port-\214le-name)2.75 E F0(and displayed when printing the port.) +2.75 E 1.33(Note that the \214le descriptor is closed by the g)72 365.903 R +1.329(arbage collector when the Scheme port becomes)-.055 F(inaccessible.)72 +380.903 Q F2 2.75(7. Files)72 410.903 R(and Dir)2.75 E(ectories)-.198 E +(\(unix-stat)72 440.903 Q F4(\214le)4.583 E F2 317.219(\)p)C -.198(ro)462.244 +440.903 S(cedur).198 E(e)-.198 E F0(The UNIX)72 459.503 Q F4(stat\(\))2.75 E F0 +(/)A F4(fstat\(\))A F0(system call.)2.75 E F4(\214le)5.5 E F0 +(is either a \214lename or a \214le descriptor)2.75 E(.)-.605 E F4(unix-stat)72 +478.103 Q F0(returns a)2.75 E F4(stat-r)2.75 E(ecor)-.407 E(d)-.407 E F0 +(with the follo)2.75 E(wing \214elds:)-.275 E 280.076 497.853 72 497.853 DL +24.277(Field T)82.692 510.103 R 48.867(ype Contents)-.88 F 280.076 514.853 72 +514.853 DL 280.076 516.853 72 516.853 DL/F5 11/Courier@0 SF(type)77.5 529.103 Q +F0 13.75(symbol \214le)127 529.103 R(type)2.75 E 280.076 533.853 72 533.853 DL +F5(mode)77.5 546.103 Q F0(inte)127 546.103 Q 15.763(ger \214le)-.165 F +(access mode)2.75 E 280.076 550.853 72 550.853 DL F5(ino)77.5 563.103 Q F0 +(inte)127 563.103 Q 15.763(ger inode)-.165 F(number)2.75 E 280.076 567.853 72 +567.853 DL F5(dev)77.5 580.103 Q F0(inte)127 580.103 Q 15.763(ger de)-.165 F +(vice number)-.275 E 280.076 584.853 72 584.853 DL F5(nlink)77.5 597.103 Q F0 +(inte)127 597.103 Q 15.763(ger number)-.165 F(of links to \214le)2.75 E 280.076 +601.853 72 601.853 DL F5(uid)77.5 614.103 Q F0(inte)127 614.103 Q 15.763 +(ger \214le)-.165 F -.275(ow)2.75 G(ner').275 E 2.75(su)-.605 G(ser)235.504 +614.103 Q(-ID)-.22 E 280.076 618.853 72 618.853 DL F5(gid)77.5 631.103 Q F0 +(inte)127 631.103 Q 15.763(ger \214le)-.165 F -.275(ow)2.75 G(ner').275 E 2.75 +(sg)-.605 G(roup-ID)235.504 631.103 Q 280.076 635.853 72 635.853 DL F5(size) +77.5 648.103 Q F0(inte)127 648.103 Q 15.763(ger \214le)-.165 F(size)2.75 E +280.076 652.853 72 652.853 DL F5(atime)77.5 665.103 Q F0(inte)127 665.103 Q +15.763(ger last)-.165 F(access time)2.75 E 280.076 669.853 72 669.853 DL F5 +(mtime)77.5 682.103 Q F0(inte)127 682.103 Q 15.763(ger last)-.165 F +(modi\214ed time)2.75 E 280.076 686.853 72 686.853 DL F5(ctime)77.5 699.103 Q +F0(inte)127 699.103 Q 15.763(ger last)-.165 F(inode change time)2.75 E 280.076 +703.853 72 703.853 DL 280.076 497.853 280.076 703.853 DL 72 497.853 72 703.853 +DL 167.645 497.853 167.645 703.853 DL 118.75 497.853 118.75 703.853 DL EP +%%Page: 7 7 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-7-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL .957(The \214le type is one of the symbols)72 87 R/F1 11 +/Times-Italic@0 SF(dir)3.708 E(ectory)-.407 E F0(,)A F1 -.165(ch)3.708 G(ar) +.165 E(acter)-.165 E(-special)-.22 E F0(,)A F1(bloc)3.708 E(k-special)-.22 E F0 +(,)A F1 -.407(re)3.708 G(gular)-.033 E F0(,)A F1(symlink)3.708 E F0(,)A F1(soc) +72 102 Q -.11(ke)-.22 G(t).11 E F0(,)A F1(\214fo)2.75 E F0 2.75(,o)C(r)129.717 +102 Q F1(unknown)2.75 E F0(.)A/F2 11/Times-Bold@0 SF(\(unix-access?)72 132 Q F1 +(\214lename mode)4.583 E F2 249.712(\)p)C -.198(ro)462.244 132 S(cedur).198 E +(e)-.198 E F1(unix-access?)72 150.6 Q F0 .68(is based on the)3.43 F F1 +(access\(\))3.43 E F0 .68(system call.)3.43 F F1(mode)6.18 E F0 .68 +(is a list of zero or more of the symbols)3.43 F F1 -.407(re)72 165.6 S(ad).407 +E F0(,)A F1(write)3.406 E F0 3.406(,a)C(nd)131.568 165.6 Q F1 -.22(ex)3.406 G +(ecute).22 E F0 6.156(.T)C .657(he empty list can be used to test for e)194.359 +165.6 R .657(xistence of the \214le.)-.165 F .657(The proce-)6.157 F +(dure returns #t if the speci\214ed access is granted, #f otherwise.)72 180.6 Q +F2(\(unix-chdir)72 210.6 Q F1(\214lename)4.583 E F2 285.44(\)p)C -.198(ro) +462.244 210.6 S(cedur).198 E(e)-.198 E F0(The UNIX)72 229.2 Q F1 -.165(ch)2.75 +G(dir\(\)).165 E F0(system call.)2.75 E F1(unix-c)5.5 E(hdir)-.165 E F0 +(returns the non-printing object.)2.75 E F2(\(unix-chmod)72 259.2 Q F1 +(\214lename mode)4.583 E F2 252.143(\)p)C -.198(ro)462.244 259.2 S(cedur).198 E +(e)-.198 E F0(The UNIX)72 277.8 Q F1 -.165(ch)2.75 G(mod\(\)).165 E F0 +(system call.)2.75 E F1(mode)5.5 E F0(is an inte)2.75 E(ger)-.165 E(.)-.605 E +F1(unix-c)5.5 E(hmod)-.165 E F0(returns the non-printing object.)2.75 E F2 +(\(unix-cho)72 307.8 Q(wn)-.11 E F1(\214lename uid gid)4.583 E F2 246.434(\)p)C +-.198(ro)462.244 307.8 S(cedur).198 E(e)-.198 E F0 1.238(The UNIX)72 326.4 R F1 +-.165(ch)3.988 G(own\(\)).165 E F0 1.238(system call.)3.988 F F1(uid)6.738 E F0 +(and)3.988 E F1(gid)3.988 E F0 1.238(are inte)3.988 F(gers.)-.165 E F1(unix-c) +6.737 E(hown)-.165 E F0 1.237(returns the non-printing)3.987 F(object.)72 341.4 +Q F2(\(unix-unlink)72 371.4 Q F1(\214lename)4.583 E F2 279.918(\)p)C -.198(ro) +462.244 371.4 S(cedur).198 E(e)-.198 E F0(The UNIX)72 390 Q F1(unlink\(\))2.75 +E F0(system call.)2.75 E F1(unix-unlink)5.5 E F0 +(returns the non-printing object.)2.75 E F2(\(unix-link)72 420 Q F1(\214lename) +4.583 E/F3 10/Times-Italic@0 SF(1)3.3 I F1(\214lename)2.75 -3.3 M F3(2)3.3 I F2 +242.132(\)p)-3.3 K -.198(ro)462.244 420 S(cedur).198 E(e)-.198 E F0(The UNIX)72 +438.6 Q F1(link\(\))2.75 E F0(system call.)2.75 E F1(unix-link)5.5 E F0 +(returns the non-printing object.)2.75 E F2(\(unix-r)72 468.6 Q(ename)-.198 E +F1(\214lename)4.583 E F3(1)3.3 I F1(\214lename)2.75 -3.3 M F3(2)3.3 I F2 +225.247(\)p)-3.3 K -.198(ro)462.244 468.6 S(cedur).198 E(e)-.198 E F0(The UNIX) +72 487.2 Q F1 -.407(re)2.75 G(name\(\)).407 E F0(system call.)2.75 E F1(unix-r) +5.5 E(ename)-.407 E F0(returns the non-printing object.)2.75 E 1.79 +(On platforms where the)72 505.8 R F1 -.407(re)4.54 G(name\(\)).407 E F0 1.79 +(function is not a)4.54 F -.275(va)-.22 G 1.791 +(ilable, the operation is performed by the).275 F(equi)72 520.8 Q -.275(va) +-.275 G .354(lent sequence of).275 F F1(link\(\))3.104 E F0(and)3.104 E F1 +(unlink\(\))3.104 E F0 .353 +(calls with interrupts disabled \(certain restrictions apply)3.104 F +(in this case, e.)72 535.8 Q(g. directories cannot be renamed\).)1.833 E F2 +(\(unix-mkdir)72 565.8 Q F1(\214lename mode)4.583 E F2 254.585(\)p)C -.198(ro) +462.244 565.8 S(cedur).198 E(e)-.198 E F0(The UNIX)72 584.4 Q F1(mkdir\(\))2.75 +E F0(system call.)2.75 E F1(mode)5.5 E F0(is an inte)2.75 E(ger)-.165 E(.)-.605 +E F1(unix-mkdir)5.5 E F0(returns the non-printing object.)2.75 E F2 +(\(unix-rmdir)72 614.4 Q F1(\214lename)4.583 E F2 282.393(\)p)C -.198(ro) +462.244 614.4 S(cedur).198 E(e)-.198 E F0(The UNIX)72 633 Q F1(rmdir\(\))2.75 E +F0(system call.)2.75 E F1(unix-rmdir)5.5 E F0(returns the non-printing object.) +2.75 E F2(\(unix-utime)72 663 Q F1(\214lename)4.583 E F2 283.614(\)p)C -.198 +(ro)462.244 663 S(cedur).198 E(e)-.198 E(\(unix-utime)72 678 Q F1 +(\214lename atime mtime)4.583 E F2 226.788(\)p)C -.198(ro)462.244 678 S(cedur) +.198 E(e)-.198 E F0 1.833(The UNIX)72 696.6 R F1(utime\(\))4.583 E F0 +(function.)4.583 E F1(unix-utime)7.333 E F0 1.834 +(sets the last access and last modi\214cation time of the)4.583 F(gi)72 711.6 Q +-.165(ve)-.275 G 2.902<6e8c>.165 G .152(le to the current time \(\214rst form\ +\) or to the speci\214ed times \(second form\).)105.02 711.6 R F1(atime)5.652 E +F0(and)2.901 E F1(mtime)2.901 E F0(are inte)72 726.6 Q(gers.)-.165 E F1 +(unix-utime)5.5 E F0(returns the non-printing object.)2.75 E EP +%%Page: 8 8 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-8-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(unix-r)72 87 Q(ead-dir)-.198 E(ectory)-.198 +E/F2 11/Times-Italic@0 SF(\214lename)4.583 E F1 242.474(\)p)C -.198(ro)462.244 +87 S(cedur).198 E(e)-.198 E F0 .47(This procedure returns the contents of the \ +speci\214ed directory as a list of \214lenames \(strings\).)72 105.6 R F2 +(\214le-)5.97 E(name)72 120.6 Q F0 .882(must be the name of a directory)3.633 F +(.)-.715 E F2(unix-r)6.382 E(ead-dir)-.407 E(ectory)-.407 E F0 .882 +(is based on the)3.632 F F2(opendir\(\))3.632 E F0(,)A F2 -.407(re)3.632 G +(addir\(\)).407 E F0(,)A(and)72 135.6 Q F2(closedir\(\))2.75 E F0(functions.) +2.75 E(Example:)72 154.2 Q/F3 10/Courier@0 SF +(;;; Return directory contents as list of \(filename . filetype\) pairs)100.346 +176.703 Q(\(define \(get-files-and-types directory\))100.346 196.303 Q(\(map) +112.346 210.303 Q(\(lambda \(file\))124.346 224.303 Q +(\(cons file \(stat-type \(unix-stat file\)\)\)\))136.346 238.303 Q +(\(unix-read-directory directory\)\)\))124.346 252.303 Q +(\(pp \(get-files-and-types "."\)\))100.346 274.703 Q F1 -.917 +(\(unix-tempname \))72 311.703 R(pr)456.128 311.703 Q(ocedur)-.198 E(e)-.198 E +(\(unix-tempname)72 326.703 Q F2(dir)4.583 E(ectory)-.407 E F1 258.358(\)p)C +-.198(ro)462.244 326.703 S(cedur).198 E(e)-.198 E(\(unix-tempname)72 341.703 Q +F2(dir)4.583 E(ectory pr)-.407 E(e\214x)-.407 E F1 230.968(\)p)C -.198(ro) +462.244 341.703 S(cedur).198 E(e)-.198 E F2(unix-tempname)72 360.303 Q F0 .575 +(returns a pathname that can be used as the name of a temporary \214le \(typic\ +ally in)3.325 F(/tmp or /usr/tmp\).)72 375.303 Q(The ne)5.5 E +(wly created pathname is not the name of an e)-.275 E(xisting \214le.)-.165 E +F2(dir)72 393.903 Q(ectory)-.407 E F0 1.026(\(a string or symbol\) can be used\ + to specify the directory component of the pathname;)3.777 F F2(pr)72 408.903 Q +(e\214x)-.407 E F0 1.049(\(string or symbol\), if present, may be used as a pr\ +e\214x for the \214lename component of the)3.799 F 2.75(pathname. Ho)72 423.903 +R(we)-.275 E -.165(ve)-.275 G .88 -.44(r, b).165 H(oth ar).44 E +(guments may be ignored by)-.198 E F2(unix-tempname)2.75 E F0(.)A F2 +(unix-tempname)72 442.503 Q F0 .967(is based on one of the UNIX functions)3.717 +F F2(tempnam\(\))3.717 E F0(,)A F2(mktemp\(\))3.717 E F0 3.717(,a)C(nd)430.578 +442.503 Q F2(tmpnam\(\))3.717 E F0(\(in)3.716 E .973 +(that order\); if none of these functions is a)72 457.503 R -.275(va)-.22 G +.974(ilable, an algorithm similar to the one emplo).275 F .974(yed by)-.11 F +(UNIX)72 472.503 Q F2(mktemp\(\))2.75 E F0(is used.)2.75 E F1 2.75(8. Symbolic) +72 502.503 R(Links)2.75 E F0 .236(The follo)97 521.103 R .235 +(wing procedures are only de\214ned on platforms that support symbolic links.) +-.275 F .235(In this)5.735 F(case, the feature)72 536.103 Q F2(unix:symlinks) +2.75 E F0(is pro)2.75 E(vided when the UNIX e)-.165 E(xtension is loaded.)-.165 +E F1(\(unix-lstat)72 566.103 Q F2(\214lename)4.583 E F1 290.335(\)p)C -.198(ro) +462.244 566.103 S(cedur).198 E(e)-.198 E F0(The UNIX)72 584.703 Q F2(lstat\(\)) +2.75 E F0(system call.)2.75 E F2(unix-lstat)5.5 E F0(returns a)2.75 E F2 +(stat-r)2.75 E(ecor)-.407 E(d)-.407 E F0(\(see)2.75 E F2(unix-stat)2.75 E F0 +(abo)2.75 E -.165(ve)-.165 G(\).).165 E F1(\(unix-r)72 614.703 Q(eadlink)-.198 +E F2(\214lename)4.583 E F1 270.964(\)p)C -.198(ro)462.244 614.703 S(cedur).198 +E(e)-.198 E F0 .133(The UNIX)72 633.303 R F2 -.407(re)2.883 G(adlink\(\)).407 E +F0 .133(system call.)2.883 F F2(unix-r)5.633 E(eadlink)-.407 E F0 .134 +(returns the contents of speci\214ed symbolic link as)2.883 F 2.75(as)72 +648.303 S(tring.)83.913 648.303 Q F1(\(unix-symlink)72 678.303 Q F2(\214lename) +4.583 E/F4 10/Times-Italic@0 SF(1)3.3 I F2(\214lename)2.75 -3.3 M F4(2)3.3 I F1 +223.19(\)p)-3.3 K -.198(ro)462.244 678.303 S(cedur).198 E(e)-.198 E F0 +(The UNIX)72 696.903 Q F2(symlink\(\))2.75 E F0(system call.)2.75 E F2 +(unix-symlink)5.5 E F0(returns the non-printing object.)2.75 E EP +%%Page: 9 9 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-9-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(9. File)72 87 R(and Record Locking)2.75 +E F0 .267(The procedures described in this section are only de\214ned if some \ +form of \214le-based locking)97 105.6 R .335(is a)72 120.6 R -.275(va)-.22 G +.336(ilable on the local system \(either locking of entire \214les, or record \ +locking\).).275 F .336(In this case, the)5.836 F(feature)72 135.6 Q/F2 11 +/Times-Italic@0 SF(unix:\214le-loc)2.972 E(king)-.22 E F0 .222(is pro)2.972 F +.221(vided at the time the UNIX e)-.165 F .221(xtension is loaded.)-.165 F .221 +(If the local system)5.721 F .055(supports locking of indi)72 150.6 R .055 +(vidual \214le se)-.275 F .056(gments, the feature)-.165 F F2(unix:r)2.806 E +(ecor)-.407 E(d-loc)-.407 E(ks)-.22 E F0 .056(is pro)2.806 F .056 +(vided as well, and)-.165 F 1.491(the locking primiti)72 165.6 R -.165(ve)-.275 +G 4.241(sa).165 G 1.491(re based on the)180.225 165.6 R F2(fcntl\(\))4.241 E F0 +1.491(system call \(otherwise the)4.241 F F2(\215oc)4.24 E(k\(\))-.22 E F0 1.49 +(system call is)4.24 F(used\).)72 180.6 Q F1(\(unix-set-lock)72 210.6 Q F2 +(fdescr loc)4.583 E 2.75(kw)-.22 G(ait?)198.573 210.6 Q F1 236.776(\)p)C -.198 +(ro)462.244 210.6 S(cedur).198 E(e)-.198 E F0(The)72 229.2 Q F2(loc)2.75 E(k) +-.22 E F0(ar)2.75 E(gument is a)-.198 E F2(loc)2.75 E(k-r)-.22 E(ecor)-.407 E +(d)-.407 E F0(with these \214elds:)2.75 E 390.659 248.95 72 248.95 DL F1 41.657 +(Field T)98.581 261.2 R 85.487(ype Contents)-.814 F 390.659 265.95 72 265.95 DL +390.659 267.95 72 267.95 DL/F3 11/Courier@0 SF(exclusive?)77.5 280.2 Q F1 +(boolean)160 280.2 Q(exclusi)213.174 280.2 Q .22 -.11(ve l)-.11 H +(ock \(write lock\) if #t,).11 E(shar)213.174 295.2 Q(ed lock \(r)-.198 E +(ead lock\) otherwise)-.198 E 390.659 299.95 72 299.95 DL F3(whence)77.5 312.2 +Q F1(symbol)160 312.2 Q F2(set)213.174 312.2 Q F1(,)A F2(curr)2.75 E(ent)-.407 +E F1 2.75(,o)C(r)273.872 312.2 Q F2(end)2.75 E F1(:)A(inter)213.174 327.2 Q(pr) +-.11 E(etation of)-.198 E F2(start)2.75 E F1(\(see)2.75 E F2(unix-lseek)2.75 E +F1(\))A 390.659 331.95 72 331.95 DL F3(start)77.5 344.2 Q F1 17.435(integer r) +160 344.2 R(elati)-.198 E .22 -.11(ve o)-.11 H(ffset in bytes).11 E 390.659 +348.95 72 348.95 DL F3(length)77.5 361.2 Q F1(integer)160 361.2 Q +(length in bytes)213.174 361.2 Q(\(0 means lock to EOF\))213.174 376.2 Q +390.659 380.95 72 380.95 DL 390.659 248.95 390.659 380.95 DL 72 248.95 72 +380.95 DL 204.924 248.95 204.924 380.95 DL 151.75 248.95 151.75 380.95 DL F0 +1.328(If record locks are supported, the \214elds)72 400.8 R F2(whence)4.079 E +F0(,)A F2(start)4.079 E F0 4.079(,a)C(nd)327.739 400.8 Q F2(length)4.079 E F0 +1.329(specify a se)4.079 F 1.329(gment in the \214le)-.165 F .567 +(referred to by)72 415.8 R F2(fdescr)3.316 E F0 .566(that is to be lock)3.316 F +.566(ed or unlock)-.11 F 3.316(ed. If)-.11 F .566 +(only entire \214les can be lock)3.316 F .566(ed, the con-)-.11 F +(tents of these \214elds are ignored by the lock procedures.)72 430.8 Q .743 +(An arbitrary number of shared locks for a \214le or \214le se)72 449.4 R .743 +(gment may be acti)-.165 F 1.073 -.165(ve a)-.275 H 3.494(tag).165 G -2.365 +-.275(iv e)442.364 449.4 T 3.494(nt).275 G .744(ime, b)467.418 449.4 R(ut)-.22 +E .396(more than one e)72 464.4 R(xclusi)-.165 E .726 -.165(ve l)-.275 H .396 +(ock, or both shared and e).165 F(xclusi)-.165 E .726 -.165(ve l)-.275 H .396 +(ocks, cannot be set at the same time.).165 F F2(fdescr)72 479.4 Q F0 .949(mus\ +t be opened for reading to be able to set a shared lock; it must be opened wit\ +h write)3.699 F .067(access for an e)72 494.4 R(xclusi)-.165 E .397 -.165(ve l) +-.275 H 2.817(ock. A).165 F .066(shared lock may be upgraded to an e)2.817 F +(xclusi)-.165 E .396 -.165(ve l)-.275 H .066(ock, and vice v).165 F(ersa.)-.165 +E(Mandatory locking may or may not be supported by the local system.)72 509.4 Q +.274(If the)72 528 R F2(wait?)3.024 E F0(ar)3.024 E .274 +(gument is #t and the speci\214ed lock cannot be applied,)-.198 F F2 +(unix-set-loc)3.024 E(k)-.22 E F0 .275(blocks until the)3.024 F(lock becomes a) +72 543 Q -.275(va)-.22 G(ilable.).275 E F2(unix-set-loc)72 561.6 Q(k)-.22 E F0 +(returns #t if the speci\214ed lock could be applied, #f otherwise.)2.75 E F1 +(\(unix-r)72 591.6 Q(emo)-.198 E -.11(ve)-.11 G(-lock).11 E F2(fdescr loc)4.583 +E(k)-.22 E F1 242.408(\)p)C -.198(ro)462.244 591.6 S(cedur).198 E(e)-.198 E F0 +.919(This procedure remo)72 610.2 R -.165(ve)-.165 G 3.669(st).165 G .919 +(he speci\214ed \214le lock or record lock from the \214le pointed to by) +186.539 610.2 R F2(fdescr)3.669 E F0(.)A F2(loc)72 625.2 Q(k)-.22 E F0 .271 +(is a)3.021 F F2(loc)3.021 E(k-r)-.22 E(ecor)-.407 E(d)-.407 E F0 3.021(;s)C +(ee)172.029 625.2 Q F2(unix-set-loc)3.021 E(k)-.22 E F0(abo)3.021 E .601 -.165 +(ve f)-.165 H .271(or a description.).165 F F2(unix-r)5.772 E(emo)-.407 E +(ve-loc)-.11 E(k)-.22 E F0 .272(returns the non-)3.022 F(printing object.)72 +640.2 Q F1(\(unix-query-lock)72 670.2 Q F2(fdescr loc)4.583 E(k)-.22 E F1 +249.305(\)p)C -.198(ro)462.244 670.2 S(cedur).198 E(e)-.198 E F0 .325 +(If record locks are not supported, this procedure al)72 688.8 R -.11(wa)-.11 G +.325(ys returns #f.).11 F .324(If record locks are supported,)5.824 F F2 +(unix-query-loc)72 703.8 Q(k)-.22 E F0 1.243 +(returns information about the \214rst lock that w)3.992 F 1.243 +(ould cause a call to)-.11 F F2(unix-set-loc)3.993 E(k)-.22 E F0(with)72 718.8 +Q F2(loc)3.779 E(k)-.22 E F0 1.029(to f)3.779 F 1.028 +(ail or block, or #f if no such lock e)-.11 F 1.028(xists \(i.)-.165 F 1.028 +(e. if claiming the speci\214ed lock w)1.833 F(ould)-.11 E 2.997 +(succeed\). Information)72 733.8 R .247 +(about the lock is returned as a pair; the car is an inte)2.997 F .247 +(ger \(the process-ID of)-.165 F EP +%%Page: 10 10 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(0-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL .333(the the process that o)72 87 R .333 +(wns the lock\), the cdr is a)-.275 F/F1 11/Times-Italic@0 SF(loc)3.082 E(k-r) +-.22 E(ecor)-.407 E(d)-.407 E F0 5.832(.T)C .332 +(he process-ID may be meaningless)349.321 87 R(in a netw)72 102 Q(ork en)-.11 E +(vironment.)-.44 E/F2 11/Times-Bold@0 SF 2.75(10. Obtaining)72 132 R -.11(Pa) +2.75 G(ssw).11 E(ord and Gr)-.11 E(oup File Entries)-.198 E F0 .789(The proced\ +ures de\214ned in this section are used to obtain entries from the system')97 +150.6 R(s)-.605 E F1(passwd)3.539 E F0(and)72 165.6 Q F1(gr)2.75 E(oup)-.495 E +F0(databases.)2.75 E F2 -.917(\(unix-get-passwd \))72 195.6 R(pr)456.128 195.6 +Q(ocedur)-.198 E(e)-.198 E(\(unix-get-passwd)72 210.6 Q F1(user)4.583 E F2 +276.882(\)p)C -.198(ro)462.244 210.6 S(cedur).198 E(e)-.198 E F0 .737(If in)72 +229.2 R -.22(vo)-.44 G -.11(ke).22 G 3.487(dw).11 G .737(ithout an ar)128.914 +229.2 R .737(gument, this procedure returns the ne)-.198 F .737 +(xt entry from the)-.165 F F1(passwd)3.486 E F0(database.)3.486 E(Successi)72 +244.2 Q 1.018 -.165(ve c)-.275 H .688(alls to).165 F F1(unix-g)3.438 E +(et-passwd)-.11 E F0 .688(return entries in a random order)3.438 F 6.188(.T) +-.605 G(he)392.391 244.2 Q F1(user)3.438 E F0(ar)3.438 E .688(gument, if pre-) +-.198 F .505(sent, is either the login name of a user \(a string or symbol\) o\ +r a numeric user)72 259.2 R .504(-ID \(an inte)-.22 F 3.254(ger\). In)-.165 F +(this case, the)72 274.2 Q F1(passwd)2.75 E F0 +(entry for this user is returned.)2.75 E F1(unix-g)72 292.8 Q(et-passwd)-.11 E +F0(returns a)2.75 E F1(passwd-r)2.75 E(ecor)-.407 E(d)-.407 E F0 +(with the follo)2.75 E(wing \214elds:)-.275 E 329.301 312.55 72 312.55 DL F2 +33.215(Field T)91.981 324.8 R 61.407(ype Contents)-.814 F 329.301 329.55 72 +329.55 DL 329.301 331.55 72 331.55 DL/F3 11/Courier@0 SF(name)77.5 343.8 Q F2 +19.239(string login)146.8 343.8 R(name)2.75 E 329.301 348.55 72 348.55 DL F3 +(password)77.5 360.8 Q F2 19.239(string login)146.8 360.8 R(passw)2.75 E(ord) +-.11 E 329.301 365.55 72 365.55 DL F3(uid)77.5 377.8 Q F2 13.75 +(integer numeric)146.8 377.8 R(user)2.75 E(-ID)-.407 E 329.301 382.55 72 382.55 +DL F3(gid)77.5 394.8 Q F2 13.75(integer numeric)146.8 394.8 R(primary gr)2.75 E +(oup-ID)-.198 E 329.301 399.55 72 399.55 DL F3(gecos)77.5 411.8 Q F2 19.239 +(string contents)146.8 411.8 R(of GECOS \214eld)2.75 E 329.301 416.55 72 416.55 +DL F3(homedir)77.5 428.8 Q F2 19.239(string home)146.8 428.8 R(dir)2.75 E +(ectory of user)-.198 E 329.301 433.55 72 433.55 DL F3(shell)77.5 445.8 Q F2 +19.239(string login)146.8 445.8 R(shell of user)2.75 E 329.301 450.55 72 450.55 +DL 329.301 312.55 329.301 450.55 DL 72 312.55 72 450.55 DL 188.039 312.55 +188.039 450.55 DL 138.55 312.55 138.55 450.55 DL F1(unix-g)72 470.4 Q +(et-passwd)-.11 E F0(is based on the UNIX)2.75 E F1 -.11(ge)2.75 G(tpwent\(\)) +.11 E F0(,)A F1 -.11(ge)2.75 G(tpwuid\(\)).11 E F0 2.75(,a)C(nd)355.184 470.4 Q +F1 -.11(ge)2.75 G(tpwnam\(\)).11 E F0(functions.)2.75 E F2(\(unix-get-gr)72 +500.4 Q -.917(oup \))-.198 F(pr)456.128 500.4 Q(ocedur)-.198 E(e)-.198 E +(\(unix-get-gr)72 515.4 Q(oup)-.198 E F1(gr)4.583 E(oup)-.495 E F2 276.354(\)p) +C -.198(ro)462.244 515.4 S(cedur).198 E(e)-.198 E F1(unix-g)72 534 Q(et-gr)-.11 +E(oup)-.495 E F0 3.487(is identical to)6.237 F F1(unix-g)6.238 E(et-passwd)-.11 +E F0 3.488(\(see abo)6.238 F -.165(ve)-.165 G 3.488(\), e).165 F 3.488 +(xcept that the system')-.165 F(s)-.605 E F1(gr)6.238 E(oup)-.495 E F0 +(database is used instead of the)72 549 Q F1(passwd)2.75 E F0(database.)2.75 E +(The result v)72 567.6 Q(alue is a)-.275 E F1(gr)2.75 E(oup-r)-.495 E(ecor) +-.407 E(d)-.407 E F0(with these \214elds:)2.75 E 321.073 587.35 72 587.35 DL F2 +50.028(Field T)91.981 599.6 R 57.294(ype Contents)-.814 F 321.073 604.35 72 +604.35 DL F3(name)77.5 616.6 Q F2 52.866(string gr)146.8 616.6 R(oup')-.198 E +2.75(sn)-.407 G(ame)274.235 616.6 Q 321.073 621.35 72 621.35 DL F3(password) +77.5 633.6 Q F2 52.866(string gr)146.8 633.6 R(oup')-.198 E 2.75(sp)-.407 G +(assw)274.235 633.6 Q(ord)-.11 E 321.073 638.35 72 638.35 DL F3(gid)77.5 650.6 +Q F2 47.377(integer numeric)146.8 650.6 R(gr)2.75 E(oup-ID)-.198 E 321.073 +655.35 72 655.35 DL F3(members)77.5 667.6 Q F2(list of symbols)146.8 667.6 Q +(gr)229.916 667.6 Q(oup members)-.198 E 321.073 672.35 72 672.35 DL 321.073 +587.35 321.073 672.35 DL 72 587.35 72 672.35 DL 221.666 587.35 221.666 672.35 +DL 138.55 587.35 138.55 672.35 DL F1(unix-g)72 692.2 Q(et-gr)-.11 E(oup)-.495 E +F0(is based on the UNIX)2.75 E F1 -.11(ge)2.75 G(tgr).11 E(ent\(\))-.407 E F0 +(,)A F1 -.11(ge)2.75 G(tgr).11 E(gid\(\))-.407 E F0 2.75(,a)C(nd)341.643 692.2 +Q F1 -.11(ge)2.75 G(tgrnam\(\)).11 E F0(functions.)2.75 E EP +%%Page: 11 11 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(1-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(unix-r)72 87 Q -.917(ewind-passwd \))-.198 +F(pr)456.128 87 Q(ocedur)-.198 E(e)-.198 E(\(unix-r)72 102 Q(ewind-gr)-.198 E +-.917(oup \))-.198 F(pr)456.128 102 Q(ocedur)-.198 E(e)-.198 E F0 2.089 +(These procedures re)72 120.6 R 2.089(wind the)-.275 F/F2 11/Times-Italic@0 SF +(passwd)4.839 E F0(and)4.839 E F2(gr)4.839 E(oup)-.495 E F0 2.089 +(\214les by calling the)4.839 F F2(setpwent\(\))4.839 E F0(and)4.839 E F2 +(setgr)4.838 E(ent\(\))-.407 E F0(UNIX functions.)72 135.6 Q F1 -.917 +(\(unix-end-passwd \))72 165.6 R(pr)456.128 165.6 Q(ocedur)-.198 E(e)-.198 E +(\(unix-end-gr)72 180.6 Q -.917(oup \))-.198 F(pr)456.128 180.6 Q(ocedur)-.198 +E(e)-.198 E F2(unix-end-passwd)72 199.2 Q F0(and)3.084 E F2(unix-end-gr)3.084 E +(oup)-.495 E F0 .335(close the)3.085 F F2(passwd)3.085 E F0(and)3.085 E F2(gr) +3.085 E(oup)-.495 E F0 .335(\214les by calling the UNIX func-)3.085 F(tions)72 +214.2 Q F2(endpwent\(\))2.75 E F0(and)2.75 E F2(endgr)2.75 E(ent\(\))-.407 E F0 +(.)A F1 2.75(11. Pr)72 244.2 R(ocess Cr)-.198 E(eation and Contr)-.198 E(ol) +-.198 E(\(unix-system)72 274.2 Q F2(string)4.583 E F1 290.324(\)p)C -.198(ro) +462.244 274.2 S(cedur).198 E(e)-.198 E F2(unix-system)72 292.8 Q F0 .222 +(starts `)2.972 F(`/bin/sh')-.814 E 2.972('a)-.814 G 2.972(sac)203.929 292.8 S +.222(hild process with)223.92 292.8 R F2(string)2.972 E F0 .222(as input and w) +2.972 F .222(aits until the shell termi-)-.11 F 4.009(nates. All)72 307.8 R +1.259(\214le descriptors e)4.009 F 1.26 +(xcept standard input, standard output, and standard error output are)-.165 F +.775(closed in the child process.)72 322.8 R F2(unix-system)6.274 E F0 .774 +(returns the e)3.524 F .774(xit code of the shell as an inte)-.165 F .774 +(ger or)-.165 F 3.524(,i)-.44 G 3.524(ft)483.371 322.8 S(he)493.616 322.8 Q +1.238(shell w)72 337.8 R 1.238 +(as interrupted by a signal, the termination status as a list of one inte)-.11 +F 1.239(ger element.)-.165 F 1.239(If the)6.739 F(shell could not be e)72 352.8 +Q -.165(xe)-.165 G(cuted, e).165 E(xit code 127 is returned.)-.165 E F1 +(\(unix-open-input-pipe)72 382.8 Q F2(string)4.583 E F1 246.907(\)p)C -.198(ro) +462.244 382.8 S(cedur).198 E(e)-.198 E(\(unix-open-output-pipe)72 397.8 Q F2 +(string)4.583 E F1 240.802(\)p)C -.198(ro)462.244 397.8 S(cedur).198 E(e)-.198 +E F0 .129(The UNIX)72 416.4 R F2(popen\(\))2.879 E F0 2.879(function. Both) +2.879 F .129(procedures create a pipe between the caller and a shell e)2.879 F +-.165(xe)-.165 G(cut-).165 E .356(ing the command)72 431.4 R F2(string)3.106 E +F0 3.106(;t)C(he)187.098 431.4 Q 3.106(yr)-.165 G .356 +(eturn a Scheme port containing the \214le pointer associated with the)209.586 +431.4 R 5.309(pipe. Closing)72 446.4 R 2.559(the Scheme port, or running the g) +5.309 F 2.559(arbage collector after the port has become)-.055 F +(unused, causes the pipe to be closed by a call to the)72 461.4 Q F2 +(pclose\(\))2.75 E F0(function.)2.75 E F2(unix-open-input-pipe)72 480 Q F0 .078 +(returns an input port that can be used to read from the standard output of th\ +e)2.827 F .681(speci\214ed command;)72 495 R F2(unix-open-output-pipe)3.431 E +F0 .681(returns an output port that accepts input to be sent to)3.431 F +(the standard input of the command.)72 510 Q F1(\(unix-f)72 540 Q -.917(ork \)) +-.275 F(pr)456.128 540 Q(ocedur)-.198 E(e)-.198 E F0 .205(The UNIX)72 558.6 R +F2(fork\(\))2.955 E F0 .206(system call.)2.956 F F2(unix-fork)5.706 E F0 .206 +(returns the process-ID of the ne)2.956 F .206(wly created process as an)-.275 +F(inte)72 573.6 Q(ger in the parent process, and the inte)-.165 E +(ger 0 in the child process.)-.165 E .128 +(The child process, as its \214rst action, in)72 592.2 R -.22(vo)-.44 G -.11 +(ke).22 G 2.878(st).11 G(he)272.685 592.2 Q F2 .128(onfork handler)2.878 F(s) +-.11 E F0 .127(that may ha)2.878 F .457 -.165(ve b)-.22 H .127(een re).165 F +.127(gistered by)-.165 F 1.595(other Elk e)72 607.2 R 1.595 +(xtensions that are currently acti)-.165 F 1.925 -.165(ve \()-.275 H 1.596 +(one purpose of).165 F F2(onfork)4.346 E F0 1.596(handlers is to mak)4.346 F +4.346(en)-.11 G -.275(ew)491.449 607.2 S(links to temporary \214les in the ne) +72 622.2 Q(wly created child process\).)-.275 E F1(\(unix-exec)72 652.2 Q F2 +(\214lename ar)4.583 E(guments)-.407 E F1 241.561(\)p)C -.198(ro)462.244 652.2 +S(cedur).198 E(e)-.198 E(\(unix-exec)72 667.2 Q F2(\214lename ar)4.583 E +(guments en)-.407 E(vir)-.44 E(onment)-.495 E F1 184.757(\)p)C -.198(ro)462.244 +667.2 S(cedur).198 E(e)-.198 E(\(unix-exec-path)72 689.7 Q F2(\214lename ar) +4.583 E(guments)-.407 E F1 216.503(\)p)C -.198(ro)462.244 689.7 S(cedur).198 E +(e)-.198 E(\(unix-exec-path)72 704.7 Q F2(\214lename ar)4.583 E(guments en) +-.407 E(vir)-.44 E(onment)-.495 E F1 159.699(\)p)C -.198(ro)462.244 704.7 S +(cedur).198 E(e)-.198 E EP +%%Page: 12 12 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(2-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL 1.403(These procedures are based on the UNIX)72 87 R/F1 11 +/Times-Italic@0 SF -.22(ex)4.153 G(ecv\(\)).22 E F0 -.11(fa)4.153 G 1.403 +(mily of system calls and library functions.).11 F 1.608(The \214rst ar)72 102 +R 1.608(gument is the name of the \214le to be e)-.198 F -.165(xe)-.165 G +(cuted.).165 E F1(ar)7.108 E(guments)-.407 E F0 1.608 +(is a list of strings to be)4.358 F .914(passed to the program as ar)72 117 R +3.664(guments. The)-.198 F F1(en)3.664 E(vir)-.44 E(onment)-.495 E F0(ar)3.664 +E .913(gument, if present, is a list of en)-.198 F(viron-)-.44 E .615(ment v)72 +132 R .616(ariable de\214nitions to be used as the ne)-.275 F 3.366(wp)-.275 G +(rogram')291.161 132 Q 3.366(se)-.605 G -.44(nv)338.516 132 S 3.366 +(ironment. Each).44 F .616(element of the list)3.366 F .189 +(is pair of strings; the car of an element is the name of an en)72 147 R .188 +(vironment v)-.44 F .188(ariable, the cdr is the v)-.275 F(ari-)-.275 E(able') +72 162 Q 3.196(sv)-.605 G .446(alue \(the)106.084 162 R F1(unix-en)3.196 E(vir) +-.44 E(on)-.495 E F0(primiti)3.196 E .776 -.165(ve c)-.275 H .446 +(an be used to obtain the current en).165 F .447(vironment of the run-)-.44 F +(ning program\).)72 177 Q F1(unix-e)72 195.6 Q(xec-path)-.22 E F0 1.406(search\ +es the speci\214ed \214lename in a list of directories obtained from the calli\ +ng)4.157 F(program')72 210.6 Q 4.346(sP)-.605 G -1.221(AT)126.055 210.6 S 4.346 +(He)1.221 G -.44(nv)156.669 210.6 S 1.596(ironment v).44 F 4.347(ariable. The) +-.275 F -.275(va)4.347 G 1.597(riant of).275 F F1(unix-e)4.347 E(xec-path)-.22 +E F0 1.597(that accepts an)4.347 F F1(en)4.347 E(vir)-.44 E(on-)-.495 E(ment)72 +225.6 Q F0(ar)3.062 E .312(gument is not a)-.198 F -.275(va)-.22 G .311 +(ilable on the currently supported platforms \(the reason is that there is no) +.275 F F1 -.22(ex)72 240.6 S(ecvpe\(\)).22 E F0 -.275(va)5.19 G 2.44 +(riant of the).275 F F1 -.22(ex)5.191 G(ecvp\(\)).22 E F0 2.441 +(function, although)5.191 F F1 -.22(ex)5.191 G(ecve\(\)).22 E F0(/)A F1 -.22 +(ex)C(ecle\(\)).22 E F0 -.275(va)5.191 G 2.441(riants of).275 F F1 -.22(ex) +5.191 G(ecv\(\)).22 E F0(and)5.191 E F1 -.22(ex)72 255.6 S(ecl\(\)).22 E F0 +(usually e)2.75 E(xist in UNIX\).)-.165 E F1(unix-e)72 274.2 Q(xec)-.22 E F0 +(and)3.212 E F1(unix-e)3.212 E(xec-path)-.22 E F0(remo)3.212 E .792 -.165(ve t) +-.165 H .462(he temporary \214les used by the dynamic loading module of).165 F +2.297(the interpreter k)72 289.2 R 2.298(ernel and in)-.11 F -.22(vo)-.44 G +2.518 -.11(ke t).22 H 2.298(he \214nalization functions that may ha).11 F 2.628 +-.165(ve b)-.22 H 2.298(een re).165 F 2.298(gistered by)-.165 F -.165(ex)72 +304.2 S 2.772(tensions. As).165 F 2.771(ar)2.772 G .021 +(esult, attempting to load an object \214le after a call to)152.86 304.2 R F1 +(unix-e)2.771 E(xec)-.22 E F0(or)2.771 E F1(unix-e)2.771 E(xec-path)-.22 E F0 +1.755(has returned \(i.)72 319.2 R 1.755(e. f)1.833 F 1.755(ailed\) may not w) +-.11 F 1.755(ork correctly)-.11 F 7.255(.T)-.715 G 1.755 +(he \214nalization functions are only in)312.988 319.2 R -.22(vo)-.44 G -.11 +(ke).22 G(d).11 E(once.)72 334.2 Q/F2 11/Times-Bold@0 SF -.917(\(unix-wait \)) +72 364.2 R(pr)456.128 364.2 Q(ocedur)-.198 E(e)-.198 E(\(unix-wait)72 379.2 Q +F1(options)4.583 E F2 295.208(\)p)C -.198(ro)462.244 379.2 S(cedur).198 E(e) +-.198 E(\(unix-wait-pr)72 401.7 Q(ocess)-.198 E F1(pid)4.583 E F2 275.254(\)p)C +-.198(ro)462.244 401.7 S(cedur).198 E(e)-.198 E(\(unix-wait-pr)72 416.7 Q +(ocess)-.198 E F1(pid options)4.583 E F2 240.109(\)p)C -.198(ro)462.244 416.7 S +(cedur).198 E(e)-.198 E F1(unix-wait)72 435.3 Q F0(and)3.274 E F1(unix-wait-pr) +3.274 E(ocess)-.495 E F0 .524(are based on the UNIX)3.274 F F1(wait\(\))3.274 E +F0 -.11(fa)3.274 G .524(mily of system calls and library).11 F 2.75 +(functions. Both)72 450.3 R(procedures return a)2.75 E F1(wait-r)2.75 E(ecor) +-.407 E(d)-.407 E F0(with the follo)2.75 E(wing \214elds:)-.275 E 458.694 +470.05 72 470.05 DL F2 62.728(Field T)98.581 482.3 R 119.504(ype Contents)-.814 +F 458.694 487.05 72 487.05 DL/F3 11/Courier@0 SF(pid)77.5 499.3 Q F2 59.576 +(integer pr)160 499.3 R(ocess-ID of the terminated child pr)-.198 E(ocess)-.198 +E 458.694 504.05 72 504.05 DL F3(status)77.5 516.3 Q F2 58.949(symbol r)160 +516.3 R(eason f)-.198 E(or pr)-.275 E(ocess termination)-.198 E 458.694 521.05 +72 521.05 DL F3(code)77.5 533.3 Q F2 59.576(integer exit)160 533.3 R +(code or termination status \(signal\))2.75 E 458.694 538.05 72 538.05 DL F3 +(core-dump?)77.5 550.3 Q F2 55.891(boolean #t)160 550.3 R(if a cor)2.75 E +(e-dump was pr)-.198 E(oduced)-.198 E 458.694 555.05 72 555.05 DL F3(resources) +77.5 567.3 Q F2 -.198(re)160 567.3 S(sour).198 E(ces-r)-.198 E 13.75(ecord r) +-.198 F(esour)-.198 E(ces of terminated pr)-.198 E(ocess)-.198 E 458.694 572.05 +72 572.05 DL 458.694 470.05 458.694 572.05 DL 72 470.05 72 572.05 DL 247.065 +470.05 247.065 572.05 DL 151.75 470.05 151.75 572.05 DL F0(See)72 591.9 Q F1 +(unix-pr)2.75 E(ocess-r)-.495 E(esour)-.407 E(ces)-.407 E F0(belo)2.75 E 2.75 +(wf)-.275 G(or a description of the)227.738 591.9 Q F1 -.407(re)2.75 G(sour) +.407 E(ces-r)-.407 E(ecor)-.407 E(d)-.407 E F0(type.)2.75 E(The)72 610.5 Q F1 +(wait-r)3.9 E(ecor)-.407 E(d)-.407 E F0 1.15(result holds the process-ID and t\ +ermination status of one of the terminated \(or)3.9 F .25 +(stopped\) children of the calling process.)72 625.5 R .25(The v)5.75 F .25 +(alue of the)-.275 F F1(status)3 E F0 .249(is one of the symbols)2.999 F F1 +(stopped)2.999 E F0(\(if)2.999 E 1.65(the child process has been stopped\),)72 +640.5 R F1(signaled)4.4 E F0 1.651 +(\(child process is terminated due to a signal\), or)4.4 F F1 -.22(ex)72 655.5 +S(ited).22 E F0 .455(\(child process has in)3.205 F -.22(vo)-.44 G -.11(ke).22 +G(d).11 E F1 -.22(ex)3.205 G(it\(\)).22 E F0(\).)A F1(code)5.955 E F0 .455 +(holds the e)3.205 F .455(xit code \(if)-.165 F F1(status)3.205 E F0(is)3.204 E +F1 -.22(ex)3.204 G(ited).22 E F0 .454(\), or a signal)B 1.214(number \(if)72 +670.5 R F1(status)3.964 E F0 1.214(is either)3.964 F F1(stopped)3.964 E F0(or) +3.964 E F1(signaled)3.964 E F0 3.964(\). The)B F1 -.407(re)3.964 G(sour).407 E +(ces)-.407 E F0 1.215(\214eld holds the user and system)3.964 F .306(time cons\ +umed by the child process and its children in nanoseconds \(additional resourc\ +es may be)72 685.5 R 1.207(supplied in future v)72 700.5 R 3.957 +(ersions\). The)-.165 F 1.208(\214elds of the)3.958 F F1 -.407(re)3.958 G(sour) +.407 E(ces)-.407 E F0 1.208(record are #f on platforms that do not)3.958 F +(support the)72 715.5 Q F1(wait3\(\))2.75 E F0(or)2.75 E F1(wait4\(\))2.75 E F0 +(system call.)2.75 E EP +%%Page: 13 13 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(3-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Italic@0 SF(unix-wait-pr)72 87 Q(ocess)-.495 E F0(allo) +3.741 E .991(ws to collect the termination status of an indi)-.275 F .99 +(vidual process or a group of)-.275 F 1.791(processes speci\214ed by the inte) +72 102 R(ger)-.165 E F1(pid)4.541 E F0(ar)4.541 E 4.541(gument. This)-.198 F +1.791(procedure is only de\214ned on platforms)4.541 F .312(where the)72 117 R +F1(waitpid\(\))3.062 E F0(or)3.062 E F1(wait4\(\))3.062 E F0 .312 +(system call is a)3.062 F -.275(va)-.22 G 3.062(ilable. In).275 F .311 +(this case, the feature)3.062 F F1(unix:wait-pr)3.061 E(ocess)-.495 E F0 +(is pro)72 132 Q(vided when the UNIX e)-.165 E(xtension is loaded.)-.165 E .103 +(If no child process is a)72 150.6 R -.275(va)-.22 G .103(ilable \(or).275 F +2.853(,i)-.44 G 2.853(nc)230.032 150.6 S .103(ase of)243.269 150.6 R F1 +(unix-wait-pr)2.853 E(ocess)-.495 E F0 2.853(,n)C 2.854(op)361.619 150.6 S .104 +(rocess as speci\214ed by the)375.473 150.6 R F1(pid)2.854 E F0(ar)72 165.6 Q +(gument\), the)-.198 E F1(pid)2.75 E F0 +(\214eld in the result is set to -1, and the)2.75 E F1(status)2.75 E F0 +(\214eld is set to the symbol)2.75 E F1(none)2.75 E F0(.)A(The)72 184.2 Q F1 +(options)3.813 E F0(ar)3.813 E 1.063 +(gument, if present, is a list of one or more of the symbols)-.198 F F1(nohang) +3.813 E F0(and)3.813 E F1(untr)3.812 E(aced)-.165 E F0(.)A +(Options are only supported if the feature)72 199.2 Q F1(unix:wait-options)2.75 +E F0(is pro)2.75 E(vided.)-.165 E/F2 11/Times-Bold@0 SF(\(unix-pr)72 229.2 Q +(ocess-r)-.198 E(esour)-.198 E -.917(ces \))-.198 F(pr)456.128 229.2 Q(ocedur) +-.198 E(e)-.198 E F0 .316(This procedure is based on the UNIX)72 247.8 R F1 +(times\(\))3.066 E F0 .316(library function.)3.066 F F1(unix-pr)5.816 E +(ocess-r)-.495 E(esour)-.407 E(ces)-.407 E F0 .316(returns the)3.066 F 1.058(r\ +esource usage of the calling process and its terminated children as a pair of) +72 262.8 R F1 -.407(re)3.808 G(sour).407 E(ces-r)-.407 E(ecor)-.407 E(ds)-.407 +E F0(.)A(Each)72 277.8 Q F1 -.407(re)2.75 G(sour).407 E(ces-r)-.407 E(ecor) +-.407 E(d)-.407 E F0(has the follo)2.75 E(wing \214elds:)-.275 E 350.839 297.55 +72 297.55 DL F2 43.115(Field T)101.881 309.8 R 62.276(ype Contents)-.814 F +350.839 314.55 72 314.55 DL/F3 11/Courier@0 SF(user-time)77.5 326.8 Q F2 13.75 +(integer user)166.6 326.8 R(time in nanoseconds)2.75 E 350.839 331.55 72 331.55 +DL F3(system-time)77.5 343.8 Q F2 13.75(integer system)166.6 343.8 R +(time in nanoseconds)2.75 E 350.839 348.55 72 348.55 DL 350.839 297.55 350.839 +348.55 DL 72 297.55 72 348.55 DL 207.839 297.55 207.839 348.55 DL 158.35 297.55 +158.35 348.55 DL F0(Addition \214elds may be supplied in future v)72 368.4 Q +(ersions.)-.165 E F2(\(unix-en)72 398.4 Q(vir)-.44 E -.917(on \))-.198 F(pr) +456.128 398.4 Q(ocedur)-.198 E(e)-.198 E F1(unix-en)72 417 Q(vir)-.44 E(on) +-.495 E F0 .622(returns the program')3.372 F 3.372(se)-.605 G -.44(nv)234.241 +417 S .623(ironment as a list of pairs.).44 F .623 +(The car of each element is the)6.123 F(name of an en)72 432 Q(vironment v)-.44 +E(ariable \(a string\), the cdr is the v)-.275 E(alue of that v)-.275 E +(ariable \(a string\).)-.275 E F2(\(unix-geten)72 462 Q(v)-.44 E F1(string) +4.583 E F2 291.985(\)p)C -.198(ro)462.244 462 S(cedur).198 E(e)-.198 E F0 .655 +(This procedure returns the v)72 480.6 R .655(alue of the en)-.275 F .655 +(vironment v)-.44 F .655(ariable with the name)-.275 F F1(string)3.405 E F0 +.655(as a string, or)3.405 F(#f if the speci\214ed v)72 495.6 Q +(ariable is not de\214ned.)-.275 E F2(\(unix-w)72 525.6 Q(orking-dir)-.11 E +-.917(ectory \))-.198 F(pr)456.128 525.6 Q(ocedur)-.198 E(e)-.198 E F1 +(unix-working-dir)72 544.2 Q(ectory)-.407 E F0 1.076 +(returns the calling program')3.826 F 3.827(sc)-.605 G 1.077(urrent w)316.797 +544.2 R 1.077(orking directory as a string.)-.11 F(The)6.577 E .189 +(procedure is based on the)72 559.2 R F1 -.11(ge)2.939 G(tcwd\(\)).11 E F0(or) +2.939 E F1 -.11(ge)2.939 G(twd\(\)).11 E F0 .189(function if an)2.939 F 2.939 +(yo)-.165 G 2.939(ft)350.773 559.2 S .189(hese is a)360.433 559.2 R -.275(va) +-.22 G .188(ilable and in).275 F -.22(vo)-.44 G -.11(ke).22 G 2.938(st).11 G +(he)493.616 559.2 Q -.814(``)72 574.2 S(pwd').814 E 2.75('c)-.814 G +(ommand otherwise.)111.6 574.2 Q F2 -.917(\(unix-getlogin \))72 604.2 R(pr) +456.128 604.2 Q(ocedur)-.198 E(e)-.198 E F1(unix-g)72 622.8 Q(etlo)-.11 E(gin) +-.11 E F0 1.167(returns the login name as a string \(obtained by the UNIX)3.917 +F F1 -.11(ge)3.918 G(tlo).11 E(gin\(\))-.11 E F0 1.168(library func-)3.918 F +(tion\).)72 637.8 Q F2 -.917(\(unix-getuids \))72 667.8 R(pr)456.128 667.8 Q +(ocedur)-.198 E(e)-.198 E -.917(\(unix-getgids \))72 682.8 R(pr)456.128 682.8 Q +(ocedur)-.198 E(e)-.198 E F1(unix-g)72 701.4 Q(etuids)-.11 E F0(\()3.727 E F1 +(unix-g)A(etgids)-.11 E F0 3.727(\)r)C .977(eturns the calling program')198.991 +701.4 R 3.726(sr)-.605 G .976(eal and ef)332.434 701.4 R(fecti)-.275 E 1.306 +-.165(ve u)-.275 H(ser).165 E .976(-IDs \(group-IDs\))-.22 F(as a pair of inte) +72 716.4 Q(gers.)-.165 E EP +%%Page: 14 14 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(4-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF -.917(\(unix-getpids \))72 87 R(pr)456.128 87 +Q(ocedur)-.198 E(e)-.198 E/F2 11/Times-Italic@0 SF(unix-g)72 105.6 Q(etpids) +-.11 E F0 .887(returns the process-ID of the calling process and the parent pr\ +ocess-ID as a pair of)3.637 F(inte)72 120.6 Q(gers.)-.165 E F1(\(unix-getgr)72 +150.6 Q -.917(oups \))-.198 F(pr)456.128 150.6 Q(ocedur)-.198 E(e)-.198 E F2 +(unix-g)72 169.2 Q(etgr)-.11 E(oups)-.495 E F0 +(returns the current supplementary group-IDs of the process as a list of inte) +2.75 E(gers.)-.165 E(Example:)72 187.8 Q/F3 10/Courier@0 SF +(;;; Get list of names of supplementary group-IDs)100.346 210.303 Q +(\(define \(get-group-names\))100.346 229.903 Q(\(map)112.346 243.903 Q +(\(lambda \(gid\))124.346 257.903 Q(\(group-name \(unix-get-group gid\)\)\)) +136.346 271.903 Q(\(unix-getgroups\)\)\))124.346 285.903 Q F1(\(unix-umask)72 +322.903 Q F2(mask)4.583 E F1 293.987(\)p)C -.198(ro)462.244 322.903 S(cedur) +.198 E(e)-.198 E F0 .519(The UNIX)72 341.503 R F2(umask\(\))3.269 E F0 .519 +(system call.)3.269 F F2(mask)6.019 E F0 .519(is an inte)3.269 F(ger)-.165 E +6.019(.T)-.605 G .519(he procedure returns the pre)315.712 341.503 R .519 +(vious v)-.275 F .519(alue of)-.275 F(the umask.)72 356.503 Q F1(\(unix-nice)72 +386.503 Q F2(incr)4.583 E F1 311.103(\)p)C -.198(ro)462.244 386.503 S(cedur) +.198 E(e)-.198 E F0 1.079(The UNIX)72 405.103 R F2(nice\(\))3.829 E F0 +(function.)3.829 E F2(incr)6.579 E F0 1.079(is an inte)3.829 F(ger)-.165 E(.) +-.605 E F2(unix-nice)6.579 E F0 1.079(returns the ne)3.829 F 3.829(wn)-.275 G +1.079(ice v)409.547 405.103 R 1.08(alue \(or zero on)-.275 F(some platforms\).) +72 420.103 Q F1(\(unix-sleep)72 450.103 Q F2(seconds)4.583 E F1 289.719(\)p)C +-.198(ro)462.244 450.103 S(cedur).198 E(e)-.198 E F0 .213(The UNIX)72 468.703 R +F2(sleep\(\))2.963 E F0(function.)2.963 E F2(seconds)5.713 E F0 .213 +(is a positi)2.963 F .543 -.165(ve i)-.275 H(nte).165 E(ger)-.165 E 5.713(.T) +-.605 G .213(he procedure returns the non-printing)338.797 468.703 R(object.)72 +483.703 Q F1 2.75(12. Obtaining)72 513.703 R(System Inf)2.75 E(ormation)-.275 E +(\(unix-system-inf)72 543.703 Q 290.607 1.833(o\) p)-.275 H -.198(ro)-1.833 G +(cedur).198 E(e)-.198 E F0(This procedure returns a)72 562.303 Q F2(system-r) +2.75 E(ecor)-.407 E(d)-.407 E F0(with these \214elds:)2.75 E 356.295 582.053 72 +582.053 DL F1 30.47(Field T)91.981 594.303 R 74.905(ype Contents)-.814 F +356.295 599.053 72 599.053 DL/F4 11/Courier@0 SF(hostname)77.5 611.303 Q F1 +13.75(string the)146.8 611.303 R(system')2.75 E 2.75(sh)-.407 G(ostname)256.382 +611.303 Q 356.295 616.053 72 616.053 DL F4(sysname)77.5 628.303 Q F1 13.75 +(string type)146.8 628.303 R(of hard)2.75 E(war)-.165 E 2.75(ep)-.198 G(latf) +279.955 628.303 Q(orm)-.275 E 356.295 633.053 72 633.053 DL F4(osname)77.5 +645.303 Q F1 13.75(string operating)146.8 645.303 R(system type and v)2.75 E +(ersion)-.11 E 356.295 650.053 72 650.053 DL 356.295 582.053 356.295 650.053 DL +72 582.053 72 650.053 DL 182.55 582.053 182.55 650.053 DL 138.55 582.053 138.55 +650.053 DL F0 .069(The hostname is determined by a call to the UNIX)72 669.903 +R F2 -.11(ge)2.82 G(thostname\(\)).11 E F0(or)2.82 E F2(uname\(\))2.82 E F0 .07 +(function; the system)2.82 F .841(name and OS name are obtained from the con\ +\214guration \214le that has been used to con\214gure and)72 684.903 R +(install Elk.)72 699.903 Q EP +%%Page: 15 15 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(5-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(unix-\214le-limit)72 87 Q/F2 11 +/Times-Italic@0 SF(limit \214le)4.583 E F1 271.679(\)p)C -.198(ro)462.244 87 S +(cedur).198 E(e)-.198 E F2(unix-\214le-limit)72 105.6 Q F0 .671 +(can be used to query v)3.421 F .672 +(arious system limits and options associated with \214les.)-.275 F F2(limit) +6.172 E F0(is a symbol identifying the type of limit;)72 120.6 Q F2(\214le)2.75 +E F0(is a \214lename or \214le descriptor)2.75 E(.)-.605 E(At least the follo) +72 139.2 Q(wing limits and options can be queried:)-.275 E 392.925 158.95 72 +158.95 DL F1 108.509(Limit/Option Meaning)77.5 171.2 R 392.925 175.95 72 175.95 +DL 392.925 177.95 72 177.95 DL/F3 11/Courier@0 SF(max-links)77.5 190.2 Q F1 +(maximum number of links to a \214le or dir)156.348 190.2 Q(ectory)-.198 E +392.925 194.95 72 194.95 DL F3(max-name)77.5 207.2 Q F1 +(maximum length of a \214lename)156.348 207.2 Q 392.925 211.95 72 211.95 DL F3 +(max-path)77.5 224.2 Q F1(maximum length of a pathname)156.348 224.2 Q 392.925 +228.95 72 228.95 DL F3(pipe-buf)77.5 241.2 Q F1(pipe b)156.348 241.2 Q +(uffer size)-.22 E 392.925 245.95 72 245.95 DL F3(no-trunc)77.5 258.2 Q F1 +(\214lename exceeding maximum length causes err)156.348 258.2 Q(or)-.198 E +(instead of being silently truncated)156.348 273.2 Q 392.925 277.95 72 277.95 +DL 392.925 158.95 392.925 277.95 DL 72 158.95 72 277.95 DL 148.098 158.95 +148.098 277.95 DL F0 .384(Additional limits may be present on some platforms.) +72 297.8 R .383(The list of limits actually supported by this)5.883 F +(procedure can be obtained by a call to)72 312.8 Q F2(unix-list-\214le-limits) +2.75 E F0(\(see belo)2.75 E(w\).)-.275 E 1.506(If present, the POSIX)72 331.4 R +F2(pathconf\(\))4.256 E F0(/)A F2(fpathconf\(\))A F0 1.506 +(function is used to query a limit; in this case the)4.256 F 1.324 +(speci\214ed \214lename or \214le descriptor is supplied as an ar)72 346.4 R +1.324(gument to)-.198 F F2(pathconf\(\))4.073 E F0(or)4.073 E F2(fpathconf\(\)) +4.073 E F0 6.823(.I)C(f)500.337 346.4 Q F2(pathconf\(\))72 361.4 Q F0 .061 +(is not a)2.81 F -.275(va)-.22 G .061(ilable, or if calling it is not appropri\ +ate for the type of limit, a static \(compile-).275 F(time\) v)72 376.4 Q +(alue is returned.)-.275 E .234(The result type of)72 395 R F2 +(unix-\214le-limit)2.984 E F0 .234 +(depends on the type of the speci\214ed limit \(boolean in case of)2.984 F F2 +(no-)2.984 E(trunc)72 410 Q F0 2.75(,i)C(nte)103.779 410 Q(ger otherwise\).) +-.165 E F1 -.917(\(unix-list-\214le-limits \))72 440 R(pr)456.128 440 Q(ocedur) +-.198 E(e)-.198 E F0 .032 +(This procedure returns the list of limit symbols that can be supplied as ar)72 +458.6 R .032(guments to)-.198 F F2(unix-\214le-limit)2.783 E F0(\(see abo)72 +473.6 Q -.165(ve)-.165 G(\).).165 E F1(\(unix-job-contr)72 503.6 Q -.917 +(ol? \))-.198 F(pr)456.128 503.6 Q(ocedur)-.198 E(e)-.198 E F0 .569 +(This predicate returns #t if UNIX job control is a)72 522.2 R -.275(va)-.22 G +.569(ilable on the local system, #f otherwise.).275 F .569(In a)6.069 F +(POSIX en)72 537.2 Q(vironment, this procedure may call)-.44 E F2(sysconf\(\)) +2.75 E F0(.)A F1 2.75(13. Date)72 567.2 R(and T)2.75 E(ime)-.198 E -.917 +(\(unix-time \))72 597.2 R(pr)456.128 597.2 Q(ocedur)-.198 E(e)-.198 E F0 6.363 +(The UNIX)72 615.8 R F2(time\(\))9.113 E F0(function.)9.113 E F2(unix-time) +221.478 615.8 Q F0 6.364(returns the number of seconds elapsed since)9.114 F +(midnight UTC, January 1, 1970 \()72 630.8 Q F2(The Epoc)A(h)-.165 E F0 2.75 +(\)a)C 2.75(sa)276.842 630.8 S 2.75(ni)288.755 630.8 S(nte)300.063 630.8 Q(ger) +-.165 E(.)-.605 E F1 -.917(\(unix-nanotime \))72 660.8 R(pr)456.128 660.8 Q +(ocedur)-.198 E(e)-.198 E F0 .626(This procedure returns the number of nanosec\ +onds elapsed since The Epoch as an inte)72 679.4 R(ger)-.165 E(.)-.605 E F2 +(unix-)6.126 E(nanotime)72 694.4 Q F0(in)2.759 E -.22(vo)-.44 G -.11(ke).22 G +2.76(so).11 G .01(ne of the UNIX functions)157.412 694.4 R F2 -.11(ge)2.76 G +(ttimeofday\(\)).11 E F0(,)A F2(ftime\(\))2.76 E F0(,)A F2(time\(\))2.76 E F0 +.01(\(in that order)2.76 F 2.76(,d)-.44 G(epend-)474.069 694.4 Q +(ing on which of these function is a)72 709.4 Q -.275(va)-.22 G +(ilable\), thus pro).275 E(viding up to microsecond resolution.)-.165 E EP +%%Page: 16 16 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(6-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(unix-decode-localtime)72 87 Q/F2 11 +/Times-Italic@0 SF(time)4.583 E F1 250.009(\)p)C -.198(ro)462.244 87 S(cedur) +.198 E(e)-.198 E(\(unix-decode-utc)72 102 Q F2(time)4.583 E F1 278.114(\)p)C +-.198(ro)462.244 102 S(cedur).198 E(e)-.198 E F0 .43(Both procedures con)72 +120.6 R -.165(ve)-.44 G .43 +(rt the speci\214ed time \(a number of seconds as returned by).165 F F2 +(unix-time)3.179 E F0 3.179(\)i)C .429(nto a)481.879 120.6 R F2(time-r)72 135.6 +Q(ecor)-.407 E(d)-.407 E F0(;)A F2(unix-decode-localtime)3.91 E F0 1.161 +(corrects for the local time zone and DST adjustment \(based)3.91 F +(on the UNIX)72 150.6 Q F2(localtime\(\))2.75 E F0(and)2.75 E F2(gmtime\(\)) +2.75 E F0(functions\).)2.75 E(A)72 169.2 Q F2(time-r)2.75 E(ecor)-.407 E(d) +-.407 E F0(has the follo)2.75 E(wing \214elds:)-.275 E 307.62 188.95 72 188.95 +DL F1 46.415(Field T)105.181 201.2 R 43.477(ype Range)-.814 F 307.62 205.95 72 +205.95 DL 307.62 207.95 72 207.95 DL/F3 11/Courier@0 SF(seconds)77.5 220.2 Q F1 +13.75(integer 0..61)173.2 220.2 R 307.62 224.95 72 224.95 DL F3(minutes)77.5 +237.2 Q F1 13.75(integer 0..59)173.2 237.2 R 307.62 241.95 72 241.95 DL F3 +(hours)77.5 254.2 Q F1 13.75(integer 0..23)173.2 254.2 R 307.62 258.95 72 +258.95 DL F3(day-of-month)77.5 271.2 Q F1 13.75(integer 1..31)173.2 271.2 R +307.62 275.95 72 275.95 DL F3(month)77.5 288.2 Q F1 13.75(integer 0..11)173.2 +288.2 R 307.62 292.95 72 292.95 DL F3(year)77.5 305.2 Q F1 13.75(integer \(y) +173.2 305.2 R(ear - 1900\))-.11 E 307.62 309.95 72 309.95 DL F3(weekday)77.5 +322.2 Q F1 13.75(integer 0..6)173.2 322.2 R 307.62 326.95 72 326.95 DL F3 +(day-of-year)77.5 339.2 Q F1 13.75(integer 0..365)173.2 339.2 R 307.62 343.95 +72 343.95 DL F3(dst)77.5 356.2 Q F1 13.75(integer 1)173.2 356.2 R +(if DST in effect)2.75 E 307.62 360.95 72 360.95 DL 307.62 188.95 307.62 360.95 +DL 72 188.95 72 360.95 DL 214.439 188.95 214.439 360.95 DL 164.95 188.95 164.95 +360.95 DL F0(Example:)72 380.8 Q/F4 10/Courier@0 SF +(;;; Return date as a string of the form "Nov 3, 1993")100.346 403.303 Q +(\(define \(date-string\))100.346 422.903 Q +(\(let* \(\(months "JanFebMarAprMayJunJulAugSepOctNovDec"\))112.346 436.903 Q +(\(time \(unix-decode-localtime \(unix-time\)\)\))154.346 450.903 Q +(\(month-inx \(* 3 \(time-month time\)\)\)\))154.346 464.903 Q +(\(format #f "~a ~a, ~a")124.346 484.503 Q +(\(substring months month-inx \(+ 3 month-inx\)\))172.346 498.503 Q +(\(time-day-of-month time\) \(+ 1900 \(time-year time\)\)\)\)\))172.346 512.503 +Q F1(\(unix-time->string)72 549.503 Q F2(time)4.583 E F1 270.623(\)p)C -.198 +(ro)462.244 549.503 S(cedur).198 E(e)-.198 E F0 .917(This procedure con)72 +568.103 R -.165(ve)-.44 G .917 +(rts the speci\214ed time into a string; it is based on the).165 F F2 +(ctime\(\))3.667 E F0(and)3.667 E F2(asctime\(\))3.666 E F0(UNIX functions.)72 +583.103 Q F2(time)5.5 E F0(is either an inte)2.75 E +(ger \(number of seconds\) or a)-.165 E F2(time-r)2.75 E(ecor)-.407 E(d)-.407 E +F0(.)A F1 2.75(14. Signals)72 613.103 R F0 .329 +(The procedures described in this section \(e)97 631.703 R(xcept)-.165 E F2 +(unix-kill)3.079 E F0(,)A F2(unix-list-signals)3.079 E F0 3.079(,a)C(nd)437.99 +631.703 Q F2(unix-pause)3.079 E F0(\))A .195(are only de\214ned if the local s\ +ystem supports reliable signals \(either BSD-style or POSIX signals\).)72 +646.703 R(In this case, the feature)72 661.703 Q F2(unix:r)2.75 E +(eliable-signals)-.407 E F0(is pro)2.75 E(vided when the UNIX e)-.165 E +(xtension is loaded.)-.165 E EP +%%Page: 17 17 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(7-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(unix-kill)72 87 Q/F2 11/Times-Italic@0 SF +(pid signal)4.583 E F1 288.773(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 +E F0 .13(The UNIX)72 105.6 R F2(kill\(\))2.88 E F0 .13(system call.)2.88 F F2 +(pid)5.63 E F0 .131(is an inte)2.88 F(ger;)-.165 E F2(sig)2.881 E F0 .131 +(is either an inte)2.881 F .131(ger \(a signal number\) or a sym-)-.165 F +(bol \(a signal name\).)72 120.6 Q(At least the follo)5.5 E +(wing signal names are supported:)-.275 E 254.6 140.35 72 140.35 DL F1 +(Signal names)132.28 152.6 Q 254.6 157.35 72 157.35 DL/F3 11/Courier@0 SF 9.9 +(sigalrm sigbus)77.5 169.6 R(sigfpe)202.9 169.6 Q 16.5(sighup sigill sigint) +77.5 184.6 R 9.9(sigkill sigpipe sigquit)77.5 199.6 R 9.9(sigsegv sigterm)77.5 +214.6 R 254.6 219.35 72 219.35 DL 254.6 140.35 254.6 219.35 DL 72 140.35 72 +219.35 DL F0 .764(The list of signal names actually supported by the local sys\ +tem can be obtained by calling)72 239.2 R F2(unix-)3.513 E(list-signals)72 +254.2 Q F0(\(see belo)2.75 E(w\).)-.275 E F2(unix-kill)72 272.8 Q F0 +(returns the non-printing object.)2.75 E F1 -.917(\(unix-list-signals \))72 +302.8 R(pr)456.128 302.8 Q(ocedur)-.198 E(e)-.198 E F0(This procedure returns \ +a list of signal names \(symbols\) that are supported by the system.)72 321.4 Q +F1(\(alarm)72 351.4 Q F2(seconds)4.583 E F1 309.288(\)p)C -.198(ro)462.244 +351.4 S(cedur).198 E(e)-.198 E F0 .219(The UNIX)72 370 R F2(alarm\(\))2.969 E +F0(function.)2.969 E F2(seconds)5.719 E F0 .219(is a positi)2.969 F .549 -.165 +(ve i)-.275 H(nte).165 E(ger)-.165 E(.)-.605 E F2(unix-alarm)5.719 E F0 .219 +(returns the number of sec-)2.969 F(onds remaining from the pre)72 385 Q +(viously set alarm.)-.275 E F1 -.917(\(unix-pause \))72 415 R(pr)456.128 415 Q +(ocedur)-.198 E(e)-.198 E F0(The UNIX)72 433.6 Q F2(pause\(\))2.75 E F0 2.75 +(function. This)2.75 F(procedure does not return.)2.75 E F1(\(unix-signal)72 +463.6 Q F2(sig action)4.583 E F1 277.168(\)p)C -.198(ro)462.244 463.6 S(cedur) +.198 E(e)-.198 E(\(unix-signal)72 478.6 Q F2(sig)4.583 E F1 307.418(\)p)C -.198 +(ro)462.244 478.6 S(cedur).198 E(e)-.198 E F2(unix-signal)72 497.2 Q F0 1.136 +(de\214nes or queries the action to be performed when a signal is deli)3.887 F +-.165(ve)-.275 G 1.136(red to the pro-).165 F 2.995(gram. If)72 512.2 R(an) +2.995 E F2(action)2.995 E F0(ar)2.995 E .245 +(gument is speci\214ed, this action is associated with the signal)-.198 F F2 +(sig)2.995 E F0 2.995(,a)C .245(nd the pre-)455.857 512.2 R 2.106 +(vious action for this signal is returned.)72 527.2 R 2.106(If no action is gi) +7.606 F -.165(ve)-.275 G 4.856(n\().165 G 2.106(second form\),)365.694 527.2 R +F2(unix-signal)4.856 E F0(just)4.855 E +(returns the action currently associated with)72 542.2 Q F2(sig)2.75 E F0(.)A +F2(sig)72 560.8 Q F0 1.293(is the name of a signal \(see)4.043 F F2(unix-kill) +4.044 E F0 1.294(for a description\).)4.044 F 1.294(The action associated with) +6.794 F F2(sigb)4.044 E(us)-.22 E F0(,)A F2(sigfpe)72 575.8 Q F0(,)A F2(sigill) +3.817 E F0(,)A F2(sigint)3.817 E F0(,)A F2(sigkill)3.817 E F0(,)A F2(sigse) +3.817 E(gv)-.44 E F0 3.817(,a)C(nd)241.301 575.8 Q F2(sigabrt)3.817 E F0 1.067 +(\(if supported\) cannot be altered; either because)3.817 F 1.367 +(UNIX does not permit this \()72 590.8 R F2(sigkill)A F0 1.368 +(\), or because the signal can be generated as the result of an)B .433 +(internal f)72 605.8 R .433(atal error \()-.11 F F2(sigb)A(us)-.22 E F0 .432 +(etc.\), or because it is used by the interpreter internally \()3.183 F F2 +(sigse)A(gv)-.44 E F0 .432(is used)3.182 F .137(by the incremental g)72 620.8 R +.137(arbage collector\).)-.055 F .137(The action associated with the)5.637 F F2 +(interrupt)2.887 E F0 .138(signal can be con-)2.888 F .097 +(trolled by rede\214ning the standard Elk)72 635.8 R F2(interrupt-handler)2.846 +E F0 .096(\(see the Elk reference manual for details\).)2.846 F F2(action)72 +654.4 Q F0(can be one of the follo)2.75 E(wing:)-.275 E(the symbol)97 673 Q F2 +(ignor)2.75 E(e)-.407 E F0(the speci\214ed signal is ignored)122 688 Q +(the symbol)97 706.6 Q F2(default)2.75 E F0(the def)122 721.6 Q +(ault action for this signal is established)-.11 E EP +%%Page: 18 18 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(8-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(the symbol)97 87 Q/F1 11/Times-Italic@0 SF -.22(ex)2.75 G(it).22 E +F0 3.243(cleanup and e)122 102 R 3.243(xit: if the signal is deli)-.165 F -.165 +(ve)-.275 G 3.244(red, the interpreter').165 F 5.994(st)-.605 G 3.244 +(emporary \214les are)418.092 102 R(remo)122 117 Q -.165(ve)-.165 G .972(d, th\ +e \214nalization functions and static C++ destructors of dynamically loaded) +.165 F -.165(ex)122 132 S(tensions are in).165 E -.22(vo)-.44 G -.11(ke).22 G +(d, and).11 E F1 -.22(ex)2.75 G(it\(\)).22 E F0(is called with an e)2.75 E +(xit code of 1)-.165 E 2.75(ac)97 150.6 S(ompound procedure)109.518 150.6 Q +(the procedure \(signal handler\) is in)122 165.6 Q -.22(vo)-.44 G -.11(ke).22 +G 2.75(do).11 G 2.75(nd)310.023 165.6 S(eli)323.773 165.6 Q -.165(ve)-.275 G +(ry of the speci\214ed signal.).165 E .199 +(The procedure speci\214ed as a signal handler must accept one or more ar)72 +187.8 R 2.95(guments. When)-.198 F .2(the signal)2.95 F 1.235(is deli)72 202.8 +R -.165(ve)-.275 G 1.235(red, the procedure is in).165 F -.22(vo)-.44 G -.11 +(ke).22 G 3.985(dw).11 G 1.235(ith the signal name \(a symbol\) as an ar) +253.859 202.8 R 3.984(gument. Signal)-.198 F 1.434 +(handlers must not return \(i.)72 217.8 R 1.434(e. the)1.833 F 4.184(ym)-.165 G +1.434(ust either e)242.366 217.8 R 1.434(xit or call a continuation\).)-.165 F +1.435(If a signal handler)6.934 F(returns, a message is displayed and the)72 +232.8 Q F1 -.407(re)2.75 G(set).407 E F0(primiti)2.75 E .33 -.165(ve i)-.275 H +2.75(sc).165 G(alled.)326.87 232.8 Q 1.156(The signal speci\214ed as an ar)72 +251.4 R 1.156(gument to)-.198 F F1(unix-signal)3.906 E F0 1.155 +(is added to \(remo)3.906 F -.165(ve)-.165 G 3.905(df).165 G 1.155 +(rom\) the signal mask)407.959 251.4 R 1.006(maintained by the interpreter)72 +266.4 R 3.756(,i)-.44 G 1.833(.e)211.533 266.4 S 3.756(.c)-1.833 G 1.006 +(alls to the)232.39 266.4 R F1(disable-interrupts)3.756 E F0(primiti)3.756 E +1.336 -.165(ve b)-.275 H 1.007(lock the signal from).165 F(deli)72 281.4 Q +-.165(ve)-.275 G(ry).165 E(.)-.715 E F1(unix-signal)72 300 Q F0 1.184 +(returns the pre)3.934 F 1.183 +(vious \(current\) action for the speci\214ed signal \(a procedure or)-.275 F +F1(ignor)3.933 E(e)-.407 E F0(,)A F1(default)72 315 Q F0 2.882(,o)C(r)113.69 +315 Q F1 -.22(ex)2.882 G(it).22 E F0 2.882(\)o)C 2.882(rt)147.944 315 S .132 +(he symbol)157.547 315 R F1(handler)2.882 E F0 .133 +(to indicate that the signal is handled internally by the inter)2.882 F(-)-.22 +E(preter)72 330 Q(.)-.605 E/F2 11/Times-Bold@0 SF 2.75(15. Miscellaneous)72 360 +R(Functions)2.75 E(\(unix-getpass)72 390 Q F1(string)4.583 E F2 287.871(\)p)C +-.198(ro)462.244 390 S(cedur).198 E(e)-.198 E F1(unix-g)72 408.6 Q(etpass)-.11 +E F0(displays)3.429 E F1(string)3.429 E F0 .679 +(on standard output, reads a passw)3.429 F .678(ord, and returns the passw)-.11 +F .678(ord as a)-.11 F 2.75(string. The)72 423.6 R(procedure in)2.75 E -.22(vo) +-.44 G -.11(ke).22 G 2.75(st).11 G(he UNIX)211.15 423.6 Q F1 -.11(ge)2.75 G +(tpass\(\)).11 E F0(function.)2.75 E F2 2.75(16. Err)72 453.6 R(or Functions) +-.198 E(\(unix-err)72 483.6 Q -.11(va)-.11 G(l).11 E F1 -.22(ex)4.583 G(pr).22 +E(ession)-.407 E F2 290.17(\)s)C(yntax)477.721 483.6 Q F0(Normally)72 502.2 Q +3.899(,aS)-.715 G 1.15(cheme error is signaled by the UNIX e)134.996 502.2 R +1.15(xtension whene)-.165 F -.165(ve)-.275 G 3.9(raU).165 G 1.15 +(NIX system call or)417.148 502.2 R 1.154(library function in)72 517.2 R -.22 +(vo)-.44 G -.11(ke).22 G 3.904(db).11 G 3.904(ya)189.873 517.2 S 1.484 -.165 +(ny o)204.161 517.2 T 3.904(ft).165 G 1.154(he abo)235.025 517.2 R 1.484 -.165 +(ve p)-.165 H(rimiti).165 E -.165(ve)-.275 G 3.904(sf).165 G 3.904(ails. The) +330.788 517.2 R(macro)3.904 E F1(unix-errval)3.904 E F0(allo)3.904 E 1.154 +(ws an)-.275 F .008(application to handle an error condition in a speci\214c w) +72 532.2 R .008(ay without the need to rede\214ne the standard)-.11 F +(error handler of Elk.)72 547.2 Q F1(unix-errval)72 565.8 Q F0 -.275(eva)3.555 +G .805(luates the speci\214ed e).275 F .804 +(xpression and returns the result of the e)-.165 F -.275(va)-.275 G 3.554 +(luation. If,).275 F(during)3.554 E -.275(eva)72 580.8 S 1.315 +(luation of the e).275 F 1.315(xpression, an error is signaled due to f)-.165 F +1.315(ailure of a UNIX function, the corre-)-.11 F 1.455(sponding primiti)72 +595.8 R 1.785 -.165(ve p)-.275 H 1.455(rocedure returns a unique).165 F F1(err) +4.205 E 1.454(or object)-.495 F F0 1.454(instead of performing normal error) +4.204 F(handling.)72 610.8 Q -.165(Fo)72 629.4 S 2.75(re).165 G(xample, e) +94.583 629.4 Q -.275(va)-.275 G(luating the e).275 E(xpression)-.165 E/F3 10 +/Courier@0 SF(\(unix-close 1000\))100.346 651.903 Q 6(;c)226.346 651.903 S +(lose a bad file descriptor)244.346 651.903 Q F0 -.11(wo)72 673.903 S(uld in) +.11 E -.22(vo)-.44 G .22 -.11(ke t).22 H +(he standard Scheme error handler in the normal w).11 E(ay)-.11 E 2.75(,w)-.715 +G(hereas e)380.066 673.903 Q -.275(va)-.275 G(luating).275 E F3 +(\(unix-errval \(unix-close 1000\)\))100.346 696.406 Q F0 -.11(wo)72 718.406 S +.219(uld return an error object to allo).11 F 2.97(wt)-.275 G .22 +(he application to handle the error locally)240.869 718.406 R 5.72(.N)-.715 G +.22(ote that e)436.295 718.406 R -.275(va)-.275 G(lua-).275 E +(tion of the enclosing e)72 733.406 Q +(xpression is not interrupted when an error is signaled, i.)-.165 E(e. the e) +1.833 E(xpression)-.165 E EP +%%Page: 19 19 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(9-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(unix-errval \(begin \(unix-close 1000\) 5\)\)) +100.346 94.503 Q F0 -.11(wo)72 116.503 S(uld return the inte).11 E(ger 5.)-.165 +E/F2 11/Times-Bold@0 SF(\(unix-err)72 146.503 Q(or?)-.198 E/F3 11 +/Times-Italic@0 SF(obj)4.583 E F2 303.37(\)p)C -.198(ro)462.244 146.503 S +(cedur).198 E(e)-.198 E F0 .539(This procedure returns #t if)72 165.103 R F3 +(obj)3.289 E F0 .539(is the)3.289 F F3(err)3.289 E .539(or object)-.495 F F0 +3.289(,#)C 3.289(fo)306.949 165.103 S(therwise.)319.401 165.103 Q F3(unix-err) +6.039 E(or?)-.495 E F0 .538(is typically used to)3.289 F +(check whether a primiti)72 180.103 Q .33 -.165(ve i)-.275 H -2.09 -.44(nv o) +.165 H -.11(ke).44 G 2.75(du).11 G(nder control of)231.786 180.103 Q F3 +(unix-errval)2.75 E F0(has signaled an error)2.75 E(.)-.605 E F2(\(unix-err)72 +210.103 Q -.917(no \))-.165 F(pr)456.128 210.103 Q(ocedur)-.198 E(e)-.198 E F0 +.242(Returns the UNIX)72 228.703 R F3(errno)2.992 E F0 .242 +(set by the last system call that has f)2.992 F 2.993(ailed. Error)-.11 F .243 +(codes are represented as)2.993 F .824(symbols corresponding to the names of t\ +he standard UNIX error numbers with letters con)72 243.703 R -.165(ve)-.44 G +(rted).165 E .571(to lo)72 258.703 R .571(wer case, i.)-.275 F(e.)1.833 E F3 +(enomem)6.071 E F0(,)A F3(ebadf)3.321 E F0 3.321(,e)C 3.321(tc. The)236.44 +258.703 R -.165(ex)3.321 G .572 +(act set of error codes that can be returned is plat-).165 F(form-dependent.)72 +273.703 Q 1.429(The v)72 292.303 R 1.429(alue returned by)-.275 F F3 +(unix-errno)4.178 E F0 1.428(is not reset when a UNIX system call e)4.178 F +-.165(xe)-.165 G 1.428(cutes successfully).165 F(.)-.715 E(Ho)72 307.303 Q(we) +-.275 E -.165(ve)-.275 G 2.307 -.44(r, v).165 H 1.427(alue of).165 F F3 +(unix-errno)4.177 E F0 1.427(is also af)4.177 F 1.428 +(fected by functions from the Elk k)-.275 F 1.428(ernel \(such as)-.11 F F3 +(open-)4.178 E(input-\214le)72 322.303 Q F0 2.75(\)a)C(nd possibly other e) +123.018 322.303 Q(xtensions that mak)-.165 E 2.75(eu)-.11 G +(se of system calls.)301.79 322.303 Q F2(\(unix-perr)72 352.303 Q(or)-.198 E F3 +(string)4.583 E F2 291.138(\)p)C -.198(ro)462.244 352.303 S(cedur).198 E(e) +-.198 E F3(unix-perr)72 370.903 Q(or)-.495 E F0(writes)3.068 E F3(string)3.068 +E F0(follo)3.068 E .317 +(wed by a colon and a short message describing the last UNIX error)-.275 F .253 +(encountered to the current output port.)72 385.903 R F3(unix-perr)5.753 E(or) +-.495 E F0(mak)3.003 E .254(es use of the `)-.11 F(`~E')-.814 E 3.004('f)-.814 +G .254(ormat speci\214er of the)409.452 385.903 R(format primiti)72 400.903 Q +-.165(ve)-.275 G(.).165 E EP +%%Page: 20 20 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(0-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(17. Examples)72 87 R F0 1.397 +(This program implements a simple program interf)72 105.6 R 1.397 +(ace to the UNIX)-.11 F/F2 11/Times-Italic@0 SF(dc)4.147 E F0 1.396 +(desktop calculator com-)4.146 F 4.428(mand. The)72 120.6 R(procedure)4.428 E +F2(calc-open)4.428 E F0 1.678(starts the)4.428 F F2(dc)4.428 E F0 1.679 +(command and establishes tw)4.429 F 4.429(op)-.11 G 1.679(ipes to/from the) +430.979 120.6 R .76(child process; the procedure)72 135.6 R F2(calc)3.51 E F0 +.76(sends its ar)3.51 F .76(gument \(a)-.198 F F2(dc)3.509 E F0 -.165(ex)3.509 +G .759(pression as a string\) as input to).165 F F2(dc)3.509 E F0(;)A F2 +(calc-close)72 150.6 Q F0(closes the pipes and w)2.75 E +(aits for the subprocess to terminate.)-.11 E/F3 10/Courier@0 SF +(\(require 'unix\))100.346 173.103 Q(\(define calc-from-dc\))100.346 192.703 Q +6(;i)244.346 192.703 S(nput port: standard output of dc command)262.346 192.703 +Q(\(define calc-to-dc\))100.346 206.703 Q 6(;o)244.346 206.703 S +(utput port: standard input of dc command)262.346 206.703 Q +(\(define calc-dc-pid\))100.346 220.703 Q 6(;p)244.346 220.703 S +(rocess-ID of child process running dc)262.346 220.703 Q +(\(define calc-dc-command "/bin/dc"\))100.346 240.303 Q(\(define \(calc-open\)) +100.346 259.903 Q(\(let* \(\(from \(unix-pipe\)\))112.346 273.903 Q +(\(to \(unix-pipe\)\))154.346 287.903 Q(\(redirect-fd \(lambda \(a b\))154.346 +301.903 Q(\(unix-dup a b\) \(unix-close a\)\)\)\))244.346 315.903 Q +(\(set! calc-dc-pid \(unix-fork\)\))124.346 329.903 Q +(\(if \(zero? calc-dc-pid\))124.346 343.903 Q(\(begin)148.346 357.903 Q +(\(unix-close \(car from\)\))160.346 371.903 Q(\(unix-close \(cdr to\)\)) +160.346 385.903 Q(\(redirect-fd \(car to\) 0\))160.346 399.903 Q +(\(redirect-fd \(cdr from\) 1\))160.346 413.903 Q +(\(unix-exec calc-dc-command '\("dc"\)\)\))160.346 427.903 Q(\(begin)148.346 +441.903 Q(\(unix-close \(cdr from\)\))160.346 455.903 Q +(\(unix-close \(car to\)\))160.346 469.903 Q(\(set! calc-to-dc)160.346 483.903 +Q(\(unix-filedescriptor->port \(cdr to\))274.346 483.903 Q("w"\)\))502.346 +483.903 Q +(\(set! calc-from-dc \(unix-filedescriptor->port \(car from\) "r"\)\)\)\)\)\)) +160.346 497.903 Q(\(define \(calc expr\))100.346 517.503 Q +(\(format calc-to-dc "~a~%" expr\))112.346 531.503 Q +(\(flush-output-port calc-to-dc\))112.346 545.503 Q +(\(read-string calc-from-dc\)\))112.346 559.503 Q(\(define \(calc-close\)) +100.346 579.103 Q(\(close-output-port calc-to-dc\))112.346 593.103 Q +(\(close-input-port calc-from-dc\))112.346 607.103 Q +(\(unix-wait-process calc-dc-pid\)\))112.346 621.103 Q +(;;; Test -- print sqrt\(2\):)100.346 649.103 Q(\(calc-open\))100.346 668.703 Q +(\(display \(calc "10k 2v p"\)\) \(newline\))100.346 682.703 Q(\(calc-close\)) +100.346 696.703 Q EP +%%Page: 21 21 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(1-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL 1.126(The follo)72 87 R 1.127 +(wing procedure copies a \214le; the ar)-.275 F 1.127 +(guments are the source and tar)-.198 F 1.127(get \214le names.)-.198 F(The) +6.627 E .542(second ar)72 102 R .542(gument may name a directory)-.198 F 3.292 +(,i)-.715 G 3.292(nt)256.103 102 S .541 +(his case the \214le is copied into the directory)267.953 102 R 6.041(.T)-.715 +G .541(he tar)475.277 102 R(-)-.22 E(get \214le must not yet e)72 117 Q(xist.) +-.165 E/F1 11/Times-Italic@0 SF(copy-\214le)5.5 E F0(preserv)2.75 E +(es the access mode of the source \214le.)-.165 E/F2 10/Courier@0 SF +(\(require 'unix\))100.346 139.503 Q(\(define copy-buffer-size 8192\))100.346 +159.103 Q(\(define \(copy-file from to\))100.346 178.703 Q +(\(let \(\(from-stat \(unix-stat from\)\))112.346 192.703 Q +(\(to-stat \(unix-errval \(unix-stat to\)\)\)\))148.346 206.703 Q +(\(if \(eq? \(stat-type from-stat\) 'directory\))124.346 224.903 Q 6(;c)418.346 +224.903 S(omplain if "from")436.346 224.903 Q +(\(error 'copy-file "~s is a directory" from\)\) ;)148.346 238.903 Q +(is a directory)442.346 238.903 Q(\(if \(and \(not \(unix-error? to-stat\)\)) +124.346 257.103 Q 6(;d)418.346 257.103 S(estination exists)436.346 257.103 Q +(\(eq? \(stat-type to-stat\) 'directory\)\))178.346 271.103 Q 18(;a)418.346 +271.103 S(nd is a directory?)448.346 271.103 Q +(\(set! to \(format #f "~a/~a" to from\)\)\))148.346 285.103 Q +(\(let* \(\(to-fd \(unix-open to '\(write create exclusive\))124.346 303.303 Q +(\(stat-mode from-stat\)\)\))274.346 317.303 Q +(\(from-fd \(unix-open from '\(read\)\)\))166.346 331.303 Q +(\(buf \(make-string copy-buffer-size\)\)\))166.346 345.303 Q +(\(let loop \(\(num-chars \(unix-read-string-fill! from-fd buf\)\)\))136.346 +373.303 Q(\(if \(positive? num-chars\))166.346 387.303 Q(\(begin)190.346 +401.303 Q(\(unix-write to-fd buf num-chars\))202.346 415.303 Q +(\(loop \(unix-read-string-fill! from-fd buf\)\)\)\)\))202.346 429.303 Q +(\(unix-close from-fd\))136.346 447.503 Q(\(unix-close to-fd\)\)\)\))136.346 +461.503 Q EP +%%Page: 22 22 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(2-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Italic@0 SF(loc)72 87 Q(k-vi)-.22 E F0 .126(starts the) +2.876 F F1(vi)2.876 E F0 .126(editor with the speci\214ed \214le name.)2.876 F +.126(It pro)5.626 F .126(vides e)-.165 F(xclusi)-.165 E .456 -.165(ve a)-.275 H +.126(ccess to the \214le dur).165 F(-)-.22 E 1.026 +(ing the editing session by applying a write lock to the \214le and remo)72 102 +R 1.026(ving it when the editor \214n-)-.165 F 2.75(ishes. A)72 117 R +(message is displayed periodically if the lock is held by somebody else.)2.75 E +/F2 10/Courier@0 SF(\(require 'unix\))100.346 139.503 Q +(\(define \(lock-vi file\))100.346 159.103 Q +(\(let* \(\(fd \(unix-open file '\(read write\)\)\))112.346 173.103 Q +(\(lock \(\(record-constructor lock-record\) #t 'set 0 0\)\)\))154.346 187.103 +Q(\(let loop \(\))124.346 206.703 Q(\(if \(not \(unix-set-lock fd lock #f\)\)) +154.346 220.703 Q(\(begin)178.346 234.703 Q +(\(format #t "Someone else is editing ~s...~%" file\))190.346 248.703 Q +(\(unix-sleep 10\))190.346 262.703 Q(\(loop\)\)\)\))190.346 276.703 Q +(\(unix-system \(format #f "vi ~a" file\)\))124.346 296.303 Q +(\(unix-remove-lock fd lock\)\)\))124.346 310.303 Q F1(pipe-size)72 350.903 Q +F0 .901(attempts to determine the capacity of a pipe.)3.651 F .901 +(It creates a pipe, places the write end of)6.401 F .574(the pipe into non-blo\ +cking I/O mode and writes into the pipe until it is full, counting the charac-) +72 365.903 R(ters successfully written.)72 380.903 Q F2(\(require 'unix\)) +100.346 403.406 Q(\(define \(pipe-size\))100.346 423.006 Q +(\(let* \(\(pipe \(unix-pipe\)\))112.346 437.006 Q +(\(flags \(unix-filedescriptor-flags \(cdr pipe\)\)\))154.346 451.006 Q +(\(len 32\))154.346 465.006 Q 6(;a)322.346 465.006 S +(ssumes capacity is multiple of len)340.346 465.006 Q +(\(noise \(make-string len\)\)\))154.346 479.006 Q +(;; enable non-blocking I/O for write side of pipe:)124.346 498.606 Q +(\(unix-filedescriptor-flags \(cdr pipe\) \(cons 'ndelay flags\)\))124.346 +512.606 Q(\(unwind-protect)124.346 532.206 Q(\(let loop \(\(size 0\)\))136.346 +546.206 Q +(\(if \(unix-error? \(unix-errval \(unix-write \(cdr pipe\) noise\)\)\))166.346 +560.206 Q(\(if \(memq \(unix-errno\) '\(eagain ewouldblock\)\))190.346 574.206 +Q(size)214.346 588.206 Q(\(error 'pipe-size "~E"\)\))214.346 602.206 Q +(\(loop \(+ size 32\)\)\)\))190.346 616.206 Q(\(unix-close \(car pipe\)\)) +136.346 630.206 Q(\(unix-close \(cdr pipe\)\)\)\)\))136.346 644.206 Q EP +%%Page: 23 23 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(3-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 13/Times-Bold@0 SF(Index)272.108 123 Q(/)72 174 Q F0 +(/bin/sh, 11)72 204 Q(/tmp, 8)72 219 Q(/usr/tmp, 8)72 234 Q F1(A)72 264 Q F0 +(access, 7)72 294 Q(accessor functions, 2)72 309 Q(alarm,)72 324 Q/F2 12 +/Times-Bold@0 SF(17)2.75 E F0(asctime, 16)72 339 Q F1(B)72 369 Q F0(BSD, 16)72 +399 Q F1(C)72 429 Q F0(calc, 20)72 459 Q(calc-close, 20)72 474 Q(calc-open, 20) +72 489 Q(chdir)72 504 Q 2.75(,7)-.44 G(chmod, 7)72 519 Q(cho)72 534 Q(wn, 7) +-.275 E(close, 3)72 549 Q(close-on-e)72 564 Q -.165(xe)-.165 G(c, 4).165 E +(closedir)72 579 Q 2.75(,8)-.44 G(cop)72 594 Q(y-\214le, 21)-.11 E(ctime, 16)72 +609 Q F1(D)72 639 Q F0(dc, 20)72 669 Q(disable-interrupts, 18)72 684 Q(dup, 3) +72 699 Q(dup2, 3)302.4 174 Q F1(E)302.4 204 Q F0(editor)302.4 234 Q 2.75(,2) +-.44 G(2)338.623 234 Q(ef)302.4 249 Q(fecti)-.275 E .33 -.165(ve g)-.275 H +(roup-ID, 13).165 E(ef)302.4 264 Q(fecti)-.275 E .33 -.165(ve u)-.275 H(ser) +.165 E(-ID, 13)-.22 E(endgrent, 11)302.4 279 Q(endpwent, 11)302.4 294 Q(en) +302.4 309 Q(vironment, 12, 13)-.44 E(errno, 19)302.4 324 Q(error codes, 19) +302.4 339 Q(error handler)302.4 354 Q 2.75(,3)-.44 G 2.75(,1)370.072 354 S(8) +381.072 354 Q(error object, 3, 18)302.4 369 Q -.165(ex)302.4 384 S(amples, 20) +.165 E -.165(ex)302.4 399 S(clusi).165 E .33 -.165(ve l)-.275 H(ock, 9).165 E +-.165(exe)302.4 414 S(cv).165 E 2.75(,1)-.715 G(2)338.007 414 Q -.165(ex)302.4 +429 S(it code, 11).165 E F1(F)302.4 459 Q F0(fcntl, 4, 9)302.4 489 Q(fdopen, 6) +302.4 504 Q(features, 1)302.4 519 Q(\214le pointer)302.4 534 Q 2.75(,5)-.44 G +(\214leno, 5)302.4 549 Q(\214nalization functions, 18)302.4 564 Q(\215ock, 9) +302.4 579 Q(fork, 11)302.4 594 Q(format, 19)302.4 609 Q(fpathconf, 15)302.4 624 +Q(fstat, 6)302.4 639 Q(ftime, 15)302.4 654 Q F1(G)302.4 684 Q F0 -.055(ga)302.4 +714 S(rbage collector).055 E 2.75(,6)-.44 G(getcwd, 13)302.4 729 Q EP +%%Page: 24 24 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(4-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(getdtablesize, 5)72 87 Q(getgrent, 10)72 102 Q(getgr)72 117 Q +(gid, 10)-.198 E(getgrnam, 10)72 132 Q(gethostname, 14)72 147 Q(getlogin, 13)72 +162 Q(getpass, 18)72 177 Q(getpwent, 10)72 192 Q(getpwnam, 10)72 207 Q +(getpwuid, 10)72 222 Q(gettimeofday)72 237 Q 2.75(,1)-.715 G(5)140.332 237 Q +(getwd, 13)72 252 Q(gmtime, 16)72 267 Q(group database, 10)72 282 Q +(group-record, 2, 10)72 297 Q/F1 13/Times-Bold@0 SF(I)72 327 Q F0 +(interrupt signal, 17)72 357 Q(interrupt-handler)72 372 Q 2.75(,1)-.44 G(7) +157.096 372 Q(isatty)72 387 Q 2.75(,5)-.715 G F1(K)72 417 Q F0(kill, 17)72 447 +Q F1(L)72 477 Q F0(limits, 15)72 507 Q(link, 7)72 522 Q(localtime, 16)72 537 Q +(lock-record, 2, 9)72 552 Q(locking, 9)72 567 Q(login name, 13)72 582 Q +(lseek, 4)72 597 Q(lstat, 8)72 612 Q F1(M)72 642 Q F0(mkdir)72 672 Q 2.75(,7) +-.44 G(mktemp, 8)72 687 Q(modi\214er functions, 2)302.4 87 Q F1(N)302.4 117 Q +F0(nanotime-record, 2)302.4 147 Q(nice, 14)302.4 162 Q(non-blocking I/O, 22) +302.4 177 Q F1(O)302.4 207 Q F0(onfork handlers, 11)302.4 237 Q(open, 3)302.4 +252 Q(opendir)302.4 267 Q 2.75(,8)-.44 G F1(P)302.4 297 Q F0 +(parent process-ID, 14)302.4 327 Q(passwd database, 10)302.4 342 Q +(passwd-record, 2, 10)302.4 357 Q(passw)302.4 372 Q(ord, 18)-.11 E -1.012(PA) +302.4 387 S(TH, 12)-.209 E(pathconf, 15)302.4 402 Q(pause, 17)302.4 417 Q +(pclose, 11)302.4 432 Q(pipe, 4, 11, 20, 22)302.4 447 Q(popen, 11)302.4 462 Q +(POSIX, 1, 15, 16)302.4 477 Q(process-ID, 14)302.4 492 Q(pwd, 13)302.4 507 Q F1 +(R)302.4 537 Q F0(read, 4)302.4 567 Q(readdir)302.4 582 Q 2.75(,8)-.44 G +(readlink, 8)302.4 597 Q(real group-ID, 13)302.4 612 Q(real user)302.4 627 Q +(-ID, 13)-.22 E(record constructor)302.4 642 Q 2.75(,2)-.44 G(record e)302.4 +657 Q(xtension, 1)-.165 E(record locking, 9)302.4 672 Q(record locks, 9)302.4 +687 Q(record types, 2)302.4 702 Q(records, 2)302.4 717 Q(reliable signals, 16) +302.4 732 Q EP +%%Page: 25 25 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(5-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(rename, 7)72 87 Q(reset, 18)72 102 Q(resource usage, 13)72 117 Q +(resources-record, 2, 13)72 132 Q(rmdir)72 147 Q 2.75(,7)-.44 G/F1 13 +/Times-Bold@0 SF(S)72 177 Q F0(setgrent, 11)72 207 Q(setpwent, 11)72 222 Q +(shared lock, 9)72 237 Q(shell, 11)72 252 Q(signal handler)72 267 Q 2.75(,1) +-.44 G(8)144.578 267 Q(signal mask, 18)72 282 Q(signal name, 17)72 297 Q +(signal, 17)72 312 Q(sleep, 14)72 327 Q(stat, 6)72 342 Q(stat-record, 2, 6, 8) +72 357 Q(supplementary group-IDs, 14)72 372 Q(symbolic links, 8)72 387 Q +(symlink, 8)72 402 Q(sysconf, 5, 15)72 417 Q(system-record, 2, 14)72 432 Q F1 +(T)72 462 Q F0(tempnam, 8)72 492 Q(temporary \214le, 8)72 507 Q +(temporary \214les, 11, 18)72 522 Q(termination status, 11)72 537 Q(time, 15)72 +552 Q(time-record, 2, 16)72 567 Q(times, 13)72 582 Q(tmpnam, 8)72 597 Q +(ttyname, 5)72 612 Q(type predicate, 2)72 627 Q F1(U)72 657 Q F0(umask, 14)72 +687 Q(uname, 14)72 702 Q(unix-access?,)72 717 Q/F2 12/Times-Bold@0 SF(7)2.75 E +F0(unix-chdir)72 732 Q(,)-.44 E F2(7)2.75 E F0(unix-chmod,)302.4 87 Q F2(7)2.75 +E F0(unix-cho)302.4 102 Q(wn,)-.275 E F2(7)2.75 E F0(unix-close,)302.4 117 Q F2 +(3)2.75 E F0(unix-close-on-e)302.4 132 Q -.165(xe)-.165 G(c,).165 E F2(4)2.75 E +F0(unix-decode-localtime,)302.4 147 Q F2(16)2.75 E F0(unix-decode-utc,)302.4 +162 Q F2(16)2.75 E F0(unix-dup,)302.4 177 Q F2(3)2.75 E F0(unix-end-group,) +302.4 192 Q F2(11)2.75 E F0(unix-end-passwd,)302.4 207 Q F2(11)2.75 E F0 +(unix-en)302.4 222 Q(viron, 12,)-.44 E F2(13)2.75 E F0(unix-errno,)302.4 237 Q +F2(19)2.75 E F0(unix-error?,)302.4 252 Q F2(19)2.75 E F0(unix-errv)302.4 267 Q +(al, 3,)-.275 E F2(18)2.75 E F0(unix-e)302.4 282 Q -.165(xe)-.165 G(c,).165 E +F2(11)2.75 E F0(unix-e)302.4 297 Q -.165(xe)-.165 G(c-path,).165 E F2(11)2.75 E +F0(unix-\214le-limit,)302.4 312 Q F2(15)2.75 E F0(unix-\214ledescriptor)302.4 +327 Q(-\215ags,)-.22 E F2(4)2.75 E F0(unix-\214ledescriptor)302.4 342 Q/F3 11 +/Symbol SF(-)A F0(>port,)A F2(6)2.75 E F0(unix-fork,)302.4 357 Q F2(11)2.75 E +F0(unix-get-group,)302.4 372 Q F2(10)2.75 E F0(unix-get-passwd,)302.4 387 Q F2 +(10)2.75 E F0(unix-geten)302.4 402 Q -.715(v,)-.44 G F2(13)3.465 E F0 +(unix-getgids,)302.4 417 Q F2(13)2.75 E F0(unix-getgroups,)302.4 432 Q F2(14) +2.75 E F0(unix-getlogin,)302.4 447 Q F2(13)2.75 E F0(unix-getpass,)302.4 462 Q +F2(18)2.75 E F0(unix-getpids,)302.4 477 Q F2(14)2.75 E F0(unix-getuids,)302.4 +492 Q F2(13)2.75 E F0(unix-isatty?,)302.4 507 Q F2(5)2.75 E F0 +(unix-job-control?,)302.4 522 Q F2(15)2.75 E F0(unix-kill,)302.4 537 Q F2(17) +2.75 E F0(unix-link,)302.4 552 Q F2(7)2.75 E F0(unix-list-\214le-limits,)302.4 +567 Q F2(15)2.75 E F0(unix-list-\214ledescriptor)302.4 582 Q(-\215ags,)-.22 E +F2(5)2.75 E F0(unix-list-open-modes,)302.4 597 Q F2(4)2.75 E F0 +(unix-list-signals,)302.4 612 Q F2(17)2.75 E F0(unix-lseek,)302.4 627 Q F2(4) +2.75 E F0(unix-lstat,)302.4 642 Q F2(8)2.75 E F0(unix-mkdir)302.4 657 Q(,)-.44 +E F2(7)2.75 E F0(unix-nanotime,)302.4 672 Q F2(15)2.75 E F0(unix-nice,)302.4 +687 Q F2(14)2.75 E F0(unix-num-\214ledescriptors,)302.4 702 Q F2(5)2.75 E F0 +(unix-open,)302.4 717 Q F2(3)2.75 E F0(unix-open-input-pipe,)302.4 732 Q F2(11) +2.75 E EP +%%Page: 26 26 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(6-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(unix-open-output-pipe,)72 87 Q/F1 12/Times-Bold@0 SF(11)2.75 E F0 +(unix-pause,)72 102 Q F1(17)2.75 E F0(unix-perror)72 117 Q(,)-.44 E F1(19)2.75 +E F0(unix-pipe,)72 132 Q F1(4)2.75 E F0(unix-port-\214ledescriptor)72 147 Q(,) +-.44 E F1(5)2.75 E F0(unix-process-resources,)72 162 Q F1(13)2.75 E F0 +(unix-query-lock,)72 177 Q F1(9)2.75 E F0(unix-read-directory)72 192 Q(,)-.715 +E F1(8)2.75 E F0(unix-read-string-\214ll!,)72 207 Q F1(4)2.75 E F0 +(unix-readlink,)72 222 Q F1(8)2.75 E F0(unix-remo)72 237 Q -.165(ve)-.165 G +(-lock,).165 E F1(9)2.75 E F0(unix-rename,)72 252 Q F1(7)2.75 E F0(unix-re)72 +267 Q(wind-group,)-.275 E F1(11)2.75 E F0(unix-re)72 282 Q(wind-passwd,)-.275 E +F1(11)2.75 E F0(unix-rmdir)72 297 Q(,)-.44 E F1(7)2.75 E F0(unix-set-lock,)72 +312 Q F1(9)2.75 E F0(unix-signal,)72 327 Q F1(17)2.75 E F0(unix-sleep,)72 342 Q +F1(14)2.75 E F0(unix-stat,)72 357 Q F1(6)2.75 E F0(unix-symlink,)72 372 Q F1(8) +2.75 E F0(unix-system,)72 387 Q F1(11)2.75 E F0(unix-system-info,)72 402 Q F1 +(14)2.75 E F0(unix-tempname,)72 417 Q F1(8)2.75 E F0(unix-time,)72 432 Q F1(15) +2.75 E F0(unix-time->string,)72 447 Q F1(16)2.75 E F0(unix-ttyname,)72 462 Q F1 +(5)2.75 E F0(unix-umask,)72 477 Q F1(14)2.75 E F0(unix-unlink,)72 492 Q F1(7) +2.75 E F0(unix-utime,)72 507 Q F1(7)2.75 E F0(unix-w)72 522 Q(ait,)-.11 E F1 +(12)2.75 E F0(unix-w)72 537 Q(ait-process,)-.11 E F1(12)2.75 E F0(unix-w)72 552 +Q(orking-directory)-.11 E(,)-.715 E F1(13)2.75 E F0(unix-write,)72 567 Q F1(4) +2.75 E F0(unix:\214le-locking, 2, 9)72 582 Q(unix:record-locks, 2, 9)72 597 Q +(unix:reliable-signals, 2, 16)72 612 Q(unix:symlinks, 2, 8)72 627 Q(unix:w)72 +642 Q(ait-options, 2, 13)-.11 E(unix:w)72 657 Q(ait-process, 2, 13)-.11 E +(unlink, 7)72 672 Q(utime, 7)302.4 87 Q/F2 13/Times-Bold@0 SF(V)302.4 117 Q F0 +(vi, 22)302.4 147 Q F2(W)302.4 177 Q F0 -.11(wa)302.4 207 S(it, 12).11 E -.11 +(wa)302.4 222 S(it-record, 2, 12).11 E -.11(wa)302.4 237 S(it3, 12).11 E -.11 +(wa)302.4 252 S(it4, 12, 13).11 E -.11(wa)302.4 267 S(itpid, 13).11 E -.11(wo) +302.4 282 S(rking directory).11 E 2.75(,1)-.715 G(3)391.698 282 Q(write, 4) +302.4 297 Q EP +%%Page: 27 27 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 13/Times-Bold@0 SF -1.196(Ta)239.127 123 S(ble of Contents)1.196 E/F1 11 +/Times-Roman@0 SF .866(Introduction ..........................................\ +..............................................................................\ +......)72 177.6 R(1)498.5 177.6 Q(Using the UNIX Extension)72 196.2 Q 19.25(..\ +..............................................................................\ +...................... 1)4.54 F(Record T)72 214.8 Q .228(ypes ................\ +..............................................................................\ +..............................)-.88 F(2)498.5 214.8 Q(Error Handling)72 233.4 Q +19.25(........................................................................\ +................................................. 3)4.848 F(Con)72 252 Q -.165 +(ve)-.44 G .239(ntions .......................................................\ +.......................................................................).165 F +(3)498.5 252 Q(Lo)72 270.6 Q(w-Le)-.275 E -.165(ve)-.275 G 2.75(lI).165 G +(/O, File Descriptors)126.571 270.6 Q 19.25(..................................\ +............................................................ 3)4.353 F +(Files and Directories)72 289.2 Q 19.25(......................................\ +.......................................................................... 6) +4.848 F(Symbolic Links)72 307.8 Q 19.25(......................................\ +..............................................................................\ +.... 8)4.518 F(File and Record Locking)72 326.4 Q 19.25(......................\ +..............................................................................\ +...... 9)3.319 F(Obtaining P)72 345 Q(assw)-.165 E(ord and Group File Entries) +-.11 E 13.75(.................................................................\ +........... 10)3.594 F(Process Creation and Control)72 363.6 Q 13.75(.........\ +..............................................................................\ +............ 11)3.011 F(Obtaining System Information)72 382.2 Q 13.75(........\ +..............................................................................\ +........... 14)3.308 F(Date and T)72 400.8 Q 1.262(ime .......................\ +..............................................................................\ +.....................)-.385 F(15)493 400.8 Q .855(Signals ....................\ +..............................................................................\ +....................................)72 419.4 R(16)493 419.4 Q +(Miscellaneous Functions)72 438 Q 13.75(......................................\ +.................................................................... 18)3.308 F +(Error Functions)72 456.6 Q 13.75(............................................\ +............................................................................ 1\ +8)5.145 F .866(Examples ......................................................\ +............................................................................)72 +475.2 R(20)493 475.2 Q(Inde)72 493.8 Q 2.868(x.)-.165 G 13.75(................\ +..............................................................................\ +.......................................... 23)102.5 493.8 R EP +%%Trailer +end +%%EOF diff --git a/doc/usenix/Makefile b/doc/usenix/Makefile new file mode 100644 index 0000000..a82c7ca --- /dev/null +++ b/doc/usenix/Makefile @@ -0,0 +1,15 @@ +TROFF= groff -ms +UNROFF= unroff -ms + +usenix.ps: usenix.ms tmp.ref + sed -f tmp.ref usenix.ms | $(TROFF) 2> /dev/null > usenix.ps + +usenix.html: usenix.ms tmp.ref + sed -f tmp.ref usenix.ms | $(UNROFF) document=usenix + +tmp.ref: usenix.ms + $(TROFF) usenix.ms 2> tmp.ref >/dev/null + +clean: + rm -f tmp.ref usenix.ps + diff --git a/doc/usenix/usenix.ms b/doc/usenix/usenix.ms new file mode 100644 index 0000000..b89272f --- /dev/null +++ b/doc/usenix/usenix.ms @@ -0,0 +1,1807 @@ +.if \n(.g .do char \[a:] \[:a] +.\" \(a: is a lower case a with diaeresis (a umlaut) +.\" \(-> is an arrow pointing to the right +.\" \(mu is a multiplication sign (cross) +.\" \*- is an em dash +. +.\" .fp 1 PR +.\" .fp 2 PI +.\" .fp 3 PB +.nr VS 20 +.fp 5 C +.fp 6 CO +.ie \n(.U .ds ^4 ^4 +.el .ds ^4 \u\s-1\|4\s0\d +. \" Second level section +.de P +.NH 2 +.. +. \" Scheme code start +.de Ss +.KS +.ta 8.5c +.nr sF \\n(.f +.ft 5 +.ps -2 +.\".vs -2 +.vs 13 +.nf +.in 1c +.if !\n(.U .sp .3c +.. +. \" Scheme code end +.de Se +.in +.fi +.vs +.ps +.ft \\n(sF +.KE +.if !\n(.U .sp .5 +.. +. \" Newline in Scheme code +.de Sl +.sp .52 +.. +.nr lS 0 1 +. \" Listing start +.de Ls +.br +.KF +.sp .5 +.LP +\l'\\n(.lu_' +.. +. \" Listing caption: .Lc caption +.de Lc +.sp .2 +.ce 999 +\f3\s-1Listing \\n+(lS:\fP \c +\\$1\s0 +.if !\\$2 \s-1\&\\$2\s0 +.ce 0 +.. +. \" Listing end: .Le reference +.de Le +.tm s/@L(\\$1)/\\n(lS/g +.LP +\l'\\n(.lu_' +.sp +.KE +.. +. \" Notes start (at end of listing) +.de Ns +.sp +.ps -2 +.vs -2 +.in 1c +.ll -1c +.. +. \" Notes end +.de Ne +.ll +.in +.vs +.ps +.sp -.3 +.. +.ds E Elk +.TL +\*E: The Extension Language Kit +.AU +Oliver Laumann* and Carsten Bormann\v'-.2m'\(dg\v'.2m' +.AI +* Technische Universit\(a:t Berlin, Germany +.br +\(dg Universit\(a:t Bremen, Germany +.AB +In the past, users of an application generally were at the mercy of +its authors when it came to adapting it to their individual needs and +tastes. +Fitting an application with an \f2extension language\fP (or \f2embedded +language\fP) enables users to customize and enhance it without having to +modify its source code. +Recently, variants of Lisp have become increasingly +popular for this purpose, to the point where the abundance of different +dialects has grown into a problem. +Of the two standardized dialects of Lisp, only \f2Scheme\fP is suitably +modest, yet sufficiently general, to serve as an extension language. +.PP +\f2\*E\fP, the \f2Extension Language Kit\fP, is a Scheme implementation +that is intended to be used as a general, reusable extension language +subsystem for integration into existing and future applications. +Applications can define their own Scheme data types and primitives, +providing for a tightly-knit integration of the C/C++ parts of the application +with Scheme code. +Library interfaces, for example to the UNIX operating system +and to various X Window System libraries, show the effectiveness of +this approach. +Several features of \*E such as dynamic loading of object files and +freezing of fully customized applications into executables +(implemented for those UNIX environments where it was feasible) +increase its usability as the backbone of a complex application. +\*E has been used in this way for seven years within a +locally-developed ODA-based multimedia document editor; it has been +used in numerous other projects after it could be made freely +available five years ago. +.AE +.NH +Introduction +.PP +The designers and implementors of a large or complex application can +rarely anticipate all requirements future users will have on the +application. +Typically, users wish to be able to customize the user interfaces +of applications according to their personal tastes or requirements, +or they want to extend the functionality of an application +(either by combining existing functions into new ones or by adding +entirely new capabilities). +This is especially true for applications used routinely, such as text +editors, and for applications with a high degree +of user interaction or with complex graphical user interfaces. +.PP +Certainly any application can be customized by modifying its source +code and recompiling it. +But this approach is often not feasible, as the source code of the +application or the tools needed to recompile it may not be available. +Even if it were feasible, it would be a time-consuming process; +it would be hard to keep up with new releases of the application; +and the coexistence of multiple, similar versions of the same +application would become a general maintenance headache. +.PP +The alternative to this approach is not to ``hard-wire'' the entire +functionality and all external aspects of an application in the source +code at all, but to provide means to customize the application's +behavior later by its users. +.P +Early Customization and Extension Languages +.PP +Many applications support at least simple methods for customization, +such as command line options or configuration files. +More powerful tools for customization are \f2macro languages\fP, +\f2command languages\fP, or \f2scripting languages\fP that are +typically found in text editors and word processors. +Prominent examples of such customization and extension languages +are the macro language of the now legendary TECO editor and, +in UNIX, the macro language of the \f2troff\fP text formatter +[Ossanna 1979] and the configuration language of the \f2sendmail\fP +program. +.PP +Although many of these classic extension languages are quite +powerful (some of them are full-fledged programming languages), +they have a reputation of being ``cryptic'' and hard to understand +and use by untrained users. +The prevailing opinion seems to be that only experts can actually +benefit from these types of extension languages (for example, +people who have mastered the \f2sendmail\fP configuration language +in all details are commonly appointed the status of a ``guru''). +In fact, it can be observed that only very few users of the \f2troff\fP +text formatter (whose macro language is reputed to be particularly +cryptic) are using macro packages written by themselves; many users +give up after some time and fall back on vendor-supplied macro +packages or packages written by a ``troff guru.'' +.PP +Experience also indicates that simplified or specialized extension +languages often have more features added and grow until they resemble +a full programming language. +Such ``organically grown'' extension languages are likely to be +contorted designs as they will consist of several levels of extensions +glued on to their initial, more limited design. +.P +High-Level Extension Languages +.PP +Recently application designers have begun to abandon +specialized and cryptic macro-style extension languages in +favor of extension languages that resemble usual high-level +programming languages, mainly languages with Algol/Pascal-style +or Lisp-style syntax and semantics. +Prominent examples of such high-level extension languages are +TPU developed by DEC, the \f2Ness\fP language of the Andrew +Toolkit [Hansen 1990], AutoDesk's CAD extension language (a dialect +of Lisp), and \f2Emacs-Lisp\fP, the extension +language of Richard Stallman's popular GNU Emacs editor +[Stallman 1981, Lewis et al. 1990]. +.PP +Emacs was the first wide-spread application to employ an +already existing and widely used high-level programming +language as its extension and customization language. +Emacs-Lisp is a dynamically scoped dialect of Lisp with additional +operations for text-editing. +The approach taken by Emacs has been tremendously successful; +users of Emacs have contributed a wealth of extensions written +in Emacs-Lisp. +.PP +Note that Emacs-Lisp is not a \f2scripting language\fP. +It is tightly interwoven with the application for which it provides +extensibility. +It also is somewhat inaccessible to the casual user, +who is unlikely to have previous experience with Lisp-like languages. +This can be contrasted with languages such as Tcl [Ousterhout 1990] and +REXX [Cowlishaw 1985], whose underlying models are no less complex, +but which are +similar enough to well-known languages such as BASIC to present less of +an obstacle to casual users. +On the other hand, non-trivial extensions benefit from the structuring +functionality inherent in general purpose programming languages such as +Lisp. +.P +\*E as a General, Reusable Extension Language +.PP +Using Lisp or Lisp-style languages as extension languages +seems to enjoy growing popularity; several applications besides +Emacs now use dialects of Lisp as their extension language. +This development has one disadvantage: the number of +incompatible (but similar) extension languages is continually growing. +Users have to learn a new language for each new application, +and application writers keep implementing new extension language +interpreters instead of reusing existing ones. +.PP +These problems can be solved by a general, reusable extension language +implementation that application writers can include into their +applications, an \f2extension language kit\fP. +The main objective of the \f2\*E\fP project was to develop such an +extension language kit and to make it freely available to encourage +use by application writers. +.NH +Overview of the Extension Language Kit +.P +The Evolution of \*E +.PP +We were prompted to develop \*E when a search for a suitable extension +language implementation for ISOTEXT [Bormann et al. 1988, Bormann +1991] was fruitless. +ISOTEXT, +a document processing system with a graphical user interface, +is almost entirely written in C++; its user interface is +based on the X window system [Scheifler et al. 1986, Scheifler et al. 1992] +and the OSF/Motif widget set. +Customizability and extensibility through a full extension language +were basic requirements on the design of ISOTEXT. +.PP +As we consider language design to be the domain of a ``selected few'' +and did not want to act as amateurs in this field, we decided to use +an existing programming language as the basis for the extension +language of ISOTEXT. +This decision was also influenced by our desire to develop a +general, reusable extension language implementation that is +not hard-wired into one specific application. +For a number of reasons an interpreted language seemed preferable: +extensions can be added to (or modified in) +a running application without re-linking it; +bugs in extensions can be caught in the interpreter and +do not crash the application; +interpreted languages usually offer better debugging facilities; +and implementing an interpreter generally is easier +than implementing a compiler. +.PP +From the beginning we favored Lisp or a dialect of Lisp +as the basis for a general extension language. +Most dialects of the Lisp family are ``small'', easy to implement, +general-purpose languages with simple syntax and powerful semantics, +and the suitability of Lisp as an extension language had already been +demonstrated by several applications, among them GNU Emacs. +Early in the project we considered to use Emacs-Lisp, +but it appeared infeasible to isolate the Lisp interpreter +from the rest of Emacs. +In addition, at the time we investigated Emacs-Lisp it was lacking +several desirable language features, such as support for floating point +and arbitrary precision numbers (\f2bignums\fP). +We also considered using MIT Scheme [MIT 1984], but due to the enormous +size of its implementation it would have dominated the size of +the application. +.P +Scheme as an Extension Language +.PP +As other implementations of Lisp or Lisp-like languages available +did not meet our requirements, we +finally decided to write an interpreter for the Lisp dialect \f2Scheme\fP +[Clinger et al. 1991, Dybvig 1987, Springer et al. 1989, +Abelson et al. 1985]. +This Scheme interpreter is the main component of the \*E package. +Scheme is a simplified, ``cleaned-up'' dialect of Lisp with +first-class procedures and static scoping rules. +The Scheme language is based on only a few language features and +semantic concepts; it consists of a small core of syntactic +forms, a set of extended forms derived from them, and a number +of standard procedures (\f2primitive\fP procedures) that operate +on a comprehensive set of types of objects (among them numbers, lists, vectors, +symbols, characters, and strings). +In 1990 Scheme became an IEEE standard [IEEE\|Std\|1178-1990] +(the standard document, although only 50 pages long, +includes the formal semantics of the language). +.PP +The standardization effort has increased the acceptance of Scheme; +for instance, the Extension Language Working Group +of the CAD Framework Initiative has recently selected Scheme as the +extension language for future CAD applications [CFI 1991a, CFI 1991b]. +Among the established programming languages we consider Scheme the +ideal candidate for a general extension language \*- +it is standardized; its semantics are +well-defined; it has a simple syntax and is easy to implement; and it +is sufficiently small to not dwarf the application it makes extensible. +.P +Extending the Extension Language +.PP +The implementation of an extension language must itself be +extensible. +Extension language code that manipulates objects or state of the +application requires adding application-specific primitive procedures +to the base extension language. +To allow \*E programs to be expressive in the context of a given +application, application writers are encouraged (and expected) to +extend standard Scheme by a rich set of application-specific data types +and Scheme primitives to operate on objects of these types. +In fact, easy extensibility of the language has been the primary +design consideration in the development of \*E (as opposed to +performance or number of language features). +Adding new types and primitives to \*E is an inexpensive operation; +it is not uncommon for an application to define hundreds +of application-specific Scheme primitives. +.\" +.\" implementation must fit well to `host language' (schreibt cabo...) +.PP +All primitive procedures of \*E are implemented as C or C++ functions. +This is true for both built-in primitives (such as \f2car\fP and \f2cdr\fP) +and primitives defined by extensions. +From the Scheme programmers' point of view, primitives and types from the +base set of the language are indistinguishable from application-specific +primitives and types. +Extensions ``register'' new primitives with the interpreter +by supplying the name of the primitive along with a pointer +to the function implementing the primitive and +information about the arguments and calling style. +New types are defined in a similar way. +Registration of new primitives and types usually takes place on startup +of the interpreter or when a compiled extension is loaded +into the running interpreter. +.PP +Another way to use the extension mechanisms of \*E is to provide +interfaces to libraries, such as the C library or the libraries +of the X window system (e.\|g.\& \f2Xlib\fP). +\*E has no facility to directly import ``foreign'' functions +(although one such facility has been contributed as an extension to \*E). +Therefore, a small amount of code acting as ``glue'' between \*E and +the library has to be written to make the contents of a library +available to Scheme programmers. +The main purpose of this interface code is to check the arguments +supplied to the library functions, to convert Scheme objects +into C types, and to convert the results of library functions back +into Scheme objects. +Such \f2library extensions\fP often act as an additional layer +between the application +to be extended and the libraries used by the application; they allow +the application writers to abstract from the details of the +libraries. +Although it is useful to distinguish between \f2library\fP extensions +and extensions interfacing to \f2applications\fP, there is no +technical difference \*- in both cases a collection of types +and functions is made available to the Scheme world. +.PP +Since many of today's applications need to interact with the X Window +System, library extensions are included with \*E that interface to the +X11 ``Xlib'' (similar in its functionality to ``CLX'' [CLX 1991], but +implemented on top of Xlib), to the X11 toolkit intrinsics (``Xt''), +and to the Athena and OSF/Motif widget sets. +.PP +In addition, the \*E UNIX extension provides Scheme access to most +UNIX system calls and operating system interface C library functions\**. +.FS +The UNIX extension defines procedures for low-level, +file-descriptor-based I/O; creation of pipes; file/record locking; +file and directory system calls; process creation and control; signal +handling; error handling; and obtaining information about date, time, +users, limits, process resources, etc. +.FE +The extension supports a wide range of different UNIX platforms +without restricting its functionality to the lowest common denominator +or the POSIX 1003.1 functions. +To facilitate writing portable Scheme programs, the extension attempts +to hide differences between the types of supported UNIX flavors. +.\"(Two examples are appended: one forks off a process +.\"and communicates with it through pipes; the other one measure the maximum +.\"capacity of a pipe using non-blocking I/O.) +.NH +Using \*E in Applications +.\" .P +.\" Bringing Everything Together +.PP +In contrast to other extension language implementations +(e.\|g.\& Tcl), +\*E does not provide its functionality in the form of a library that is +statically linked into an application to be extended. +Instead, the object modules comprising the application +and all required library extensions are dynamically linked with and +loaded into the running Scheme interpreter. +To accomplish this, the \f2load\fP primitive of \*E has been +extended to load not only files containing Scheme code, +but also object files \*- compiled extensions written +in C or C++. +Dynamic loading enables applications to load less frequently +used modules into the running program only on demand; such an +application is initially smaller than the equivalent statically +linked application (where all modules must be combined into +one large executable file). +.PP +Dynamic loading of object files is often used together with the +\f2dump\fP primitive that creates an executable file from +the running interpreter, similar to \f2unexec\fP of GNU Emacs or +\f2dump\%lisp\fP in some Lisp systems. +The \f2dump\fP primitive of \*E differs from existing, similar +mechanisms in that the newly created executable, when called, starts at +the point where \f2dump\fP was called in the original invocation (as +opposed to the program's \f2main\fP entry point). +Here the return value of \f2dump\fP is ``true'', while in the original +invocation it returns ``false'' \*- not unlike the UNIX \f2fork\fP system +call. +.P +Dynamic Loading and Dump in Cooperation +.PP +To generate a new instance of an application one would typically +invoke the Scheme interpreter, load all object modules and all Scheme +code required initially, perform all initializations that can survive a +\f2dump\fP, and finally dump an image of the running interpreter +containing all the loaded code into a new executable on disk. +The use of \f2dump\fP avoids time-consuming activities such as +loading of object files and other initializations on each startup. +The dumped executable, when started, resumes after the call to +\f2dump\fP; at this point one would perform the remaining, +environment-dependent initializations and finally invoke the +application's ``main program'' (e.\|g.\& enter the X toolkit's event +processing main loop). +Listing @L(dump) shows a (slightly simplified) Scheme program that +generates and starts a new instance of an application. +.Ls +.Ss +;;; Load initially required object files and Scheme files of +;;; application and dump image into executable file. +;;; Dumped file enters application's main loop on startup. +.Sl +(load 'main.o) ; initial object modules +(load 'edit.o) +(load 'x11.o) ; (a library extension) +\&... +(load 'ui.scm) ; initial Scheme files +(load 'custom.scm) +(load 'x11.scm) +\&... +(initialize-application) +.Sl +(if (dump 'a.out) + (begin ; dumped a.out starts execution here + (initialize-depending-on-environment) + (main-loop-of-application) + (exit))) +.Sl +;; Original invocation gets here when dump is finished. We're done. +.Se +.Lc "Scheme code to generate and start an application" +.Ns +\f2Note:\fP Filenames can be given as symbols (besides the usual string +literals). +A more meaningful name than a.out would probably be chosen in practice. +.Ne +.Le dump +.PP +On systems that do not support dynamic linking and loading of +object files (such as older versions of UNIX System V) +or where \f2dump\fP cannot be implemented, +the interpreter kernel and the application and library extensions +are linked statically and combined into one executable. +.PP +In any event, in an application using \*E, the control initially +rests in the Scheme interpreter. +The interpreter acts as the ``main program'' of the application; it is the +interpreter's \f2main()\fP function which is invoked on startup of +the program. +Therefore the first code to execute in an application is Scheme code; +this Scheme code provides the shell functionality of the application +(hence it is called \f2shell code\fP). +The shell code may perform a few simple tasks, for instance, load a +user-provided initialization file containing customization code for +the application and then enter the application's main loop, +or it may be as complex as in ISOTEXT, where the entire X-based +user interface is written in Scheme. +.P +Making Oneself Known to the Extension Language +.PP +The application, as it is linked with the extension language +interpreter, has full access to all external functions and variables of +the interpreter kernel. +The interpreter, on the other hand, does not have any knowledge of the +contents of dynamically linked and loaded object modules; all it +sees of an object file being loaded is the file's symbol table. +To obtain ``hooks'' into a newly loaded extension, the interpreter +searches the symbol table of each object file being loaded for +functions whose names start with the prefix ``elk_init_'' +(\f2extension initialization functions\fP) and invokes these functions +as they are encountered. +Likewise, to support extensions written in C++, any C++ static +constructors found in the symbol table are called. +When linked statically with its extensions, the interpreter must scan +its own symbol table on startup to find and invoke the initialization +functions. +(Similar support is available for calling extension finalization functions +and C++ static destructors on termination.) +.PP +Besides initializing private data of the modules being loaded, +these initialization functions register with the interpreter +the Scheme primitives and Scheme data types implemented by the extensions. +To enable extensions to register new primitive procedures and types, +the interpreter kernel exports two functions: \f2Define_Primitive()\fP +to register a new Scheme primitive and \f2Define_Type()\fP to +register a new Scheme data type. +Both functions take pointers to C functions as arguments that implement +the new primitive or the basic access functions of the type (such as +the print function and the equality predicates). +.PP +A simple example for a library extension is presented in Appendix A. +.NH +Notes on the Implementation +.PP +Designing \*E, not as another Scheme implementation, but as an +extension language kit, provided a design space different from +that traditionally available for Lisp implementations. +The necessary deviations from the treaded paths of UNIX programming +uncovered limitations in portability, aggravated by badly tested +corners of standard UNIX facilities. +This section discusses the more interesting examples of such issues. +.P +Implementing Continuations +.PP +Finding a way to efficiently implement Scheme's \f2continuations\fP +called for considerable efforts during the design phase of \*E. +Continuations are a powerful language feature; they support the +definition of arbitrary control structures such as non-local +loop and procedure exits, \f2break\fP and \f2return\fP as in C, +exception handling facilities, explicit backtracking, co-routines, +or multitasking based on \f2engines\fP [Dybvig 1987]. +.PP +The primitive procedure +.Ss +\s+1(call-with-current-continuation \f2receiver\fP)\s0 +.Se +packages up the current execution state of the program into +an object (the \f2continuation\fP or \f2escape procedure\fP) +and passes this object as an argument to \f2receiver\fP (which is +a procedure of one argument). +Continuations are first-class objects in Scheme; they are +represented as procedures of one argument (not to be confused +with the \f2receiver\fP procedure). +Each time a continuation procedure is called with a value, +it causes this value to be returned as the result of the +\f2call-with-current-continuation\fP expression which created this +continuation. +If the procedure \f2receiver\fP terminates normally (i.\|e.\& does +not invoke the continuation given to it), the value +returned by \f2call-with-current-continuation\fP is the return +value of \f2receiver\fP. +.PP +As long as the use of a continuation is confined to the runtime +of the \f2receiver\fP procedure, \f2call-with-current-continuation\fP +is similar in its functionality to \f2catch/throw\fP in most +Lisp dialects or \f2setjmp/longjmp\fP in C. +However, continuations, like all procedures in Scheme, have indefinite +extent (unlimited lifetime); they can be stored in variables and +called an arbitrary number of times, even after the \f2receiver\fP and +the enclosing \f2call-with-current-continuation\fP have already +terminated. +Listing @L(call-cc) shows a program fragment where continuations +are used to get back an arbitrary number of times into the middle +of an expression whose computation has already been completed. +While not particularly useful, this example demonstrates that +continuations can be used to build control structures that +cannot be implemented by means of less general language features like +catch/throw or setjmp/longjmp. +.Ls +.Ss +(define my-function + (lambda (n m) + (+ n (mark m))) ; return n+m +.Sl +(define get-back "uninitialized") +.Sl +(define mark ; identity function, but also + (lambda (value) ; assign current continuation + (call-with-current-continuation ; to a global variable + (lambda (continuation) + (set! get-back continuation) ; (assign it) + value)))) +.Sl +.Sl +(my-function 10 20) ; invoke my-function \f2prints 30\fP +(get-back 5) ; resume with new value \f2prints 15\fP +(get-back 0) ; ...once more \f2prints 10\fP +.Se +.Lc "Using continuations with unlimited extent" +.Le call-cc +.PP +The different approaches applicable to implementing +continuations are intimately tied to the strategies used for +interpreting the language itself. +Scheme interpreters generally employ a lexical analyzer and parser +\*- the \f2reader\fP \*- to read and parse the Scheme source code and +produce an intermediate representation of the program. +During this phase, symbols are collected in a global hash table +(in Lisp jargon, the symbols are \f2interned\fP), and a tree +structure representing the program's S-expressions is built up +on the heap of the interpreter. +The majority of interpreters compile this intermediate representation +into an abstract machine language (such as \f2byte code\fP). +The evaluator is then implemented as an abstract machine which interprets +the low-level language; this machine \*- usually a simple stack +machine \*- may even be implemented in hardware. +.PP +In an abstract machine implementation, the straightforward approach to +implement \f2call-with-current-continuation\fP is to package up the +contents of the abstract machine's registers (program counter, stack +pointer, etc.) and runtime stack. +Since continuations have indefinite +extent, it would not suffice to just capture its registers (as the C +library function \f2setjmp\fP does for the real machine). +To be able to continue the evaluation of procedures that have +already returned and whose frames are therefore no longer on the stack, +a continuation must also embody the contents of the abstract +machine's stack at the time it is created. +When a continuation is applied, the machine resumes the ``frozen'' +computation by restoring the saved registers and stack contents +of the abstract machine. +.PP +Just saving the abstract machine's state would not work in \*E, because +at the time a continuation is created, arbitrary library functions may +be active in addition to Scheme primitives. +For instance, consider the \*E interface to the +``Xt'' toolkit intrinsics of the X window system. +Here, a typical scenario is that some Scheme +procedure invokes the primitive that enters the toolkit's event +dispatching main loop (\f2XtAppMainLoop()\fP). +When an event arrives (for example, a mouse button press event), +the toolkit's main loop invokes a callback function, which in turn +calls a user-supplied Scheme procedure to be executed when a +mouse button is pressed. +This Scheme procedure might in turn invoke yet another function +from the ``Xt'' library, and so on. +A similar example would be a \f2qsort\fP or \f2ftw\fP extension to \*E, +where the user-supplied function called by the \f2qsort()\fP or +\f2ftw()\fP C library function would invoke a procedure written +in Scheme. +.PP +The interpreter's thread of execution at any time obviously involves +both Scheme primitives and library functions (such as +\f2XtAppMainLoop()\fP and \f2qsort()\fP in the examples above) in an +arbitrary combination. +Therefore, a continuation must embody not only the execution +state of the active Scheme procedures, but also that of the +currently active library functions (such as local variables +used by the library functions). +In the approach used by \*E, a continuation is created by capturing +the machine's registers \*- like \f2setjmp\fP in C does \*- and the C +runtime stack. +When a continuation is applied later, the registers and the saved +stack contents are copied back. +Actually, we did not follow the usual ``abstract machine'' +technique in \*E at all; instead, the Scheme evaluator directly +interprets the intermediate representation produced by the reader. +In a sense, it is the ``real'' machine (the hardware on which \*E +is executed) that plays the role the abstract machine plays in +implementations with byte-code compilation. +.PP +Although the abstract machine technique usually yields faster +execution of Scheme code, the performance of \*E resembles +that of existing interpreters employing this technique, +and the implementation of \*E is simpler than that of comparable +interpreters using byte-code compilation. +While the technique to implement continuations in \*E is not strictly +portable \*- it is based on certain assumptions on the machine's stack +layout and the C compiler and runtime environment \*- +.\"implementations of the small machine-dependent part now exist for +it works on most major machine architectures (with two +exceptions, which are supported using \f2asm\fP statements). +.P +The Implementation of ``dump'' +.PP +Continuations provide a natural basis for implementing the +execution-state preserving semantics of the \f2dump\fP primitive. +When called, \f2dump\fP invokes \f2call-with-current-continuation\fP. +The real work is done in the \f2receiver\fP procedure; +it stores the newly created continuation into a global variable, +sets a global \f2was-dumped\fP flag to indicate that a dump has taken place, +creates an executable file from the image of the running process, +and finally returns ``false''. +The return value of the \f2dump\fP primitive is the return value +of this call to \f2call-with-current-continuation\fP, i.\|e.\& +``false'' if a dump has just been performed. +.PP +When the interpreter \*- either the original program or a dumped +executable \*- is started, it examines the \f2was-dumped\fP flag +as its very first action. +If the flag is set, the running interpreter was started from a +dumped executable. +In this case the interpreter immediately invokes, with an argument of +``true'', the continuation that was saved away by a call to \f2dump\fP; +this causes that call to \f2dump\fP to finish and return ``true'' to +its caller. +If, on the other hand, the \f2was-dumped\fP flag is not set (i.\|e.\& +the running process was not started from a dumped image), the +interpreter initializes and starts up as usual. +.PP +Before writing an image of the running process to disk, \f2dump\fP +has to close all open Scheme file ports, as open file descriptors would +not survive a \f2dump\fP \*- they would no longer be valid in the +dumped executable. +Generally, this is true for all objects pointing to information +maintained by the UNIX kernel, such as the current directory, the +current signal dispositions, resource limits, or interval timers. +Users and implementors of \*E extensions must be aware of this +particular restriction. +For instance, users of the X11 extensions have to make sure that, +if \f2dump\fP is to be used, connections to X-displays are only +established in the dumped invocation. +.PP +To be able to create an executable from the running process, \f2dump\fP +has to open and read the a.out file from which the running process was +started (actually, if the system linker has been called to dynamically +load object files, the output of the most recent invocation of the +linker is used instead of the original a.out). +The symbol table of the new executable is copied from the a.out file of +the running program; in addition, the a.out header has to be read to +obtain the length of the text segment and the start of the data segment +of the running process. +To do so, \f2dump\fP has to determine the filename of the a.out file from +which the process was started based on the information in \f2argv[0]\fP +and in the PATH environment variable. +This approach is obviously based on several prerequisites: \f2dump\fP +must be able to access its a.out file (\f2argv[0]\fP must carry +meaningful information; the file must be readable) and the running +program's a.out file must not have been stripped. +It would have been advantageous for the implementation of \f2dump\fP +if the entire a.out file were automatically mapped into memory +on startup, like it is done, for instance, in NeXT-OS/Mach. +.PP +\f2dump\fP combines the data segment and the ``bss'' segment of the +running process into the data segment of the new executable. +If \*E had a separate heap for storing constant objects (future +versions may have one), +\f2dump\fP could place this read-only part of the memory into the new +executable's text segment to make it sharable. +When the interpreter's heap is written to disk, \f2dump\fP seeks +over the unused portions of the heap, so that fake blocks (holes) can be +used for these parts of the file. +This results in a considerable conservation of disk space in +the final executable, as at least half of the interpreter's +heap is unused at any time due to the garbage collection +algorithm of \*E. +.PP +Since the a.out formats used in the numerous +versions of UNIX differ vastly, \*E has to include separate +implementations of \f2dump\fP for the currently supported +a.out formats. +Version 2.2 of \*E handles the BSD-style a.out format used +in BSD and ``derived'' UNIX versions (such as SunOS 4.1), +the COFF a.out format (used in older releases of UNIX System V +and in A/UX), Convex SOFF, +Extended COFF of MIPS-based computers (DEC, SGI), and +the ELF a.out format of System V Release 4 and related UNIX +versions (Solaris 2.x, OSF/1). +.P +Dynamic Loading of Object Files +.PP +When loading an object file during runtime, addresses +within this object file must be relocated to their new location +in the program's address space. +To allow extensions to directly reference objects of the interpreter +kernel, such as the heap and the built-in primitives, unresolved +references into the \f2base program\fP must be resolved during +dynamic loading. +Finally, the object file needs to be able to export its entry points +(such as \*E's extension initialization functions) to the base program. +.PP +More than one object file may have to be loaded into one invocation +of \*E. +To manage non-trivial, hierarchically structured sets of extensions, +where a number of high-level extensions require one or more lower-level +extensions to be loaded, it is essential that object files loaded later +can make use of the symbols defined by previously loaded object files. +As this style of dynamic loading allows building complex systems from +small components incrementally, we will use the term \f2incremental +loading\fP. +.PP +With the advent of 4.0\|BSD in 1980 [Joy 1980], +support for incremental +loading was added to the system linker and has since been supported by +most major UNIX variants: +when the \-A option and the name of the base executable are supplied to the +linker, linking is performed in a way that the object file produced by +the linker can be read into the already running executable. +The symbol table of the resulting object file is a combination of the +symbols defined by the base program and the newly defined symbols added +by the linking process, from the object file or from libraries used in +linking. +Only this newly linked code and data is entered into the +resulting object file. +The incremental style of dynamic loading is achieved by saving +the resulting output file each time the linker is invoked and using +this file as the base program for the next incremental loading step, +such that both old and new symbols can be referenced. +.PP +Incremental loading is generally supported by the linkers of UNIX +versions that use the BSD-style a.out format and by those of several +UNIX systems based on more modern a.out formats (e.\|g.\& Ultrix). +It is not supported by any existing release of UNIX System V. +Some newer UNIX versions that have shared libraries and dynamic linking +(such as System V Release 4 or SunOS) offer a library interface to +the dynamic linker. +In some systems this kind of interface is intended to replace the +incremental loading functionality of the system linker. +These dynamic linker interfaces usually come in the form of a library that +exports functions such as \f2dlopen()\fP to map a shared object module or +shared library into the address space of the caller (the base program) +and \f2dlsym()\fP to obtain the address of a function or data item in +the newly attached object module. +.PP +In some implementations, object files attached through \f2dlopen()\fP may +directly reference symbols in the base program; in other implementations +they may not. +In any case, object files cannot directly reference symbols defined +by objects that have been placed into the program by previous calls +to \f2dlopen()\fP (only, if at all, indirectly by calling \f2dlsym()\fP). +Thus, these dynamic linker interfaces are clearly inferior to +incremental loading, as they lack the important capability to +load a set of object files \f2incrementally\fP. +Many vendors who have replaced ``/bin/ld \-A'' by a \f2dlopen\fP-style library +in their UNIX systems, or who intend to do so, do not seem to be +aware of the fact that this change will break applications that +rely on incremental loading. +.PP +For \*E, the consequence of being restricted to dynamic linker +interfaces of that kind is that, except for the simplest applications, +one must pre-link all possible combinations of extensions that are +not completely independent of each other. +In general, given a set of \f2n\fP extensions each of which can be +based on one out of \f2m\fP other extensions, this means having to prepare +and keep around \f2n\|\(mu\|m\fP pre-linked object files; not to +mention the contortions one has to go through when the hierarchy of +extensions has a depth greater than two (not an unlikely scenario in +practice). +If the number of extensions and relations between them is larger than +trivial, or if the extensions are large or require large libraries, +keeping around all pre-linked combinations of object modules will cause +a maintenance problem and may waste a considerable amount of disk space. +.PP +Another, although minor, problem with these dynamic linker interfaces +is that they usually offer only a simple-minded function (such as +\f2dlsym()\fP) to look up the address of a specific symbol of a newly +accessed object module (typically some kind of module initialization +function); but they do not provide a way to scan all newly defined +symbols. +This functionality is insufficient to implement extension +initialization in \*E, where a dynamically loadable extension often is +composed from a number of small modules, each defining its own +initialization function. +Requiring a single, common initialization function name for the entire +object file implies that (often configuration-dependent) ``glue code'' +must be added to call all the individual initialization functions, +including the C++ static constructors. +.PP +Version 2.2 of \*E supports dynamic loading in environments with +``ld\|\|\-A'' (such as BSD, SunOS 4, Ultrix, and certain versions of +SGI Irix and HP-UX), in HP-UX 9 (based on \f2shl_load\fP), and in +MACH/NeXT-OS (\f2rld_load\fP). +By generating shared objects on the fly, System V Release 4 and +SunOS 5 (Solaris 2) are also supported, although in a limited and +not yet satisfactory way. +.P +Non-Standard Language Features +.PP +As the current version of the Scheme standard (deliberately) does not +specify several important language issues, such as error handling or +syntactic extensions, we have added a number of non-standard language +features to the Scheme interpreter of \*E to fill some of the holes. +.PP +A proposal for a macro extension has only recently been +added as an addendum to the \f2Revised\*(^4 Report on the +Algorithmic Language Scheme\fP [Clinger et al. 1991] and is still being +discussed controversially within the Scheme community. +To avoid having to wait for a final version of a macro system to +evolve and be included in the Scheme standard, we implemented a +simple-minded macro mechanism in \*E that resembles the macro +facilities offered by various existing Scheme and Lisp systems. +.PP +One area where the Scheme standard does not specify any language +features yet is error and exception handling; the standard merely +states which error situations a conforming implementation is +required to detect and report. +Since it is essential for a non-trivial application to be able to +gracefully handle error situations (such as failures in interactions +with the operating system) and other exceptional conditions, we have +added a simple error and exception handling facility to \*E. +.PP +When an error is detected by the interpreter, a user-supplied +error handling procedure is invoked with arguments identifying the +type and source of the error. +The standard interactive environment (top-level) of \*E provides a +default error handler that prints an error message and then resumes the +main read-eval-print loop by means of a \f2reset\fP primitive. +Most primitives of \*E and the extensions use this error handling +facility to signal an error, as opposed to indicating failure by +a distinctive return value (which would be prone to being ignored). +To by-pass the standard error handler and ``catch'' failure of a +particular primitive, programs may enclose the call to the primitive by +\f2call-with-current-continuation\fP and dynamically bind the error +handler to the continuation (as shown in listing @L(errset)). +.Ls +.Ss +(define (open-input-file-or-not name) + (call-with-current-continuation + (lambda (return) ; \f6return\fP becomes escape procedure + (fluid-let ((error-handler ; rebind \f6error-handler\fP + (lambda args (return #f)))) + (open-input-file name))))) +.Se +.Lc "A version of open-input-file that returns the newly opened port \ +on success, #f on error" +.Le errset +.PP +\*E provides a similar facility to handle an \f2interrupt\fP exception: +a user-supplied interrupt handler is invoked when a SIGINT signal is sent +to the interpreter (usually by typing the interrupt character on the +keyboard). +Support for other exceptions, such as timer interrupts, may be provided +in future versions. +.PP +Another non-standard primitive that facilitates handling of errors is +\f2dynamic-wind\fP, a generalization of the \f2unwind-protect\fP form +offered by many Lisp dialects. +\f2dynamic-wind\fP is used to implement the \f2fluid-let\fP special +form (to create \f2fluid\fP or dynamic variable bindings). +Both \f2dynamic-wind\fP and \f2fluid-let\fP are also provided by +several other Scheme dialects [MIT 1984, Dybvig 1987]. +.PP +The current version of the Scheme standard does not provide any +language features that would make it possible to implement a useful +Scheme debugger (apart from a debugger based on source code +instrumentation). +To compensate for this shortcoming, we have added a few primitives that +aid the implementation of a simple interactive debugger, among them an +\f2eval\fP primitive (although, in theory, \f2eval\fP could be +implemented by writing an expression into a temporary file and then +loading this file). +In addition, \*E, like a few other Scheme dialects, provides lexical +environments as first class (but immutable) objects. +Other non-standard primitives that aid writing debuggers are +\f2procedure-lambda\fP to obtain the lambda expression that evaluated +to a given procedure, and a primitive that returns the list of +currently active procedures together with their actual arguments and +the lexical environments in which the procedure calls took place +(a \f2backtrace\fP). +.\" +.\" provide, require; autoloading +.P +Garbage Collection +.PP +The garbage collector of \*E is based on the \f2stop-and-copy\fP +algorithm (see e.\|g. [Abelson et al. 1985]). +The heap area is divided into two \f2semispaces\fP, only one of which +is active during normal operation. +In a garbage collection, all objects that are still reachable are moved +into the unused semispace; the previously used semispace then remains +unused until the next garbage collection. +An incremental, generational garbage collector for \*E, inspired by +Yip's garbage collector [Yip 1991], has recently been implemented +as an alternative to the stop-and-copy garbage collector\**. +.FS +With a generational garbage collector, objects surviving garbage +collections will not be touched again until there is only a certain +amount of memory left on the heap, triggering a full garbage +collection. +Particularly in applications with large amounts of Scheme code or +other constant data, partial GCs run much faster than full GCs. +With incremental garbage collection, starting a garbage collection does +not suspend the application until the GC is done; +instead, the collector returns control to the application almost +immediately (after having marked pages of interest unreadable with the +\f2mprotect\fP system call) and regains control with a SIGSEGV signal. +.FE +.PP +Extensions to \*E can register \f2before-GC\fP and \f2after-GC\fP +functions with the interpreter; these functions are invoked by the +garbage collector immediately before and after each garbage collection +run. +Within \f2after-GC\fP functions, extensions can determine whether +a particular Scheme object has become garbage, i.\|e. no references +to the object exist any longer. +In this case, an extension may perform some kind of clean-up action; +for example, if the now unreferenced object contains a handle to an open +file, close this file. +.PP +The \*E distribution contains a library based on this mechanism that +enables extensions to register a \f2termination function\fP for +objects of a particular type. +The termination function associated with an object is then invoked +by the garbage collector automatically when this object has been +detected to be unused. +The Xlib extension of \*E uses this library to perform suitable +finalization operations on objects created by the extensions, for +example, close windows, unload fonts, and free colormap objects that +have become unreferenced. +This mechanism is slightly complicated by the fact that objects may +have to be terminated in a predefined order; for instance, when an +X11 display becomes garbage, all objects associated with this +display must be terminated before the display itself is finally closed. +.P +Library Extensions +.PP +The problems we encountered when designing +and implementing \*E's interfaces to the C libraries of X11 +are likely to apply to a wide range of similar APIs. +The X11 libraries, especially Xlib, are quite complex; the core Xlib +alone exports more than 600 functions and macros, with +numerous different mechanisms for passing arguments and +for manipulating objects, some of which could be considered rather +verbose and error-prone. +This complexity is, at least partly, caused by the semantic +restrictiveness of the C programming language. +Thus, when designing the Scheme language interface, we had the +opportunity to eliminate some of the ``warts.'' +.PP +If integration of a library with an extension language (or interactive +language in general) is not anticipated at the time the programmer's +interface of the library is designed, writing a properly functioning +extension language interface to this library can become rather +challenging or even impossible. +This problem is exemplified by the ``Xt'' toolkit intrinsics library +of X11, in particular by earlier versions of this library. +The following example illustrates a typical difficulty caused by +the ``static'' nature of the programmer's interface to ``Xt'': +.PP +Each class of graphical objects (\f2widgets\fP in ``Xt'' terminology) +exports a list of attributes (\f2resources\fP) that are associated with +objects of this class. +A function is provided by ``Xt'' to obtain the list of resources of a +widget class together with the name and C type (integer, string, +pixmap, color, etc.) of each resource. +On this basis, operations like setting the value of a widget's resource +from within Scheme can be implemented in a straightforward way. +The ``Xt'' extension just has to check if the user-supplied Scheme +value can be converted into a C object of the resource's type, perform +this conversion, and call the Xt-function to set the resource, or +complain to the user if the value is not suitable for this resource. +However, in early versions of Xt, some classes of widgets had a subset of +resources (the \f2constraint resources\fP) whose names and types +could not be obtained by an ``Xt'' application. +While this omission was usually not perceived as a problem for C +programmers (who would know each widget's resources \f2a priori\fP from +reading the documentation), it had a dramatic effect on \*E's ``Xt'' +extension, as now the knowledge about these resources had to be +hard-wired into the extension. +As a result, the extension's source code had to be modified for each +new widget set to be made usable from within Scheme code. +.PP +This particular problem has been remedied in recent releases of X11, +though several similar problems remain; even in the UNIX C library. +While design flaws of library interfaces often go unnoticed or are +considered minor when writing C or C++ programs (e.\|g.\& the fact +that implementations of the \f2qsort()\fP functions are +non-reentrant), they become crucial when these libraries are made +accessible to an extension language. +As the importance of extension languages is growing, it is essential +that future library interfaces are designed with the particular +requirements of extensions languages in mind. +.PP +.\" automatic generation of interfaces / foreign functions +.NH +Practical Experiences with \*E +.P +\*E and ISOTEXT +.PP +In developing the document processing system ISOTEXT, \*E +proved to be a major asset [Bormann 1991]. +Scheme was used as the implementation language for all user interface +aspects of ISOTEXT. +Apart from providing extensibility to users of ISOTEXT, using \*E as +the base for ISOTEXT made it possible to write the shell code in a high +level language with all its amenities, e.\|g.\& automatic storage +reclamation. +As no recompilation and relinking is necessary, it is a quick operation +to apply and test changes to the user interface. +.PP +\*E provides for a strong ``firewall'' in the ISOTEXT system: +bugs in the Scheme code give rise to errors at the Scheme level, which can +easily be debugged using the (primitive, but functional) built-in +debugger of \*E, while conditions such as core dumps always are the +result of bugs in the ISOTEXT kernel implementation. +.PP +All this assistance for the development of ISOTEXT could be +obtained without sacrificing the performance of the ISOTEXT kernel +system, which is still written in efficient C++. +.PP +\*E also allowed us to isolate the ISOTEXT kernel from the choice of an +X toolkit: +the ISOTEXT kernel is unaware of the toolkit being used (``Xt'' with +OSF/Motif). +The Scheme code builds a user interface using the Motif library +interface and provides X windows to the ISOTEXT kernel. +Input is processed by the Scheme code which calls editor primitives +provided by the ISOTEXT kernel and schedules redisplay operations. +Replacing Xt and OSF/Motif by e.\|g.\& \f2Xview\fP would require no +changes in the ISOTEXT kernel. +.\".PP +.\"As extensions and the \*E kernel are effectively linked together, the +.\"current interface between the two allows extensions to call every +.\"global function in the \*E kernel. +.\"This makes it difficult to rewrite in Scheme primitives that originally +.\"were written in C. +.PP +The work on ISOTEXT clearly identified one single main problem in +writing non-trivial extensions: as any request for new heap space can +trigger a garbage collection, extensions must register local or +temporary Scheme objects with the garbage collector to protect them +from being discarded during a GC run caused by any nested procedure +call. +While this scheme has the advantage that maximum utilization of the +available heap space is guaranteed, it imposes a strict discipline +on the extension programmer. +Failure to properly protect temporary Scheme objects usually results +in delayed crashes of the application that are hard to trace back to the +actual source of the problem. +For instance, when developing the X11 extensions to \*E, most of the time +spent for debugging was due to GC-related bugs. +.\" Similarly, the following bug in the interpreter kernel went unnoticed for years: +.\" .Ss +.\" \s+1newframe = Add_Binding(newframe, Car(b), Eval(val));\s0 +.\" .Se +.\" Depending on the C compiler used, \f2newframe\fP is pushed on the argument +.\" stack before \f2Eval\fP, which may trigger a GC, is called. +.\" The GC generally moves the object to which \f2newframe\fP points, +.\" updating the variable \f2newframe\fP, but not the copy +.\" on the argument stack, which is now a dangling reference. +.\" When the GNU C compiler uncovered this problem, the line was changed to +.\" the proper: +.\" .Ss +.\" \s+1temp = Eval(val);\s0 +.\" \s+1newframe = Add_Binding(newframe, Car(b), temp);\s0 +.\" .Se +.\" +.\"(cabo: recruiting problems) +.P +\*E and TELES.VISION +.PP +Another example for using Elk and its X interface as the basis for a +user interface subsystem is the TELES.VISION desktop video +conferencing system [TELES 1991]. +First, a somewhat generalized User Interface Management System was +built in about 1500 lines of Scheme, which was then instantiated to +build a number of revisions of the TELES.VISION user interface. +The user interface communicates with the rest of the conferencing +system via a remote procedure call C library, using Scheme +continuations as a basis for a simple form of multithreading. +According to the TELES.VISION implementors [Bastian 1993], Elk was a +``perfect fit'' for this application, with the single exception that +its initial garbage collector placed too heavy a burden on the memory +starved initial environment (where 8 MB of memory had to be shared +between an operating system, various realtime device drivers, drivers +for video codec hardware, and an MS-Windows emulation subsystem). +This has since been remedied by adding memory. +Using Elk also helped when TELES.VISION was ported to OS/2 \*- in +particular, its continuations ported easily. +Also, Elk was used in the TELES.VISION project to build a rapid +prototype of the central conference management subsystem (again using +continuations to provide multithreading) within less than two weeks. +.P +Other Projects +.PP +While \*E has been used in the ISOTEXT project since 1987, legal +issues prevented making it publicly available until the fall of 1989. +Since, \*E has gained acceptance, in fact sufficient momentum to +encourage others to contribute software. +Elk has been used successfully as an extension language for a +hypertext database, a distributed version +management system, various CAD programs, testing and simulation +systems for digital circuits as well as environmental models. +It also has found use simply as a Scheme programming environment, in +particular for its X and Motif interface. +.PP +The X extensions have proven useful in particular for writers of +applications with graphical user interfaces based on X; \*E enables +them to write their user interfaces or parts thereof in Scheme to +achieve a high degree of customizability. +.PP +\*E also has found use as a free-standing Scheme implementation. +In combination with the X extensions it is well-suited for teaching X +to beginners, as a tool for interactively exploring X, and as a +platform for rapid prototyping of X-based applications. +.PP +Outside of the UNIX world, we are aware of user-done ports to DOS (both +16 bit and 32 bit using DJGPP), OS/2, and MacOS. +.PP +Users cited the following features as significant for their choice of +Elk: dynamic object code loading, dumping of ready-to-run executables, +Elk's performance, its legally unencumbered availability, and finally +its simplicity and adaptability (and, as users say, its consistent, +clean and well-structured code). +.PP +Users are not happy with various artificial limitations still in the +system (such as the static heap size which with the stop-and-copy +garbage collector needs to be fixed at invocation time), with Elk's +performance, and with the fact that Elk ``likes to be in control'' +(i.e.\&, supplies the main program). +In addition, prospective users tend to ponder acceptance problems with +their fellow workers and customers (who might not be well versed in +Lisp/Scheme) before committing to Elk. +Finally, for many extension language applications, Elk is ``too big'', +and users have asked for versions without the more expensive Elk +features such as arbitrary size number support or continuations. +On the other hand, users have asked for additional features such as an +inter-process communication interface, or a better debugger. +Also, a port to MS-Windows has been actively sought. +.NH +Conclusions +.PP +Since the \*E project began, both the research community and +significant industry projects have generated increasing numbers of +``embeddable language'' implementations. +While many such languages inherit the syntactic flavor of BASIC, those +projects that focus on the ability to build non-trivial extensions +recently seem to almost exclusively turn to the Scheme language. +.PP +Scheme has proven to be an effective language for extension language +purposes. +In the beginning of the ISOTEXT project, there were concerns that an +implementation of the full Scheme language would be both too large and +too slow. +These reservations proved to be unfounded: +the binary code size of \*E is still significantly below that of a +medium size application such as \f2vi\fP. +While the performance of \*E may be uninspiring (no compiler is +available), this turned out not to be a critical issue, as any +bottlenecks can easily be replaced by a primitive recoded in C or C++. +.PP +There also were concerns that Scheme was going to be hard to learn for +UNIX users familiar with, say, the Bourne Shell and C. +This seems to be more of a problem with initial acceptance than with +a steep learning curve: +after having overcome the initial barrier (which generally had +to do mainly with perceiving the syntax as queer), users reported the +same rapid increase in productivity they already knew from shell +programming. +It certainly has not been necessary to recruit Lisp programmers to be +able to extend applications with \*E. +.PP +.ds Tx "T\v'.2m'E\v'-.2m'X +Finally, \*E was an exercise in writing portable software without +being restricted to what is considered portable today. +Apart from the well-known problem that true portability between +current relevant platforms cannot be attained by just picking one of +the proclaimed ``standards'', and the unwieldy situation that there +are too many standards for (auto-)configuration of software, a +significant part of the effort in generating \*E was consumed by +devising support for each new platform for dynamic loading, generation +of executables from running programs, and switching between threads of +control (continuations). +Note that many non-trivial applications of today (apart from +Lisp programming environments, GNU emacs and \*(Tx come to mind) need one +or more of these features; also note that most relevant current +platforms can be made to support these features quite well \*- just in +wildly different ways. +.NH +Availability +.PP +\*E is available in legally unencumbered status. +The current version as of June 1994 is 2.2. +The most recent version of \*E is available via anonymous FTP from +ftp.x.org (/contrib) and ftp.fu-berlin.de +(/pub/unix/languages/scheme). +.NH +Acknowledgments +.PP +An early version of \*E was written while one of us was employed at +TELES GmbH, Berlin. +We are grateful to Prof.\& Dr.\& Sigram Schindler of TELES and TU +Berlin for providing the work environment for ISOTEXT and \*E and for +the permission to publish this software. +.PP +The present version is a result of our research work at Technische +Universit\(a:t Berlin, with the benefit of the work of many +contributors. +In particular, we wish to thank Marco Scheibe who wrote the +generational, incremental garbage collector. +.NH +References +.IP "[Abelson et al. 1985] +Harold Abelson and Gerald J. Sussman with Julie Sussman, +\f2Structure and Interpretation of Computer Programs\fP, +MIT Press, Cambridge, Mass., 1985. +.\" +.IP "[Bastian 1993]" +Personal communication with Jan Bastian, TELES. +.\" +.IP "[Bormann et al. 1988] +Ute Bormann, Carsten Bormann, C. Bathe, +SDE \*- A WYSIWYG Editing and Formatting System for ODA and +SGML Documents, +ESPRIT '88, \f2Proceedings of the 5th Annual ESPRIT Conference, +Brussels\fP, November 14-17, 1988. +.\" +.IP "[Bormann 1991]" +Carsten Bormann, +Open Document Processing and the ISOTEXT System, +Doctoral Dissertation, TU-Berlin, 1991. +.\" +.IP "[CFI 1991a]" +CAD Framework Initiative, CFI Extension Language Sub-Committee, +\f2CFI Extension Language Selection Document\fP, +CFI Document Number 87, CAD Framework Initiative Inc., Austin, Texas, 1991. +.\" +.IP "[CFI 1991b]" +CAD Framework Initiative, Extension Language Working Group: +Architecture Technical Sub-Committee, +\f2Extension Language: Core Language Selection\fP, +Draft Proposal Version 0.7, CFI Document Number ARCH-91-G-1, +CAD Framework Initiative Inc., Austin, Texas, 1991. +.\" +.IP "[Clinger et al. 1991]" +William Clinger and Jonathan Rees (Editors), +\f2Revised\*(^4 Report on the Algorithmic Language Scheme\fP, +November 2, 1991. +Available as ftp://cs.indiana.edu/pub/scheme-repository/doc/r4rs.ps.Z. +.\" +.IP "[CLX 1991]" +CLX \*- Common LISP X Interface, 1991. +(Part of the X11 Release 5 distribution available from the +MIT software distribution center.) +.IP "[Cowlishaw 1985]" +M. F. Cowlishaw, +\f2The REXX Language \*- A Practical Approach to Programming\fP +Prentice Hall, Englewood Cliffs, NJ, 1985. +.\" +.IP "[Dybvig 1987]" +R. Kent Dybvig, +\f2The Scheme Programming Language\fP, +Prentice Hall, Englewood Cliffs, NJ, 1987. +.\" +.IP "[Hansen 1990]" +Wilfred J. Hansen, +Enhancing documents with embedded programs: How Ness extends +insets in the Andrew ToolKit, +\f2Proceedings of IEEE Computer Society 1990 International +Conference on Computer Languages\fP, +March 12-15, 1990, New Orleans. +.\" +.IP "[IEEE\|Std\|1178-1990]" +\f2IEEE Standard for the Scheme Programming Language\fP, +New York, May 28, 1991 (approved December 10, 1990). +.\" +.IP "[Joy 1980]" +Bill Joy, +Changes in the VAX system in the Fourth Berkeley Distribution, +Computer Systems Research Group, +University of California, Berkeley, +November 1980. +.\" +.IP "[Lewis et al. 1990]" +Bil Lewis, Dan LaLiberte, the GNU Manual Group, +GNU Emacs Lisp Reference Manual, +Edition 1.03, Free Software Foundation, Cambridge, Mass., +December 1990. +.\" +.IP "[MIT 1984]" +MIT Scheme Manual, Seventh Edition, +Department of Electrical Engineering and Computer Science, +Massachusetts Institute of Technology, +Cambridge, Mass., September 1984. +.\" +.IP "[Ossanna 1979]" +J. F. Ossanna, +Nroff/Troff User's Manual, +UNIX Programmer's Manual, Seventh Edition, vol. 2, +Bell Telephone Laboratories, Murray Hill, NJ, January 1979. +.\" +.IP "[Ousterhout 1990]" +John K. Ousterhout, +Tcl: An Embeddable Command Language, +\f2Proceedings of the USENIX 1990 Winter Conference\fP, +January 1990, pp. 133-146. +.\" +.IP "[Scheifler et al. 1986]" +Robert W. Scheifler and Jim Gettys, +The X Window System, +\f2ACM Transactions on Graphics\fP, vol. 5, no. 2, pp. 79-109, 1986. +.\" +.IP "[Scheifler et al. 1992]" +Robert Scheifler and James Gettys, +\f2X Window System\fP, +Third Edition, +Digital Press, +1992. +.\" +.IP "[Springer et al. 1989]" +George Springer and Daniel O. Friedman, +\f2Scheme and the Art of Programming\fP, +MIT Press, Cambridge, Mass., 1989. +.\" +.IP "[Stallman 1981]" +Richard M. Stallman, +EMACS \*- The Extensible, Customizable, Self-documenting Display +Editor Production System, +\f2SIGPLAN Notices\fP, vol. 16, no. 6, pp. 147-156, Association for +Computing Machinery, New York, 1981. +.\" +.IP "[TELES 1991] +Das TELES.VISION System \*- Philosophie und Technologie, +TELES GmbH, Berlin, 1991 (in German). +.\" +.IP "[Yip 1991]" +G. May Yip, +Incremental, Generational Mostly-Copying Garbage Collection in +Uncooperative Environments, +WRL Research Report 91/8, +DEC Western Research Laboratory, +Palo Alto, California, 1991. +.ie \n(.U \{\ +.NH S A +Appendix: Extending \*E \*- An Example +.\} +.el \{\ +.bp +.SH +.nr H1 1 +.af H1 A +Appendix A: Extending \*E \*- An Example +.\} +.P +The ``ndbm'' Library Extension +.PP +The extensibility mechanisms of \*E can be demonstrated best by +examining a simple library extension. +Consider the \f2ndbm\fP library that is available on most versions +of UNIX. +This library implements functions to maintain a simple database +file of key/contents pairs. +.PP +As shown in Listing @L(ndbm), both the keys and the data to be stored +are described by the type \f2datum\fP; it consists of the data +(a string of bytes) and the length of the data. +\f2dbm_open()\fP opens a database file and returns a handle +to that file to be used in subsequent operations on that +database (a pointer to an opaque data type, similar to the \f2fopen\fP +and \f2readdir\fP interfaces); it returns a null pointer if the +file could not be opened. +A database is closed by a call to \f2dbm_close()\fP. +The data stored under a given key is accessed by the function +\f2dbm_fetch()\fP; it returns an object of type \f2datum\fP +(with a null \f2dptr\fP if the key could not be found). +\f2dbm_store\fP is used to insert an entry into a database and +to modify an existing entry; it returns zero on success and a +non-zero value on error. +.Ls +.Ss +#include +.Sl +.Sl +typedef struct { + char *dptr; + int dsize; +} datum; +.Sl +.Sl +DBM *dbm_open(char *file, int flags, int mode); +.Sl +void dbm_close(DBM *db); +.Sl +datum dbm_fetch(DBM *db, datum key); +.Sl +int dbm_store(DBM *db, datum key, datum data, int flags); +.Se +.Lc "The UNIX \f2ndbm\fP library" +.Ns +\f2Note:\fP For simplicity, several functions have been omitted. +The \f2flags\fP and \f2mode\fP arguments of \f2dbm_open\fP are that +of the \f2open\fP system call. +The \f2flags\fP argument of \f2dbm_store\fP can be DBM_INSERT to +insert a new entry into the database or DBM_REPLACE to change +an existing entry. +.Ne +.Le ndbm +.PP +The straightforward way to write an \f2ndbm\fP extension to \*E is to +provide a new Scheme data type \f2dbm-file\fP together with the +obligatory type predicate \f2dbm-file?\fP and the Scheme primitive +procedures \f2dbm-open\fP, \f2dbm-close\fP, \f2dbm-fetch\fP and +\f2dbm-store\fP that operate on objects of type \f2dbm-file\fP. +.PP +\f2dbm-open\fP receives the filename (a string or a symbol); +the second argument is one of the symbols \f2reader\fP (open +the file read-only), \f2writer\fP (read and write access), and +\f2create\fP (read and write access, create new file if it does +not exist). +The optional filemode argument is an integer. +\f2dbm-open\fP returns an object of type \f2dbm-file\fP or #f +(false) if the file could not be opened. +\f2dbm-close\fP closes the database file associated with its +argument of type \f2dbm-file\fP. +As this function is called for its side-effect only, +and for lack of a better result, it returns a non-printing object. +.PP +\f2dbm-fetch\fP expects a \f2dbm-file\fP and a string argument +(the key to be searched) and returns a string (the data stored +under the key) or #f if the key does not exist. +Note that in \*E strings may contain arbitrary 8-bit characters, +including the null byte. +\f2dbm-store\fP is called with a \f2dbm-file\fP, two strings +(key and data) and one of the symbols \f2insert\fP and \f2replace\fP. +Its integer return value is the return value of \f2dbm_store()\fP. +.PP +These procedures and the new \f2dbm-file\fP type can be used +by application programmers to manipulate database files +in those parts of their applications that are written in Scheme. +Listing @L(ndbm-example) shows a small example. +.Ls +.Ss +(define expand-mail-alias + (lambda (alias) + (let ((d (dbm-open "/etc/aliases" 'reader))) + (if (not d) + (error 'expand-mail-alias "cannot open database")) + (unwind-protect + (dbm-fetch d alias) + (dbm-close d))))) +.Sl +(define address-of-staff (expand-mail-alias "staff")) +.Se +.Lc "Using the ndbm extension" +.Ns +\f2Note:\fP The \f2unwind-protect\fP and the \f2error\fP form +are not present in standard Scheme. +.Ne +.Le ndbm-example +.P +The Anatomy of a Scheme Type +.PP +Listing @L(ndbm-skeleton) shows the part of the extension that deals with +the new data type \f2dbm-file\fP and the extension initialization +function. +The variable \f2T_Dbm\fP will hold the unique identifier of the +newly defined type. +The structure \f2S_Dbm\fP defines the C representation of the type; +one such C structure is declared for each composite Scheme type. +Its main component is the handle of the database file that is +contained in each object of type \f2dbm-file\fP. +.Ls +.Ss +#include +#include +.Sl +int T_Dbm; +.Sl +struct S_Dbm { + DBM *dbm; + char alive; /* 0 or 1 */ +}; +.Sl +#define DBMF(obj) ((struct S_Dbm *)POINTER(obj)) +.Sl +int Dbm_Equal(a, b) Object a, b; { + return DBMF(a)->alive && DBMF(b)->alive && DBMF(a)->dbm == DBMF(b)->dbm; +} +.Sl +void Dbm_Print(d, port) Object d, port; { + Printf(port, "#[dbm-file %lu]", DBMF(d)->dbm); +} +.Sl +Object P_Is_Dbm(x) Object x; { + return TYPE(x) == T_Dbm ? True : False; +} +.Sl +void elk_init_dbm() { + Define_Primitive(P_Is_Dbm, "dbm-file?", 1, 1, EVAL); + Define_Primitive(P_Dbm_Open, "dbm-open", 2, 3, VARARGS); + Define_Primitive(P_Dbm_Close, "dbm-close", 1, 1, EVAL); + Define_Primitive(P_Dbm_Store, "dbm-store", 4, 4, EVAL); + Define_Primitive(P_Dbm_Fetch, "dbm-fetch", 2, 2, EVAL); +.Sl + T_Dbm = Define_Type("dbm-file", sizeof(struct S_Dbm), + Dbm_Equal, Dbm_Equal, Dbm_Print, NOFUNC); +} +.Se +.Lc "Skeleton of the ndbm extension" +.Ns +\f2Note:\fP For simplicity some details have been omitted in this +listing, and the calling interface of some functions has been +simplified; the program would not compile in this form. +A working \f2gdbm\fP (GNU dbm) extension is included in the \*E +distribution. +.Ne +.Le ndbm-skeleton +.PP +Scheme objects can usually live longer than their underlying +C objects. +In case of the \f2dbm-file\fP type, a Scheme object of that type +can obviously still be referenced after its database handle has been +closed by a call to \f2dbm-close\fP. +As \*E extensions must not crash the application, we must prevent +such stale objects from being used in further calls to +\f2dbm-fetch\fP, \f2dbm-store\fP, and \f2dbm-close\fP. +One way to achieve this is to record in each Scheme object whether +the underlying C object is still alive or has been terminated. +The boolean component \f2alive\fP in the \f2dbm-file\fP type +serves this purpose. +It is initialized with true and is set to false in \f2dbm-close\fP. +Further operations on objects with \f2alive\fP being false are +rejected. +.PP +The interpreter stores all Scheme objects in variables of type +\f2Object\fP. +An \f2Object\fP is typically a 32-bit value; it is composed of +a \f2tag\fP part and a \f2pointer\fP part. +The \f2tag\fP part indicates the type of the object, and the remaining +bits hold the actual memory address of the object (they point into +the interpreter's heap). +The macros \f2TYPE\fP and \f2POINTER\fP are provided to extract +the fields of an \f2Object\fP. +Each type definition must define a macro to extract the object's +memory address from an \f2Object\fP (by means of \f2POINTER\fP) +and then cast it into a pointer to the underlying C structure +(see \f2#define DBMF\fP in Listing @L(ndbm-skeleton)). +.PP +\f2Dbm_Equal()\fP implements both the \f2eqv?\fP and the \f2equal?\fP +predicates for \f2dbm-file\fP objects; it returns true if both objects +being compared are alive and contain identical \f2DBM\fP handles. +.PP +\f2Dbm_Print()\fP is called by the interpreter each time an object +of type \f2dbm-file\fP is to be printed; it is invoked with the +object and the Scheme port to which the output is to be sent. +.PP +\f2P_Is_Dbm()\fP implements the primitive procedure \f2dbm-file?\fP +(the type predicate). +As with all primitives, it receives arguments of type \f2Object\fP and +returns an \f2Object\fP, and it has a name beginning with ``P_''. +.PP +The definition of the initialization function \f2elk_init_dbm()\fP +is straightforward; it invokes \f2Define_Primitive()\fP once +for each primitive procedure and finally \f2Define_Type()\fP to +make the new type known to the interpreter. +.PP +The arguments that can be supplied to \f2Define_Primitive()\fP are a +pointer to the function implementing the primitive procedure, the +Scheme name of the primitive, the minimum and maximum number of +arguments, and a symbol indicating the \f2calling discipline\fP of the +primitive. +For most of the functions in this example, the calling discipline is +\f2EVAL\fP, indicating a normal procedure with a fixed number of +arguments, such as \f2car\fP. +Elk also supports procedures with variable argument list, such as +\f2list\fP (\f2VARARGS\fP); and \f2NOEVAL\fP for \f2special forms\fP +(variable number of unevaluated arguments). +.PP +\f2Define_Type()\fP is invoked with the Scheme name of the type, the +size of the type's representation in C or C++ (given as a constant or +as a function), two functions implementing the \f2eqv?\fP and +\f2equal?\fP predicates for objects of this type, a function that is +called by the interpreter to print an object of the new type (the +type's \f2print function\fP), and a function providing information +about the type to the garbage collector. +The return value of \f2Define_Type()\fP is a ``handle'' to the newly +defined type (a small, unique integer); its main uses are to +check the type of arguments supplied to primitive procedures and to +instantiate objects of this type. +.P +Primitive Procedures \*- The Details +.PP +Listing @L(dbm-open) gives the definitions of the primitives \f2dbm-open\fP +and \f2dbm-close\fP. +.Ls +.Ss +static SYMDESCR Flag_Syms[] = { + { "reader", O_RDONLY }, + { "writer", O_RDWR }, + { "create", O_RDWR|O_CREAT }, + { 0, 0 } +}; +.Sl +Object P_Dbm_Open(argc, argv) int argc; Object *argv; { + char *p; + DBM *dp; + Object d; +.Sl + Make_C_String(argv[0], p); + dp = dbm_open(p, Symbols_To_Bits(argv[1], 0, Flag_Syms), + argc == 3 ? Get_Integer(argv[2]) : 0666); + if (dp == 0) + return False; + d = Alloc_Object(sizeof(struct S_Dbm), T_Dbm, 0); + DBMF(d)->dbm = dp; + DBMF(d)->alive = 1; + return d; +} +.Sl +void Check_Dbm(d) Object d; { + Check_Type(d, T_Dbm); + if (!DBMF(d)->alive) + Primitive_Error("invalid dbm-file: ~s", d); +} +.Sl +Object P_Dbm_Close(d) Object d; { + Check_Dbm(d); + DBMF(d)->alive = 0; + dbm_close(DBMF(d)->dbm); + return Void; +} +.Se +.Lc "ndbm extension \*- implementation of \f2dbm-open\fP and \f2dbm-close\fP +.Le dbm-open +.PP +\f2dbm-open\fP, as it has an optional argument, is a function with +\f2VARARGS\fP calling discipline (not to be confused with the C +language feature of the same name), as indicated by the last argument +to the \f2Define_Primitive\fP call. +Primitives of this type receive an array of \f2Objects\fP and a count. +.PP +The initial call to the macro \f2Make_C_String\fP checks if the +first argument to \f2dbm-open\fP is a string (or a symbol) and +converts it to a C string. +To obtain the second argument to \f2dbm_open()\fP, the symbol +passed to the Scheme primitive (\f2reader\fP, \f2writer\fP, etc.) +has to be mapped to a corresponding flags combination (\f2O_RDONLY\fP, +\f2O_RDWR\fP, etc.). +This is accomplished by the \*E function \f2Symbols_To_Bits()\fP; it +is invoked with a Scheme symbol, a flag indicating whether a single +symbol or a list of symbols (a mask) is to be converted, and a +table of pairs of symbol names and C integers. +The third argument to \f2dbm_open\fP is the filemode; +\f2Get_Integer()\fP converts a Scheme number to a C integer. +\f2dbm-open\fP finally allocates a new Scheme object of type \f2T_Dbm\fP +on the heap, initializes the components of the object, and returns it. +.PP +The auxiliary function \f2Check_Dbm()\fP is used by the remaining +primitives to check whether a given object is of type \f2dbm-file\fP +and if so, whether it is stale. +In this case an error is signaled; \f2Primitive_Error()\fP enters +the error handler of \*E. +.PP +\f2P_Dbm_Close()\fP just marks the object as stale by setting +\f2alive\fP to false and closes the database file. +.PP +Listing @L(dbm-store) shows the implementation of \f2dbm-store\fP and +\f2dbm-fetch\fP. +\f2Make_Integer()\fP is the counterpart to \f2Get_Integer()\fP; +it converts a C integer into a Scheme number. +Likewise, \f2Make_String()\fP converts a C string into a +Scheme string. +.bp +.Ls +.Ss +static SYMDESCR Store_Syms[] = { + { "insert", DBM_INSERT }, + { "replace", DBM_REPLACE }, + { 0, 0 } +}; +.Sl +Object P_Dbm_Store(d, key, content, flag) Object d, key, content, flag; { + datum k, c; + int result; +.Sl + Check_Dbm(d); + Check_Type(key, T_String); + Check_Type(content, T_String); + k.dptr = STRING(key)->data; k.dsize = STRING(key)->size; + c.dptr = STRING(content)->data; c.dsize = STRING(content)->size; + result = dbm_store(DBMF(d)->dbm, k, c, + Symbols_To_Bits(flag, 0, Store_Syms)); + return Make_Integer(result); +} +.Sl +Object P_Dbm_Fetch(d, key) Object d, key; { + datum k, c; +.Sl + Check_Dbm(d); + Check_Type(key, T_String); + k.dptr = STRING(key)->data; k.dsize = STRING(key)->size; + c = dbm_fetch(DBMF(d)->dbm, k); + return c.dptr ? Make_String(c.dptr, c.dsize) : False; +} +.Se +.Lc "ndbm extension \*- implementation of \f2dbm-store\fP and \f2dbm-fetch\fP +.Le dbm-store +.\" ---------- +.\" Erwaehnen: Little Languages +.\" ---------- +.\" Read the CFI papers again diff --git a/doc/usenix/usenix.ps b/doc/usenix/usenix.ps new file mode 100644 index 0000000..d3039a9 --- /dev/null +++ b/doc/usenix/usenix.ps @@ -0,0 +1,2354 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier +%%+ font Symbol +%%+ font Courier-Oblique +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 31 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier +%%IncludeResource: font Symbol +%%IncludeResource: font Courier-Oblique +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier-Oblique@0 ENC0/Courier-Oblique RE +/Courier@0 ENC0/Courier RE/Times-Roman@0 ENC0/Times-Roman RE/Times-Italic@0 +ENC0/Times-Italic RE/Times-Bold@0 ENC0/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(Elk: The Extension Language Kit)201.984 123 Q/F1 10 +/Times-Italic@0 SF(Oliver Laumann* and Car)204.44 147 Q(sten Bormann)-.1 E<87> +-2 I/F2 10/Times-Roman@0 SF 2.5(*T)203.78 165 S(echnische Uni)216.69 165 Q -.15 +(ve)-.25 G(rsit\344t Berlin, German).15 E(y)-.15 E 2.5<8755>224.12 177 S(ni) +238.84 177 Q -.15(ve)-.25 G(rsit\344t Bremen, German).15 E(y)-.15 E F1(ABSTRA) +264.535 213 Q(CT)-.3 E F2 .385 +(In the past, users of an application generally were at the merc)133 245 R +2.885(yo)-.15 G 2.885(fi)395.465 245 S .385(ts authors when)404.46 245 R .628 +(it came to adapting it to their indi)108 265 R .629(vidual needs and tastes.) +-.25 F .629(Fitting an application with an)5.629 F F1 -.2(ex)108 285 S 1.249 +(tension langua).2 F -.1(ge)-.1 G F2(\(or)3.849 E F1 1.248(embedded langua) +3.748 F -.1(ge)-.1 G F2 3.748(\)e).1 G 1.248 +(nables users to customize and enhance it)298.322 285 R 2.647(without ha)108 +305 R 2.647(ving to modify its source code.)-.2 F(Recently)7.648 E 5.148(,v) +-.65 G 2.648(ariants of Lisp ha)345.008 305 R 2.948 -.15(ve b)-.2 H(ecome).15 E +2.335(increasingly popular for this purpose, to the point where the ab)108 325 +R 2.335(undance of dif)-.2 F(ferent)-.25 E .139(dialects has gro)108 345 R .139 +(wn into a problem.)-.25 F .139(Of the tw)5.139 F 2.639(os)-.1 G .14 +(tandardized dialects of Lisp, only)300.821 345 R F1(Sc)2.64 E(heme)-.15 E F2 +(is suitably modest, yet suf)108 365 Q(\214ciently general, to serv)-.25 E 2.5 +(ea)-.15 G 2.5(sa)319.8 365 S 2.5(ne)330.63 365 S(xtension language.)342.42 365 +Q F1(Elk)133 388.6 Q F2 2.624(,t)C(he)154.234 388.6 Q F1 .123(Extension Langua) +2.623 F .323 -.1(ge K)-.1 H(it).1 E F2 2.623(,i)C 2.623(saS)270.916 388.6 S +.123(cheme implementation that is intended to be)290.052 388.6 R .111 +(used as a general, reusable e)108 408.6 R .112 +(xtension language subsystem for inte)-.15 F .112(gration into e)-.15 F .112 +(xisting and)-.15 F .367(future applications.)108 428.6 R .367 +(Applications can de\214ne their o)5.367 F .366 +(wn Scheme data types and primiti)-.25 F -.15(ve)-.25 G(s,).15 E(pro)108 448.6 +Q .203(viding for a tightly-knit inte)-.15 F .204 +(gration of the C/C++ parts of the application with Scheme)-.15 F 3.87 +(code. Library)108 468.6 R(interf)3.87 E 1.37(aces, for e)-.1 F 1.369 +(xample to the UNIX operating system and to v)-.15 F 1.369(arious X)-.25 F -.4 +(Wi)108 488.6 S(ndo).4 E 3.896(wS)-.25 G 1.396(ystem libraries, sho)151.246 +488.6 R 3.896(wt)-.25 G 1.396(he ef)245.734 488.6 R(fecti)-.25 E -.15(ve)-.25 G +1.396(ness of this approach.).15 F(Se)6.397 E -.15(ve)-.25 G 1.397 +(ral features of).15 F .367(Elk such as dynamic loading of object \214les and \ +freezing of fully customized applications)108 508.6 R 2.587(into e)108 528.6 R +-.15(xe)-.15 G 2.587(cutables \(implemented for those UNIX en).15 F 2.587 +(vironments where it w)-.4 F 2.587(as feasible\))-.1 F .254 +(increase its usability as the backbone of a comple)108 548.6 R 2.754(xa)-.15 G +2.754(pplication. Elk)319.816 548.6 R .254(has been used in this)2.754 F -.1 +(wa)108 568.6 S 2.859(yf).1 G .359(or se)130.749 568.6 R -.15(ve)-.25 G 2.859 +(ny).15 G .359(ears within a locally-de)172.167 568.6 R -.15(ve)-.25 G .359 +(loped OD).15 F .359(A-based multimedia document editor;)-.4 F 1.063 +(it has been used in numerous other projects after it could be made freely a) +108 588.6 R -.25(va)-.2 G 1.063(ilable \214v).25 F(e)-.15 E(years ago.)108 +608.6 Q/F3 10/Times-Bold@0 SF 2.5(1. Intr)72 660.6 R(oduction)-.18 E F2 .848 +(The designers and implementors of a lar)97 684.2 R .848(ge or comple)-.18 F +3.348(xa)-.15 G .848(pplication can rarely anticipate all require-)329.53 684.2 +R .087(ments future users will ha)72 704.2 R .387 -.15(ve o)-.2 H 2.587(nt).15 +G .087(he application.)202.712 704.2 R -.8(Ty)5.087 G(pically).8 E 2.587(,u) +-.65 G .086(sers wish to be able to customize the user inter)313.733 704.2 R(-) +-.2 E -.1(fa)72 724.2 S 2.765(ces of applications according to their personal \ +tastes or requirements, or the).1 F 5.265(yw)-.15 G 2.765(ant to e)429.475 +724.2 R 2.765(xtend the)-.15 F EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2-)279.67 56 S .478 +(functionality of an application \(either by combining e)72 92 R .477 +(xisting functions into ne)-.15 F 2.977(wo)-.25 G .477 +(nes or by adding entirely)402.662 92 R(ne)72 112 Q 2.798(wc)-.25 G 2.798 +(apabilities\). This)95.648 112 R .299 +(is especially true for applications used routinely)2.798 F 2.799(,s)-.65 G +.299(uch as te)370.436 112 R .299(xt editors, and for appli-)-.15 F +(cations with a high de)72 132 Q(gree of user interaction or with comple)-.15 E +2.5(xg)-.15 G(raphical user interf)327.49 132 Q(aces.)-.1 E .95(Certainly an)97 +155.6 R 3.45(ya)-.15 G .95 +(pplication can be customized by modifying its source code and recompiling it.) +159.85 155.6 R(But)5.95 E .402(this approach is often not feasible, as the sou\ +rce code of the application or the tools needed to recompile it)72 175.6 R .619 +(may not be a)72 195.6 R -.25(va)-.2 G 3.119(ilable. Ev).25 F .619 +(en if it were feasible, it w)-.15 F .618 +(ould be a time-consuming process; it w)-.1 F .618(ould be hard to)-.1 F -.1 +(ke)72 215.6 S .454(ep up with ne).1 F 2.954(wr)-.25 G .454 +(eleases of the application; and the coe)150.116 215.6 R .454 +(xistence of multiple, similar v)-.15 F .455(ersions of the same)-.15 F +(application w)72 235.6 Q(ould become a general maintenance headache.)-.1 E +.256(The alternati)97 259.2 R .556 -.15(ve t)-.25 H 2.756(ot).15 G .256 +(his approach is not to `)173.188 259.2 R(`hard-wire')-.74 E 2.756('t)-.74 G +.256(he entire functionality and all e)318.764 259.2 R .256(xternal aspects) +-.15 F 1.166(of an application in the source code at all, b)72 279.2 R 1.167 +(ut to pro)-.2 F 1.167(vide means to customize the application')-.15 F 3.667 +(sb)-.55 G(eha)474.21 279.2 Q(vior)-.2 E(later by its users.)72 299.2 Q/F1 10 +/Times-Bold@0 SF 2.5(1.1. Early)72 339.2 R +(Customization and Extension Languages)2.5 E F0(Man)97 362.8 Q 2.967(ya)-.15 G +.466(pplications support at least simple methods for customization, such as co\ +mmand line options)127.587 362.8 R .007(or con\214guration \214les.)72 382.8 R +.007(More po)5.007 F .008(werful tools for customization are)-.25 F/F2 10 +/Times-Italic@0 SF(macr)2.508 E 2.508(ol)-.45 G(angua)365.226 382.8 Q -.1(ge) +-.1 G(s).1 E F0(,)A F2 .008(command langua)2.508 F -.1(ge)-.1 G(s).1 E F0 2.508 +(,o)C(r)500.67 382.8 Q F2 1.102(scripting langua)72 402.8 R -.1(ge)-.1 G(s).1 E +F0 1.102(that are typically found in te)3.602 F 1.101(xt editors and w)-.15 F +1.101(ord processors.)-.1 F 1.101(Prominent e)6.101 F 1.101(xamples of)-.15 F +1.299(such customization and e)72 422.8 R 1.299 +(xtension languages are the macro language of the no)-.15 F 3.8(wl)-.25 G -.15 +(eg)410.46 422.8 S 1.3(endary TECO editor).15 F .04 +(and, in UNIX, the macro language of the)72 442.8 R F2(tr)2.54 E(of)-.45 E(f) +-.18 E F0(te)2.54 E .04 +(xt formatter [Ossanna 1979] and the con\214guration language)-.15 F(of the)72 +462.8 Q F2(sendmail)2.5 E F0(program.)2.5 E 2.012(Although man)97 486.4 R 4.512 +(yo)-.15 G 4.513(ft)170.874 486.4 S 2.013(hese classic e)181.497 486.4 R 2.013 +(xtension languages are quite po)-.15 F 2.013(werful \(some of them are full-) +-.25 F .161(\215edged programming languages\), the)72 506.4 R 2.661(yh)-.15 G +-2.25 -.2(av e)234.414 506.4 T 2.661(ar)2.861 G .161(eputation of being `) +261.036 506.4 R(`cryptic')-.74 E 2.661('a)-.74 G .16 +(nd hard to understand and use)383.5 506.4 R 1.037(by untrained users.)72 526.4 +R 1.037(The pre)6.037 F -.25(va)-.25 G 1.037 +(iling opinion seems to be that only e).25 F 1.038 +(xperts can actually bene\214t from these)-.15 F .339(types of e)72 546.4 R +.339(xtension languages \(for e)-.15 F .338(xample, people who ha)-.15 F .638 +-.15(ve m)-.2 H .338(astered the).15 F F2(sendmail)2.838 E F0 .338 +(con\214guration language)2.838 F .086 +(in all details are commonly appointed the status of a `)72 566.4 R(`guru')-.74 +E 2.586('\). In)-.74 F -.1(fa)2.586 G .086(ct, it can be observ).1 F .086 +(ed that only v)-.15 F .086(ery fe)-.15 F(w)-.25 E 1.707(users of the)72 586.4 +R F2(tr)4.207 E(of)-.45 E(f)-.18 E F0(te)4.207 E 1.707(xt formatter \(whose ma\ +cro language is reputed to be particularly cryptic\) are using)-.15 F 1.938 +(macro packages written by themselv)72 606.4 R 1.938(es; man)-.15 F 4.438(yu) +-.15 G 1.938(sers gi)272.738 606.4 R 2.238 -.15(ve u)-.25 H 4.438(pa).15 G +1.938(fter some time and f)332.862 606.4 R 1.939(all back on v)-.1 F(endor)-.15 +E(-)-.2 E(supplied macro packages or packages written by a `)72 626.4 Q(`trof) +-.74 E 2.5(fg)-.25 G(uru.)306.22 626.4 Q -.74('')-.7 G .262 +(Experience also indicates that simpli\214ed or specialized e)97 650 R .261 +(xtension languages often ha)-.15 F .561 -.15(ve m)-.2 H .261(ore features).15 +F 1.186(added and gro)72 670 R 3.686(wu)-.25 G 1.186(ntil the)146.678 670 R +3.686(yr)-.15 G 1.186(esemble a full programming language.)187.79 670 R 1.186 +(Such `)6.186 F(`or)-.74 E -.05(ga)-.18 G 1.187(nically gro).05 F(wn')-.25 E +3.687('e)-.74 G(xtension)470.11 670 Q .49(languages are lik)72 690 R .49 +(ely to be contorted designs as the)-.1 F 2.989(yw)-.15 G .489 +(ill consist of se)291.399 690 R -.15(ve)-.25 G .489(ral le).15 F -.15(ve)-.25 +G .489(ls of e).15 F .489(xtensions glued on to)-.15 F +(their initial, more limited design.)72 710 Q EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-3-)279.67 56 S/F1 10/Times-Bold@0 SF 2.5 +(1.2. High-Le)72 92 R -.1(ve)-.15 G 2.5(lE).1 G(xtension Languages)148.7 92 Q +F0 .475(Recently application designers ha)97 115.6 R .775 -.15(ve b)-.2 H -.15 +(eg).15 G .476(un to abandon specialized and cryptic macro-style e).15 F +(xtension)-.15 E .839(languages in f)72 135.6 R -.2(avo)-.1 G 3.339(ro).2 G +3.339(fe)155.387 135.6 S .838(xtension languages that resemble usual high-le) +166.346 135.6 R -.15(ve)-.25 G 3.338(lp).15 G .838 +(rogramming languages, mainly)377.614 135.6 R .889(languages with Algol/P)72 +155.6 R .889(ascal-style or Lisp-style syntax and semantics.)-.15 F .889 +(Prominent e)5.889 F .89(xamples of such high-)-.15 F(le)72 175.6 Q -.15(ve) +-.25 G 3.254(le).15 G .754(xtension languages are TPU de)98.584 175.6 R -.15 +(ve)-.25 G .753(loped by DEC, the).15 F/F2 10/Times-Italic@0 SF(Ness)3.253 E F0 +.753(language of the Andre)3.253 F 3.253(wT)-.25 G .753(oolkit [Hansen)444.087 +175.6 R .228(1990], AutoDesk')72 195.6 R 2.728(sC)-.55 G .228(AD e)157.176 +195.6 R .228(xtension language \(a dialect of Lisp\), and)-.15 F F2(Emacs-Lisp) +2.729 E F0 2.729(,t)C .229(he e)403.763 195.6 R .229(xtension language of)-.15 +F(Richard Stallman')72 215.6 Q 2.5(sp)-.55 G +(opular GNU Emacs editor [Stallman 1981, Le)155.89 215.6 Q(wis et al. 1990].) +-.25 E .043(Emacs w)97 239.2 R .042 +(as the \214rst wide-spread application to emplo)-.1 F 2.542(ya)-.1 G 2.542(na) +322.658 239.2 S .042(lready e)334.64 239.2 R .042 +(xisting and widely used high-le)-.15 F -.15(ve)-.25 G(l).15 E .646 +(programming language as its e)72 259.2 R .647 +(xtension and customization language.)-.15 F .647 +(Emacs-Lisp is a dynamically scoped)5.647 F .396 +(dialect of Lisp with additional operations for te)72 279.2 R 2.896 +(xt-editing. The)-.15 F .396(approach tak)2.896 F .396 +(en by Emacs has been tremen-)-.1 F(dously successful; users of Emacs ha)72 +299.2 Q .3 -.15(ve c)-.2 H(ontrib).15 E(uted a wealth of e)-.2 E +(xtensions written in Emacs-Lisp.)-.15 E 1.082(Note that Emacs-Lisp is not a)97 +322.8 R F2 1.082(scripting langua)3.582 F -.1(ge)-.1 G F0 6.082(.I).1 G 3.582 +(ti)312.666 322.8 S 3.582(st)321.808 322.8 S 1.082(ightly interw)332.06 322.8 R +-.15(ove)-.1 G 3.582(nw).15 G 1.082(ith the application for)414.374 322.8 R +.437(which it pro)72 342.8 R .437(vides e)-.15 F(xtensibility)-.15 E 5.437(.I) +-.65 G 2.937(ta)205.018 342.8 S .437(lso is some)215.175 342.8 R .436 +(what inaccessible to the casual user)-.25 F 2.936(,w)-.4 G .436(ho is unlik) +416.596 342.8 R .436(ely to ha)-.1 F -.15(ve)-.2 G(pre)72 362.8 Q .556(vious e) +-.25 F .556(xperience with Lisp-lik)-.15 F 3.056(el)-.1 G 3.056(anguages. This) +218.144 362.8 R .557(can be contrasted with languages such as Tcl [Ouster)3.056 +F(-)-.2 E 1.132(hout 1990] and REXX [Co)72 382.8 R(wlisha)-.25 E 3.632(w1)-.15 +G 1.131(985], whose underlying models are no less comple)225.86 382.8 R 1.131 +(x, b)-.15 F 1.131(ut which are)-.2 F .499(similar enough to well-kno)72 402.8 +R .499(wn languages such as B)-.25 F .5 +(ASIC to present less of an obstacle to casual users.)-.35 F(On)5.5 E .446 +(the other hand, non-tri)72 422.8 R .446(vial e)-.25 F .445(xtensions bene\214\ +t from the structuring functionality inherent in general purpose)-.15 F +(programming languages such as Lisp.)72 442.8 Q F1 2.5(1.3. Elk)72 482.8 R +(as a General, Reusable Extension Language)2.5 E F0 .791 +(Using Lisp or Lisp-style languages as e)97 506.4 R .792 +(xtension languages seems to enjo)-.15 F 3.292(yg)-.1 G(ro)409.036 506.4 Q .792 +(wing popularity; se)-.25 F(v-)-.25 E 1.118(eral applications besides Emacs no) +72 526.4 R 3.617(wu)-.25 G 1.117(se dialects of Lisp as their e)231.477 526.4 R +1.117(xtension language.)-.15 F 1.117(This de)6.117 F -.15(ve)-.25 G(lopment) +.15 E .094(has one disadv)72 546.4 R .094 +(antage: the number of incompatible \(b)-.25 F .095(ut similar\) e)-.2 F .095 +(xtension languages is continually gro)-.15 F(wing.)-.25 E .944(Users ha)72 +566.4 R 1.244 -.15(ve t)-.2 H 3.444(ol).15 G .944(earn a ne)134.192 566.4 R +3.444(wl)-.25 G .944(anguage for each ne)185.364 566.4 R 3.444(wa)-.25 G .944 +(pplication, and application writers k)283.29 566.4 R .944(eep implementing)-.1 +F(ne)72 586.4 Q 2.5(we)-.25 G +(xtension language interpreters instead of reusing e)95.2 586.4 Q +(xisting ones.)-.15 E .012(These problems can be solv)97 610 R .012 +(ed by a general, reusable e)-.15 F .013 +(xtension language implementation that applica-)-.15 F .995 +(tion writers can include into their applications, an)72 630 R F2 -.2(ex)3.494 +G .994(tension langua).2 F 1.194 -.1(ge k)-.1 H(it).1 E F0 5.994(.T)C .994 +(he main objecti)386.95 630 R 1.294 -.15(ve o)-.25 H 3.494(ft).15 G(he)477.736 +630 Q F2(Elk)3.494 E F0 .645(project w)72 650 R .645(as to de)-.1 F -.15(ve) +-.25 G .645(lop such an e).15 F .646(xtension language kit and to mak)-.15 F +3.146(ei)-.1 G 3.146(tf)351.174 650 S .646(reely a)360.43 650 R -.25(va)-.2 G +.646(ilable to encourage use by).25 F(application writers.)72 670 Q EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-4-)279.67 56 S/F1 10/Times-Bold@0 SF 2.5(2. Ov)72 +92 R(er)-.1 E(view of the Extension Language Kit)-.1 E 2.5(2.1. The)72 132 R +(Ev)2.5 E(olution of Elk)-.1 E F0 2.48 -.8(We w)97 155.6 T .88 +(ere prompted to de).8 F -.15(ve)-.25 G .88 +(lop Elk when a search for a suitable e).15 F .88 +(xtension language implementation)-.15 F .363(for ISO)72 175.6 R .363 +(TEXT [Bormann et al. 1988, Bormann 1991] w)-.4 F .364(as fruitless.)-.1 F(ISO) +5.364 E(TEXT)-.4 E 2.864(,ad)-.74 G .364(ocument processing sys-)404.952 175.6 +R .812(tem with a graphical user interf)72 195.6 R .812 +(ace, is almost entirely written in C++; its user interf)-.1 F .812 +(ace is based on the X)-.1 F(windo)72 215.6 Q 2.688(ws)-.25 G .188(ystem [Sche\ +i\215er et al. 1986, Schei\215er et al. 1992] and the OSF/Motif widget set.) +110.548 215.6 R(Customizability)5.188 E(and e)72 235.6 Q +(xtensibility through a full e)-.15 E +(xtension language were basic requirements on the design of ISO)-.15 E(TEXT)-.4 +E(.)-.74 E .002(As we consider language design to be the domain of a `)97 259.2 +R .002(`selected fe)-.74 F(w')-.25 E 2.502('a)-.74 G .002(nd did not w)383.826 +259.2 R .002(ant to act as ama-)-.1 F .64 +(teurs in this \214eld, we decided to use an e)72 279.2 R .64 +(xisting programming language as the basis for the e)-.15 F .64(xtension lan-) +-.15 F .573(guage of ISO)72 299.2 R(TEXT)-.4 E 5.573(.T)-.74 G .573 +(his decision w)165.059 299.2 R .572(as also in\215uenced by our desire to de) +-.1 F -.15(ve)-.25 G .572(lop a general, reusable e).15 F(xten-)-.15 E .239(si\ +on language implementation that is not hard-wired into one speci\214c applicat\ +ion.)72 319.2 R -.15(Fo)5.24 G 2.74(ran).15 G .24(umber of reasons)434.65 319.2 +R .614(an interpreted language seemed preferable: e)72 339.2 R .613 +(xtensions can be added to \(or modi\214ed in\) a running applica-)-.15 F .565 +(tion without re-linking it; b)72 359.2 R .565(ugs in e)-.2 F .566 +(xtensions can be caught in the interpreter and do not crash the applica-)-.15 +F .329(tion; interpreted languages usually of)72 379.2 R .328(fer better deb) +-.25 F .328(ugging f)-.2 F .328 +(acilities; and implementing an interpreter gener)-.1 F(-)-.2 E +(ally is easier than implementing a compiler)72 399.2 Q(.)-.55 E .021 +(From the be)97 422.8 R .021(ginning we f)-.15 F -.2(avo)-.1 G .021 +(red Lisp or a dialect of Lisp as the basis for a general e).2 F .022 +(xtension language.)-.15 F .975(Most dialects of the Lisp f)72 442.8 R .974 +(amily are `)-.1 F(`small')-.74 E .974 +(', easy to implement, general-purpose languages with simple)-.74 F 1.905 +(syntax and po)72 462.8 R 1.905 +(werful semantics, and the suitability of Lisp as an e)-.25 F 1.906 +(xtension language had already been)-.15 F .388(demonstrated by se)72 482.8 R +-.15(ve)-.25 G .388(ral applications, among them GNU Emacs.).15 F .387 +(Early in the project we considered to use)5.387 F .215(Emacs-Lisp, b)72 502.8 +R .215(ut it appeared infeasible to isolate the Lisp interpreter from the rest\ + of Emacs.)-.2 F .216(In addition, at)5.216 F .287(the time we in)72 522.8 R +-.15(ve)-.4 G(stig).15 E .287(ated Emacs-Lisp it w)-.05 F .287(as lacking se) +-.1 F -.15(ve)-.25 G .286(ral desirable language features, such as support for) +.15 F 1.31(\215oating point and arbitrary precision numbers \()72 542.8 R/F2 10 +/Times-Italic@0 SF(bignums)A F0 3.81(\). W)B 3.81(ea)-.8 G 1.31 +(lso considered using MIT Scheme [MIT)336.64 542.8 R .382(1984], b)72 562.8 R +.381(ut due to the enormous size of its implementation it w)-.2 F .381(ould ha) +-.1 F .681 -.15(ve d)-.2 H .381(ominated the size of the applica-).15 F(tion.) +72 582.8 Q F1 2.5(2.2. Scheme)72 622.8 R(as an Extension Language)2.5 E F0 .205 +(As other implementations of Lisp or Lisp-lik)97 646.4 R 2.706(el)-.1 G .206 +(anguages a)287.498 646.4 R -.25(va)-.2 G .206 +(ilable did not meet our requirements, we).25 F 2.006 +(\214nally decided to write an interpreter for the Lisp dialect)72 666.4 R F2 +(Sc)4.506 E(heme)-.15 E F0 2.005([Clinger et al. 1991, Dyb)4.505 F 2.005 +(vig 1987,)-.15 F .191(Springer et al. 1989, Abelson et al. 1985].)72 686.4 R +.192(This Scheme interpreter is the main component of the Elk pack-)5.192 F +3.766(age. Scheme)72 706.4 R 1.266(is a simpli\214ed, `)3.766 F(`cleaned-up') +-.74 E 3.766('d)-.74 G 1.266 +(ialect of Lisp with \214rst-class procedures and static scoping)259.466 706.4 +R 2.751(rules. The)72 726.4 R .252(Scheme language is based on only a fe)2.751 +F 2.752(wl)-.25 G .252(anguage features and semantic concepts; it consists of) +286.446 726.4 R EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-5-)279.67 56 S 2.947(as)72 92 S .447 +(mall core of syntactic forms, a set of e)83.277 92 R .446(xtended forms deri) +-.15 F -.15(ve)-.25 G 2.946(df).15 G .446 +(rom them, and a number of standard pro-)336.468 92 R .629(cedures \()72 112 R +/F1 10/Times-Italic@0 SF(primitive)A F0 .629 +(procedures\) that operate on a comprehensi)3.129 F .929 -.15(ve s)-.25 H .63 +(et of types of objects \(among them num-).15 F 3.59(bers, lists, v)72 132 R +3.59(ectors, symbols, characters, and strings\).)-.15 F 3.59 +(In 1990 Scheme became an IEEE standard)8.59 F -.834([IEEE Std 1178-1990])72 +152 R .402(\(the standard document, although only 50 pages long, includes the \ +formal semantics)2.902 F(of the language\).)72 172 Q .61 +(The standardization ef)97 195.6 R .609 +(fort has increased the acceptance of Scheme; for instance, the Extension Lan-) +-.25 F .234(guage W)72 215.6 R .234(orking Group of the CAD Frame)-.8 F -.1(wo) +-.25 G .234(rk Initiati).1 F .534 -.15(ve h)-.25 H .234 +(as recently selected Scheme as the e).15 F .234(xtension lan-)-.15 F 1.483 +(guage for future CAD applications [CFI 1991a, CFI 1991b].)72 235.6 R 1.482 +(Among the established programming lan-)6.482 F .765 +(guages we consider Scheme the ideal candidate for a general e)72 255.6 R .765 +(xtension language \212 it is standardized; its)-.15 F .743(semantics are well\ +-de\214ned; it has a simple syntax and is easy to implement; and it is suf)72 +275.6 R .743(\214ciently small to)-.25 F(not dw)72 295.6 Q +(arf the application it mak)-.1 E(es e)-.1 E(xtensible.)-.15 E/F2 10 +/Times-Bold@0 SF 2.5(2.3. Extending)72 335.6 R(the Extension Language)2.5 E F0 +1.445(The implementation of an e)97 359.2 R 1.446 +(xtension language must itself be e)-.15 F 3.946(xtensible. Extension)-.15 F +1.446(language code)3.946 F .067(that manipulates objects or state of the appl\ +ication requires adding application-speci\214c primiti)72 379.2 R .366 -.15 +(ve p)-.25 H(rocedures).15 E .613(to the base e)72 399.2 R .613 +(xtension language.)-.15 F 2.213 -.8(To a)5.613 H(llo).8 E 3.113(wE)-.25 G .613 +(lk programs to be e)249.231 399.2 R(xpressi)-.15 E .913 -.15(ve i)-.25 H 3.114 +(nt).15 G .614(he conte)382.9 399.2 R .614(xt of a gi)-.15 F -.15(ve)-.25 G +3.114(na).15 G(pplica-)476.23 399.2 Q .342 +(tion, application writers are encouraged \(and e)72 419.2 R .342 +(xpected\) to e)-.15 F .342(xtend standard Scheme by a rich set of applica-) +-.15 F .152(tion-speci\214c data types and Scheme primiti)72 439.2 R -.15(ve) +-.25 G 2.652(st).15 G 2.652(oo)264.162 439.2 S .153 +(perate on objects of these types.)276.814 439.2 R .153(In f)5.153 F .153 +(act, easy e)-.1 F(xtensibil-)-.15 E .087 +(ity of the language has been the primary design consideration in the de)72 +459.2 R -.15(ve)-.25 G .086(lopment of Elk \(as opposed to per).15 F(-)-.2 E +.183(formance or number of language features\).)72 479.2 R .183(Adding ne)5.183 +F 2.683(wt)-.25 G .183(ypes and primiti)303.704 479.2 R -.15(ve)-.25 G 2.683 +(st).15 G 2.683(oE)387.463 479.2 S .183(lk is an ine)401.256 479.2 R(xpensi) +-.15 E .484 -.15(ve o)-.25 H(per).15 E(-)-.2 E(ation; it is not uncommon for a\ +n application to de\214ne hundreds of application-speci\214c Scheme primiti)72 +499.2 Q -.15(ve)-.25 G(s.).15 E .162(All primiti)97 522.8 R .462 -.15(ve p)-.25 +H .161(rocedures of Elk are implemented as C or C++ functions.).15 F .161 +(This is true for both b)5.161 F(uilt-in)-.2 E(primiti)72 542.8 Q -.15(ve)-.25 +G 3.865(s\().15 G 1.365(such as)119.355 542.8 R F1(car)3.865 E F0(and)3.865 E +F1(cdr)3.865 E F0 3.865(\)a)C 1.365(nd primiti)214.21 542.8 R -.15(ve)-.25 G +3.865(sd).15 G 1.365(e\214ned by e)277.1 542.8 R 3.865(xtensions. From)-.15 F +1.365(the Scheme programmers')3.865 F .089(point of vie)72 562.8 R 1.388 -.65 +(w, p)-.25 H(rimiti).65 E -.15(ve)-.25 G 2.588(sa).15 G .088(nd types from the\ + base set of the language are indistinguishable from application-)176.884 562.8 +R .983(speci\214c primiti)72 582.8 R -.15(ve)-.25 G 3.483(sa).15 G .983 +(nd types.)154.116 582.8 R .983(Extensions `)5.983 F(`re)-.74 E(gister')-.15 E +3.483('n)-.74 G 1.483 -.25(ew p)294.728 582.8 T(rimiti).25 E -.15(ve)-.25 G +3.483(sw).15 G .983(ith the interpreter by supplying the)360.484 582.8 R 1.614 +(name of the primiti)72 602.8 R 1.914 -.15(ve a)-.25 H 1.614 +(long with a pointer to the function implementing the primiti).15 F 1.914 -.15 +(ve a)-.25 H 1.614(nd information).15 F .426(about the ar)72 622.8 R .426 +(guments and calling style.)-.18 F(Ne)5.426 E 2.926(wt)-.25 G .427 +(ypes are de\214ned in a similar w)255.362 622.8 R(ay)-.1 E 5.427(.R)-.65 G +-.15(eg)403.409 622.8 S .427(istration of ne).15 F 2.927(wp)-.25 G(rimi-)484 +622.8 Q(ti)72 642.8 Q -.15(ve)-.25 G 2.744(sa).15 G .244(nd types usually tak) +97.674 642.8 R .243 +(es place on startup of the interpreter or when a compiled e)-.1 F .243 +(xtension is loaded into)-.15 F(the running interpreter)72 662.8 Q(.)-.55 E +.379(Another w)97 686.4 R .379(ay to use the e)-.1 F .379 +(xtension mechanisms of Elk is to pro)-.15 F .38(vide interf)-.15 F .38 +(aces to libraries, such as the)-.1 F 3.276(Cl)72 706.4 S .776 +(ibrary or the libraries of the X windo)84.726 706.4 R 3.276(ws)-.25 G .775 +(ystem \(e.)251.764 706.4 R(g.)1.666 E F1(Xlib)3.275 E F0 3.275(\). Elk)B .775 +(has no f)3.275 F .775(acility to directly import `)-.1 F(`for)-.74 E(-)-.2 E +(eign')72 726.4 Q 2.548('f)-.74 G .048(unctions \(although one such f)101.018 +726.4 R .048(acility has been contrib)-.1 F .048(uted as an e)-.2 F .048 +(xtension to Elk\).)-.15 F .049(Therefore, a small)5.048 F EP +%%Page: 6 6 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-6-)279.67 56 S .795(amount of code acting as `)72 +92 R(`glue')-.74 E 3.295('b)-.74 G .794 +(etween Elk and the library has to be written to mak)215.81 92 R 3.294(et)-.1 G +.794(he contents of a)438.578 92 R 1.079(library a)72 112 R -.25(va)-.2 G 1.079 +(ilable to Scheme programmers.).25 F 1.079(The main purpose of this interf) +6.079 F 1.08(ace code is to check the ar)-.1 F(gu-)-.18 E .082 +(ments supplied to the library functions, to con)72 132 R -.15(ve)-.4 G .082 +(rt Scheme objects into C types, and to con).15 F -.15(ve)-.4 G .081 +(rt the results of).15 F 2.473(library functions back into Scheme objects.)72 +152 R(Such)7.473 E/F1 10/Times-Italic@0 SF(libr)4.974 E 2.474(ary e)-.15 F +(xtensions)-.2 E F0 2.474(often act as an additional layer)4.974 F .372 +(between the application to be e)72 172 R .372 +(xtended and the libraries used by the application; the)-.15 F 2.872(ya)-.15 G +(llo)424.068 172 Q 2.871(wt)-.25 G .371(he application)447.249 172 R 1.386 +(writers to abstract from the details of the libraries.)72 192 R 1.386 +(Although it is useful to distinguish between)6.386 F F1(libr)3.887 E(ary)-.15 +E F0 -.15(ex)72 212 S .049(tensions and e).15 F .049(xtensions interf)-.15 F +.049(acing to)-.1 F F1(applications)2.549 E F0 2.549(,t)C .049 +(here is no technical dif)291.604 212 R .048(ference \212 in both cases a col-) +-.25 F(lection of types and functions is made a)72 232 Q -.25(va)-.2 G +(ilable to the Scheme w).25 E(orld.)-.1 E .987(Since man)97 255.6 R 3.487(yo) +-.15 G 3.487(ft)153.264 255.6 S(oday')162.861 255.6 Q 3.487(sa)-.55 G .987 +(pplications need to interact with the X W)196.898 255.6 R(indo)-.4 E 3.487(wS) +-.25 G .988(ystem, library e)401.904 255.6 R(xtensions)-.15 E .367 +(are included with Elk that interf)72 275.6 R .367(ace to the X11 `)-.1 F +(`Xlib')-.74 E 2.866('\()-.74 G .366(similar in its functionality to `)299.038 +275.6 R(`CLX')-.74 E 2.866('[)-.74 G .366(CLX 1991],)455.304 275.6 R -.2(bu)72 +295.6 S 3.518(ti).2 G 1.018 +(mplemented on top of Xlib\), to the X11 toolkit intrinsics \(`)90.878 295.6 R +(`Xt')-.74 E 1.019('\), and to the Athena and OSF/Motif)-.74 F(widget sets.)72 +315.6 Q .269(In addition, the Elk UNIX e)97 339.2 R .269(xtension pro)-.15 F +.268(vides Scheme access to most UNIX system calls and operat-)-.15 F 1.331 +(ing system interf)72 359.2 R 1.331(ace C library functions)-.1 F/F2 8 +/Times-Roman@0 SF(1)-3.2 I F0 6.331(.T)3.2 K 1.331(he e)256.086 359.2 R 1.331 +(xtension supports a wide range of dif)-.15 F 1.332(ferent UNIX plat-)-.25 F +.897(forms without restricting its functionality to the lo)72 379.2 R .896 +(west common denominator or the POSIX 1003.1 func-)-.25 F 3.229(tions. T)72 +399.2 R 3.229(of)-.8 G .729(acilitate writing portable Scheme programs, the e) +116.448 399.2 R .729(xtension attempts to hide dif)-.15 F .73(ferences between) +-.25 F(the types of supported UNIX \215a)72 419.2 Q -.2(vo)-.2 G(rs.).2 E/F3 10 +/Times-Bold@0 SF 2.5(3. Using)72 459.2 R(Elk in A)2.5 E(pplications)-.25 E F0 +.188(In contrast to other e)97 482.8 R .188 +(xtension language implementations \(e.)-.15 F .187(g. Tcl\), Elk does not pro) +1.666 F .187(vide its function-)-.15 F .501 +(ality in the form of a library that is statically link)72 502.8 R .501 +(ed into an application to be e)-.1 F 3.001(xtended. Instead,)-.15 F .502 +(the object)3.001 F 1.438 +(modules comprising the application and all required library e)72 522.8 R 1.437 +(xtensions are dynamically link)-.15 F 1.437(ed with and)-.1 F 2.512 +(loaded into the running Scheme interpreter)72 542.8 R 7.512(.T)-.55 G 5.012 +(oa)270.692 542.8 S 2.512(ccomplish this, the)285.144 542.8 R F1(load)5.012 E +F0(primiti)5.012 E 2.812 -.15(ve o)-.25 H 5.012(fE).15 G 2.512(lk has been) +453.986 542.8 R -.15(ex)72 562.8 S .071 +(tended to load not only \214les containing Scheme code, b).15 F .071 +(ut also object \214les \212 compiled e)-.2 F .071(xtensions written)-.15 F +.567(in C or C++.)72 582.8 R .568(Dynamic loading enables applications to load\ + less frequently used modules into the running)5.567 F .268(program only on de\ +mand; such an application is initially smaller than the equi)72 602.8 R -.25 +(va)-.25 G .268(lent statically link).25 F .268(ed appli-)-.1 F +(cation \(where all modules must be combined into one lar)72 622.8 Q(ge e)-.18 +E -.15(xe)-.15 G(cutable \214le\).).15 E 2.292 +(Dynamic loading of object \214les is often used together with the)97 646.4 R +F1(dump)4.793 E F0(primiti)4.793 E 2.593 -.15(ve t)-.25 H 2.293(hat creates an) +.15 F -.15(exe)72 666.4 S 1.175(cutable \214le from the running interpreter).15 +F 3.675(,s)-.4 G 1.175(imilar to)259.7 666.4 R F1(une)3.675 E(xec)-.2 E F0 +1.175(of GNU Emacs or)3.675 F F1(dumplisp)3.675 E F0 1.175(in some Lisp)3.675 F +.32 LW 76 676.4 72 676.4 DL 80 676.4 76 676.4 DL 84 676.4 80 676.4 DL 88 676.4 +84 676.4 DL 92 676.4 88 676.4 DL 96 676.4 92 676.4 DL 100 676.4 96 676.4 DL 104 +676.4 100 676.4 DL 108 676.4 104 676.4 DL 112 676.4 108 676.4 DL 116 676.4 112 +676.4 DL 120 676.4 116 676.4 DL 124 676.4 120 676.4 DL 128 676.4 124 676.4 DL +132 676.4 128 676.4 DL 136 676.4 132 676.4 DL 140 676.4 136 676.4 DL 144 676.4 +140 676.4 DL/F4 6/Times-Roman@0 SF(1)82 685.8 Q F2 .161(The UNIX e)4 2.4 N .162 +(xtension de\214nes procedures for lo)-.12 F(w-le)-.2 E -.12(ve)-.2 G .162 +(l, \214le-descriptor).12 F .162 +(-based I/O; creation of pipes; \214le/record locking;)-.16 F 1.025(\214le and\ + directory system calls; process creation and control; signal handling; error \ +handling; and obtaining information)72 698.2 R +(about date, time, users, limits, process resources, etc.)72 708.2 Q EP +%%Page: 7 7 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-7-)279.67 56 S 3.632(systems. The)72 92 R/F1 10 +/Times-Italic@0 SF(dump)3.632 E F0(primiti)3.632 E 1.432 -.15(ve o)-.25 H 3.632 +(fE).15 G 1.132(lk dif)215.31 92 R 1.132(fers from e)-.25 F 1.132 +(xisting, similar mechanisms in that the ne)-.15 F 1.132(wly created)-.25 F +-.15(exe)72 112 S .23(cutable, when called, starts at the point where).15 F F1 +(dump)2.73 E F0 -.1(wa)2.73 G 2.73(sc).1 G .23(alled in the original in)319.95 +112 R -.2(vo)-.4 G .23(cation \(as opposed to).2 F .012(the program')72 132 R +(s)-.55 E F1(main)2.512 E F0 .012(entry point\).)2.512 F .013 +(Here the return v)5.013 F .013(alue of)-.25 F F1(dump)2.513 E F0 .013(is `) +2.513 F(`true')-.74 E .013(', while in the original in)-.74 F -.2(vo)-.4 G .013 +(cation it).2 F(returns `)72 152 Q(`f)-.74 E(alse')-.1 E 2.5('\212n)-.74 G +(ot unlik)152.89 152 Q 2.5(et)-.1 G(he UNIX)193.35 152 Q F1(fork)2.5 E F0 +(system call.)2.5 E/F2 10/Times-Bold@0 SF 2.5(3.1. Dynamic)72 192 R +(Loading and Dump in Cooperation)2.5 E F0 1.852 -.8(To g)97 215.6 T .252 +(enerate a ne).8 F 2.752(wi)-.25 G .252(nstance of an application one w)175.818 +215.6 R .252(ould typically in)-.1 F -.2(vo)-.4 G .452 -.1(ke t).2 H .252 +(he Scheme interpreter).1 F 2.752(,l)-.4 G(oad)489.56 215.6 Q 1.725 +(all object modules and all Scheme code required initially)72 235.6 R 4.225(,p) +-.65 G 1.726(erform all initializations that can survi)324.625 235.6 R 2.026 +-.15(ve a)-.25 H F1(dump)72 255.6 Q F0 4.172(,a)C 1.672(nd \214nally dump an i\ +mage of the running interpreter containing all the loaded code into a ne) +105.332 255.6 R(w)-.25 E -.15(exe)72 275.6 S .708(cutable on disk.).15 F .708 +(The use of)5.708 F F1(dump)3.208 E F0 -.2(avo)3.208 G .708 +(ids time-consuming acti).2 F .708 +(vities such as loading of object \214les and)-.25 F .326 +(other initializations on each startup.)72 295.6 R .325(The dumped e)5.326 F +-.15(xe)-.15 G .325(cutable, when started, resumes after the call to).15 F F1 +(dump)2.825 E F0(;)A .206(at this point one w)72 315.6 R .206 +(ould perform the remaining, en)-.1 F .206 +(vironment-dependent initializations and \214nally in)-.4 F -.2(vo)-.4 G .407 +-.1(ke t).2 H(he).1 E(application')72 335.6 Q 3.39(s`)-.55 G .89 +(`main program')129.09 335.6 R 3.39('\()-.74 G -.834(e. g.)202.33 335.6 R .89 +(enter the X toolkit')3.39 F 3.39(se)-.55 G -.15(ve)311.796 335.6 S .889 +(nt processing main loop\).).15 F .889(Listing 1 sho)5.889 F .889(ws a)-.25 F +(\(slightly simpli\214ed\) Scheme program that generates and starts a ne)72 +355.6 Q 2.5(wi)-.25 G(nstance of an application.)351.16 355.6 Q .242(On system\ +s that do not support dynamic linking and loading of object \214les \(such as \ +older v)97 379.2 R .242(ersions of)-.15 F 1.294(UNIX System V\) or where)72 +399.2 R F1(dump)3.794 E F0 1.294(cannot be implemented, the interpreter k)3.794 +F 1.294(ernel and the application and)-.1 F(library e)72 419.2 Q +(xtensions are link)-.15 E(ed statically and combined into one e)-.1 E -.15(xe) +-.15 G(cutable.).15 E 1.1(In an)97 442.8 R 3.6(ye)-.15 G -.15(ve)131.01 442.8 S +1.099(nt, in an application using Elk, the control initially rests in the Sche\ +me interpreter).15 F 6.099(.T)-.55 G(he)494.56 442.8 Q 1.055 +(interpreter acts as the `)72 462.8 R 1.055(`main program')-.74 F 3.555('o)-.74 +G 3.556(ft)241.8 462.8 S 1.056(he application; it is the interpreter')251.466 +462.8 R(s)-.55 E F1(main\(\))3.556 E F0 1.056(function which is)3.556 F(in)72 +482.8 Q -.2(vo)-.4 G -.1(ke).2 G 3.417(do).1 G 3.417(ns)111.937 482.8 S .917 +(tartup of the program.)124.244 482.8 R .916(Therefore the \214rst code to e) +5.917 F -.15(xe)-.15 G .916(cute in an application is Scheme code;).15 F 1.318 +(this Scheme code pro)72 502.8 R 1.319 +(vides the shell functionality of the application \(hence it is called)-.15 F +F1 1.319(shell code)3.819 F F0 3.819(\). The)B .641 +(shell code may perform a fe)72 522.8 R 3.141(ws)-.25 G .641 +(imple tasks, for instance, load a user)201.116 522.8 R(-pro)-.2 E .64 +(vided initialization \214le containing)-.15 F .456 +(customization code for the application and then enter the application')72 +542.8 R 2.957(sm)-.55 G .457(ain loop, or it may be as comple)367.631 542.8 R +(x)-.15 E(as in ISO)72 562.8 Q(TEXT)-.4 E 2.5(,w)-.74 G +(here the entire X-based user interf)145.85 562.8 Q(ace is written in Scheme.) +-.1 E F2 2.5(3.2. Making)72 602.8 R(Oneself Kno)2.5 E +(wn to the Extension Language)-.1 E F0 .527(The application, as it is link)97 +626.4 R .526(ed with the e)-.1 F .526(xtension language interpreter)-.15 F +3.026(,h)-.4 G .526(as full access to all e)391.27 626.4 R(xternal)-.15 E 1.528 +(functions and v)72 646.4 R 1.528(ariables of the interpreter k)-.25 F 4.029 +(ernel. The)-.1 F(interpreter)4.029 E 4.029(,o)-.4 G 4.029(nt)352.157 646.4 S +1.529(he other hand, does not ha)363.966 646.4 R 1.829 -.15(ve a)-.2 H -.15(ny) +.15 G(kno)72 666.4 Q 1.171(wledge of the contents of dynamically link)-.25 F +1.17(ed and loaded object modules; all it sees of an object \214le)-.1 F .903 +(being loaded is the \214le')72 686.4 R 3.403(ss)-.55 G .903(ymbol table.) +180.125 686.4 R 2.503 -.8(To o)5.903 H .903(btain `).8 F(`hooks')-.74 E 3.403 +('i)-.74 G .903(nto a ne)320.96 686.4 R .903(wly loaded e)-.25 F .904 +(xtension, the interpreter)-.15 F .661(searches the symbol table of each objec\ +t \214le being loaded for functions whose names start with the pre\214x)72 +706.4 R -.74(``)72 726.4 S(elk_init_').74 E 5.542('\()-.74 G F1 -.2(ex)128.272 +726.4 S 3.042(tension initialization functions).2 F F0 5.543(\)a)C 3.043(nd in) +278.039 726.4 R -.2(vo)-.4 G -.1(ke).2 G 5.543(st).1 G 3.043 +(hese functions as the)332.315 726.4 R 5.543(ya)-.15 G 3.043(re encountered.) +439.317 726.4 R EP +%%Page: 8 8 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-8-)279.67 56 S(__________________________________\ +____________________________________________________)74 105.6 Q/F1 8/Courier@0 +SF(;;; Load initially required object files and Scheme files of)100.346 127.103 +Q(;;; application and dump image into executable file.)100.346 140.103 Q +(;;; Dumped file enters application's main loop on startup.)100.346 153.103 Q +(\(load 'main.o\))100.346 172.863 Q 4.8(;i)191.546 172.863 S +(nitial object modules)205.946 172.863 Q(\(load 'edit.o\))100.346 185.863 Q +(\(load 'x11.o\))100.346 198.863 Q 4.8(;\()191.546 198.863 S 4.8(al)205.946 +198.863 S(ibrary extension\))220.346 198.863 Q(...)100.346 211.863 Q +(\(load 'ui.scm\))100.346 224.863 Q 4.8(;i)191.546 224.863 S +(nitial Scheme files)205.946 224.863 Q(\(load 'custom.scm\))100.346 237.863 Q +(\(load 'x11.scm\))100.346 250.863 Q(...)100.346 263.863 Q +(\(initialize-application\))100.346 276.863 Q(\(if \(dump 'a.out\))100.346 +296.623 Q 86.4(\(begin ;)119.546 309.623 R(dumped a.out starts execution here) +4.8 E(\(initialize-depending-on-environment\))129.146 322.623 Q +(\(main-loop-of-application\))129.146 335.623 Q(\(exit\)\)\))129.146 348.623 Q +(;; Original invocation gets here when dump is finished.)100.346 368.383 Q +(We're done.)9.6 E/F2 9/Times-Bold@0 SF(Listing 1:)179.518 402.383 Q/F3 9 +/Times-Roman@0 SF(Scheme code to generate and start an application)4.5 E/F4 8 +/Times-Italic@0 SF(Note:)100.346 440.383 Q/F5 8/Times-Roman@0 SF .948 +(Filenames can be gi)2.948 F -.12(ve)-.2 G 2.948(na).12 G 2.948(ss)205.414 +440.383 S .948(ymbols \(besides the usual string literals\).)214.586 440.383 R +2.948(Am)4.948 G .948(ore meaningful name than a.out)370.326 440.383 R -.08(wo) +100.346 458.383 S(uld probably be chosen in practice.).08 E F0(_______________\ +_______________________________________________________________________)74 +475.983 Q(Lik)72 515.983 Q -.25(ew)-.1 G .633(ise, to support e).25 F .633 +(xtensions written in C++, an)-.15 F 3.133(yC)-.15 G .632 +(++ static constructors found in the symbol table are)293.244 515.983 R 2.675 +(called. When)72 535.983 R(link)2.675 E .175(ed statically with its e)-.1 F +.176(xtensions, the interpreter must scan its o)-.15 F .176 +(wn symbol table on startup)-.25 F .039(to \214nd and in)72 555.983 R -.2(vo) +-.4 G .239 -.1(ke t).2 H .039(he initialization functions.).1 F .038 +(\(Similar support is a)5.039 F -.25(va)-.2 G .038(ilable for calling e).25 F +.038(xtension \214nalization)-.15 F +(functions and C++ static destructors on termination.\))72 575.983 Q 1.219 +(Besides initializing pri)97 599.583 R -.25(va)-.25 G 1.219 +(te data of the modules being loaded, these initialization functions re).25 F +(gister)-.15 E 1.83(with the interpreter the Scheme primiti)72 619.583 R -.15 +(ve)-.25 G 4.33(sa).15 G 1.83(nd Scheme data types implemented by the e)258.11 +619.583 R 4.33(xtensions. T)-.15 F(o)-.8 E .897(enable e)72 639.583 R .897 +(xtensions to re)-.15 F .897(gister ne)-.15 F 3.397(wp)-.25 G(rimiti)216.185 +639.583 Q 1.197 -.15(ve p)-.25 H .897(rocedures and types, the interpreter k) +.15 F .897(ernel e)-.1 F .898(xports tw)-.15 F 3.398(of)-.1 G(unc-)486.23 +639.583 Q(tions:)72 659.583 Q/F6 10/Times-Italic@0 SF(De\214ne_Primitive\(\)) +3.383 E F0 .883(to re)3.383 F .883(gister a ne)-.15 F 3.383(wS)-.25 G .883 +(cheme primiti)253.538 659.583 R 1.183 -.15(ve a)-.25 H(nd).15 E F6(De\214ne_T) +3.383 E(ype\(\))-.74 E F0 .883(to re)3.383 F .883(gister a ne)-.15 F 3.382(wS) +-.25 G(cheme)477.9 659.583 Q .027(data type.)72 679.583 R .027 +(Both functions tak)5.027 F 2.527(ep)-.1 G .027(ointers to C functions as ar) +201.745 679.583 R .027(guments that implement the ne)-.18 F 2.527(wp)-.25 G +(rimiti)447.125 679.583 Q .327 -.15(ve o)-.25 H 2.528(rt).15 G(he)494.56 +679.583 Q(basic access functions of the type \(such as the print function and \ +the equality predicates\).)72 699.583 Q EP +%%Page: 9 9 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-9-)279.67 56 S 2.5(As)97 92 S(imple e)110.61 92 Q +(xample for a library e)-.15 E(xtension is presented in Appendix A.)-.15 E/F1 +10/Times-Bold@0 SF 2.5(4. Notes)72 132 R(on the Implementation)2.5 E F0 .638 +(Designing Elk, not as another Scheme implementation, b)97 155.6 R .638 +(ut as an e)-.2 F .638(xtension language kit, pro)-.15 F .637(vided a)-.15 F +.344(design space dif)72 175.6 R .344(ferent from that traditionally a)-.25 F +-.25(va)-.2 G .344(ilable for Lisp implementations.).25 F .345 +(The necessary de)5.344 F(viations)-.25 E 1.42 +(from the treaded paths of UNIX programming unco)72 195.6 R -.15(ve)-.15 G 1.42 +(red limitations in portability).15 F 3.92(,a)-.65 G(ggra)424.96 195.6 Q -.25 +(va)-.2 G 1.42(ted by badly).25 F 1.078(tested corners of standard UNIX f)72 +215.6 R 3.578(acilities. This)-.1 F 1.079 +(section discusses the more interesting e)3.579 F 1.079(xamples of such)-.15 F +(issues.)72 235.6 Q F1 2.5(4.1. Implementing)72 275.6 R(Continuations)2.5 E F0 +.267(Finding a w)97 299.2 R .267(ay to ef)-.1 F .267 +(\214ciently implement Scheme')-.25 F(s)-.55 E/F2 10/Times-Italic@0 SF +(continuations)2.767 E F0 .266(called for considerable ef)2.767 F .266 +(forts during)-.25 F .223(the design phase of Elk.)72 319.2 R .224 +(Continuations are a po)5.224 F .224(werful language feature; the)-.25 F 2.724 +(ys)-.15 G .224(upport the de\214nition of arbi-)389.224 319.2 R .135 +(trary control structures such as non-local loop and procedure e)72 339.2 R +(xits,)-.15 E F2(br)2.635 E(eak)-.37 E F0(and)2.635 E F2 -.37(re)2.635 G(turn) +.37 E F0 .134(as in C, e)2.634 F .134(xception han-)-.15 F(dling f)72 359.2 Q +(acilities, e)-.1 E +(xplicit backtracking, co-routines, or multitasking based on)-.15 E F2(engines) +2.5 E F0([Dyb)2.5 E(vig 1987].)-.15 E(The primiti)97 382.8 Q .3 -.15(ve p)-.25 +H(rocedure).15 E/F3 9/Courier@0 SF(\(call-with-current-continuation)100.346 +404.303 Q/F4 9/Times-Italic@0 SF -.333(re)5.4 G(ceiver).333 E F3(\))A F0 1.045 +(packages up the current e)72 434.303 R -.15(xe)-.15 G 1.046 +(cution state of the program into an object \(the).15 F F2(continuation)3.546 E +F0(or)3.546 E F2 1.046(escape pr)3.546 F(oce-)-.45 E(dur)72 454.303 Q(e)-.37 E +F0 2.868(\)a)C .368(nd passes this object as an ar)100.598 454.303 R .368 +(gument to)-.18 F F2 -.37(re)2.868 G(ceiver).37 E F0 .367 +(\(which is a procedure of one ar)2.868 F 2.867(gument\). Continua-)-.18 F .584 +(tions are \214rst-class objects in Scheme; the)72 474.303 R 3.084(ya)-.15 G +.584(re represented as procedures of one ar)255.638 474.303 R .584 +(gument \(not to be con-)-.18 F .128(fused with the)72 494.303 R F2 -.37(re) +2.627 G(ceiver).37 E F0 2.627(procedure\). Each)2.627 F .127 +(time a continuation procedure is called with a v)2.627 F .127 +(alue, it causes this)-.25 F -.25(va)72 514.303 S .083 +(lue to be returned as the result of the).25 F F2(call-with-curr)2.584 E +(ent-continuation)-.37 E F0 -.15(ex)2.584 G .084 +(pression which created this contin-).15 F 2.669(uation. If)72 534.303 R .169 +(the procedure)2.669 F F2 -.37(re)2.669 G(ceiver).37 E F0 .169 +(terminates normally \(i.)2.669 F .169(e. does not in)1.666 F -.2(vo)-.4 G .369 +-.1(ke t).2 H .169(he continuation gi).1 F -.15(ve)-.25 G 2.669(nt).15 G 2.669 +(oi)470.052 534.303 S .169(t\), the)480.501 534.303 R -.25(va)72 554.303 S +(lue returned by).25 E F2(call-with-curr)2.5 E(ent-continuation)-.37 E F0 +(is the return v)2.5 E(alue of)-.25 E F2 -.37(re)2.5 G(ceiver).37 E F0(.)A .731 +(As long as the use of a continuation is con\214ned to the runtime of the)97 +577.903 R F2 -.37(re)3.232 G(ceiver).37 E F0(procedure,)3.232 E F2(call-with-) +3.232 E(curr)72 597.903 Q(ent-continuation)-.37 E F0 .211 +(is similar in its functionality to)2.711 F F2(catc)2.711 E(h/thr)-.15 E(ow) +-.45 E F0 .211(in most Lisp dialects or)2.711 F F2(setjmp/longjmp)2.71 E F0(in) +2.71 E 2.966(C. Ho)72 617.903 R(we)-.25 E -.15(ve)-.25 G 1.267 -.4(r, c).15 H +.467(ontinuations, lik).4 F 2.967(ea)-.1 G .467(ll procedures in Scheme, ha) +209.367 617.903 R .767 -.15(ve i)-.2 H .467(nde\214nite e).15 F .467 +(xtent \(unlimited lifetime\); the)-.15 F(y)-.15 E .221(can be stored in v)72 +637.903 R .221(ariables and called an arbitrary number of times, e)-.25 F -.15 +(ve)-.25 G 2.72(na).15 G .22(fter the)366.92 637.903 R F2 -.37(re)2.72 G +(ceiver).37 E F0 .22(and the enclosing)2.72 F F2(call-with-curr)72 657.903 Q +(ent-continuation)-.37 E F0(ha)2.65 E .45 -.15(ve a)-.2 H .15 +(lready terminated.).15 F .15(Listing 2 sho)5.15 F .15 +(ws a program fragment where contin-)-.25 F .278(uations are used to get back \ +an arbitrary number of times into the middle of an e)72 677.903 R .277 +(xpression whose computa-)-.15 F .897(tion has already been completed.)72 +697.903 R .897(While not particularly useful, this e)5.897 F .897 +(xample demonstrates that continua-)-.15 F .313(tions can be used to b)72 +717.903 R .313(uild control structures that cannot be implemented by means of \ +less general language)-.2 F(features lik)72 737.903 Q 2.5(ec)-.1 G(atch/thro) +127.99 737.903 Q 2.5(wo)-.25 G 2.5(rs)178.01 737.903 S(etjmp/longjmp.)187.73 +737.903 Q EP +%%Page: 10 10 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(0-)288 56 S(___________________\ +___________________________________________________________________)74 105.6 Q +/F1 8/Courier@0 SF(\(define my-function)100.346 127.103 Q(\(lambda \(n m\)) +109.946 140.103 Q(\(+ n \(mark m\)\)\))119.546 153.103 Q 4.8(;r)287.546 153.103 +S(eturn n+m)301.946 153.103 Q(\(define get-back "uninitialized"\))100.346 +172.863 Q(\(define mark)100.346 192.623 Q 4.8(;i)287.546 192.623 S +(dentity function, but also)301.946 192.623 Q(\(lambda \(value\))109.946 +205.623 Q 4.8(;a)287.546 205.623 S(ssign current continuation)301.946 205.623 Q +14.4(\(call-with-current-continuation ;)119.546 218.623 R(to a global variable) +4.8 E(\(lambda \(continuation\))129.146 231.623 Q +(\(set! get-back continuation\))138.746 244.623 Q 4.8(;\()287.546 244.623 S +(assign it\))301.946 244.623 Q(value\)\)\)\))138.746 257.623 Q +(\(my-function 10 20\))100.346 284.143 Q 4.8(;i)287.546 284.143 S +(nvoke my-function)301.946 284.143 Q/F2 8/Times-Italic@0 SF(prints 30)407.546 +284.143 Q F1(\(get-back 5\))100.346 297.143 Q 4.8(;r)287.546 297.143 S +(esume with new value)301.946 297.143 Q F2(prints 15)9.6 E F1(\(get-back 0\)) +100.346 310.143 Q 4.8(;.)287.546 310.143 S(..once more)301.946 310.143 Q F2 +(prints 10)407.546 310.143 Q/F3 9/Times-Bold@0 SF(Listing 2:)191.686 344.143 Q +/F4 9/Times-Roman@0 SF(Using continuations with unlimited e)4.5 E(xtent)-.135 E +F0(___________________________________________________________________________\ +___________)74 367.743 Q .933(The dif)97 411.343 R .933(ferent approaches appl\ +icable to implementing continuations are intimately tied to the strate-)-.25 F +.525(gies used for interpreting the language itself.)72 431.343 R .525 +(Scheme interpreters generally emplo)5.525 F 3.025(yal)-.1 G -.15(ex)425.91 +431.343 S .525(ical analyzer and).15 F .392(parser \212 the)72 451.343 R/F5 10 +/Times-Italic@0 SF -.37(re)2.892 G(ader).37 E F0 2.892<8a74>2.892 G 2.892(or) +172.18 451.343 S .393 +(ead and parse the Scheme source code and produce an intermediate representa-) +183.402 451.343 R 1.019(tion of the program.)72 471.343 R 1.019 +(During this phase, symbols are collected in a global hash table \(in Lisp jar) +6.019 F 1.018(gon, the)-.18 F .307(symbols are)72 491.343 R F5(interned)2.807 E +F0 .307(\), and a tree structure representing the program')B 2.808(sS)-.55 G +(-e)361.402 491.343 Q .308(xpressions is b)-.15 F .308(uilt up on the heap)-.2 +F 1.549(of the interpreter)72 511.343 R 6.549(.T)-.55 G 1.548(he majority of i\ +nterpreters compile this intermediate representation into an abstract)156.907 +511.343 R 1.006(machine language \(such as)72 531.343 R F5 1.006(byte code) +3.506 F F0 3.507(\). The)B -.25(eva)3.507 G 1.007 +(luator is then implemented as an abstract machine which).25 F .75 +(interprets the lo)72 551.343 R(w-le)-.25 E -.15(ve)-.25 G 3.25(ll).15 G .75 +(anguage; this machine \212 usually a simple stack machine \212 may e)171.64 +551.343 R -.15(ve)-.25 G 3.25(nb).15 G 3.25(ei)470.2 551.343 S(mple-)480.67 +551.343 Q(mented in hardw)72 571.343 Q(are.)-.1 E .17 +(In an abstract machine implementation, the straightforw)97 594.943 R .17 +(ard approach to implement)-.1 F F5(call-with-curr)2.67 E(ent-)-.37 E +(continuation)72 614.943 Q F0 1.993 +(is to package up the contents of the abstract machine')4.493 F 4.493(sr)-.55 G +-.15(eg)370.273 614.943 S 1.993(isters \(program counter).15 F 4.492(,s)-.4 G +(tack)487.34 614.943 Q(pointer)72 634.943 Q 2.792(,e)-.4 G .292 +(tc.\) and runtime stack.)109.662 634.943 R .292(Since continuations ha)5.292 F +.592 -.15(ve i)-.2 H .293(nde\214nite e).15 F .293(xtent, it w)-.15 F .293 +(ould not suf)-.1 F .293(\214ce to just cap-)-.25 F .993(ture its re)72 654.943 +R .993(gisters \(as the C library function)-.15 F F5(setjmp)3.493 E F0 .993 +(does for the real machine\).)3.493 F 2.592 -.8(To b)5.992 H 3.492(ea).8 G .992 +(ble to continue the)426.864 654.943 R -.25(eva)72 674.943 S .377 +(luation of procedures that ha).25 F .677 -.15(ve a)-.2 H .378 +(lready returned and whose frames are therefore no longer on the stack,).15 F +4.157(ac)72 694.943 S 1.657 +(ontinuation must also embody the contents of the abstract machine')85.037 +694.943 R 4.156(ss)-.55 G 1.656(tack at the time it is created.)381.584 694.943 +R .197(When a continuation is applied, the machine resumes the `)72 714.943 R +(`frozen')-.74 E 2.697('c)-.74 G .198(omputation by restoring the sa)348.81 +714.943 R -.15(ve)-.2 G 2.698(dr).15 G -.15(eg)491.38 714.943 S(-).15 E +(isters and stack contents of the abstract machine.)72 734.943 Q EP +%%Page: 11 11 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(1-)288 56 S .503(Just sa)97 92 R +.503(ving the abstract machine')-.2 F 3.003(ss)-.55 G .503(tate w)241.245 92 R +.503(ould not w)-.1 F .503(ork in Elk, because at the time a continuation is) +-.1 F .652(created, arbitrary library functions may be acti)72 112 R .952 -.15 +(ve i)-.25 H 3.152(na).15 G .652(ddition to Scheme primiti)289.256 112 R -.15 +(ve)-.25 G 3.152(s. F).15 F .653(or instance, consider)-.15 F 1.127 +(the Elk interf)72 132 R 1.127(ace to the `)-.1 F(`Xt')-.74 E 3.627('t)-.74 G +1.127(oolkit intrinsics of the X windo)199.372 132 R 3.627(ws)-.25 G 3.626 +(ystem. Here,)344.774 132 R 3.626(at)3.626 G 1.126(ypical scenario is that) +413.692 132 R .332(some Scheme procedure in)72 152 R -.2(vo)-.4 G -.1(ke).2 G +2.832(st).1 G .332(he primiti)209.268 152 R .632 -.15(ve t)-.25 H .332 +(hat enters the toolkit').15 F 2.832(se)-.55 G -.15(ve)360.05 152 S .332 +(nt dispatching main loop \().15 F/F1 10/Times-Italic@0 SF(XtApp-)A +(MainLoop\(\))72 172 Q F0 3.76(\). When)B 1.26(an e)3.76 F -.15(ve)-.25 G 1.26 +(nt arri).15 F -.15(ve)-.25 G 3.76(s\().15 G 1.259(for e)232.18 172 R 1.259 +(xample, a mouse b)-.15 F 1.259(utton press e)-.2 F -.15(ve)-.25 G 1.259 +(nt\), the toolkit').15 F 3.759(sm)-.55 G 1.259(ain loop)470.241 172 R(in)72 +192 Q -.2(vo)-.4 G -.1(ke).2 G 3.313(sac).1 G .814 +(allback function, which in turn calls a user)117.916 192 R .814 +(-supplied Scheme procedure to be e)-.2 F -.15(xe)-.15 G .814(cuted when a).15 +F .417(mouse b)72 212 R .417(utton is pressed.)-.2 F .416 +(This Scheme procedure might in turn in)5.417 F -.2(vo)-.4 G .616 -.1(ke y).2 H +.416(et another function from the `).1 F(`Xt')-.74 E(')-.74 E(library)72 232 Q +3.547(,a)-.65 G 1.047(nd so on.)108.497 232 R 3.547(As)6.047 G 1.047(imilar e) +167.685 232 R 1.047(xample w)-.15 F 1.047(ould be a)-.1 F F1(qsort)3.547 E F0 +(or)3.547 E F1(ftw)3.547 E F0 -.15(ex)3.547 G 1.048 +(tension to Elk, where the user).15 F(-supplied)-.2 E(function called by the)72 +252 Q F1(qsort\(\))2.5 E F0(or)2.5 E F1(ftw\(\))2.5 E F0 2.5(Cl)2.5 G +(ibrary function w)235.32 252 Q(ould in)-.1 E -.2(vo)-.4 G .2 -.1(ke a p).2 H +(rocedure written in Scheme.).1 E 1.767(The interpreter')97 275.6 R 4.267(st) +-.55 G 1.766(hread of e)172.184 275.6 R -.15(xe)-.15 G 1.766(cution at an).15 F +4.266(yt)-.15 G 1.766(ime ob)286.924 275.6 R 1.766(viously in)-.15 F -.2(vo)-.4 +G(lv).2 E 1.766(es both Scheme primiti)-.15 F -.15(ve)-.25 G 4.266(sa).15 G(nd) +494 275.6 Q 1.013(library functions \(such as)72 295.6 R F1(XtAppMainLoop\(\)) +3.513 E F0(and)3.513 E F1(qsort\(\))3.513 E F0 1.014(in the e)3.514 F 1.014 +(xamples abo)-.15 F -.15(ve)-.15 G 3.514(\)i).15 G 3.514(na)406.818 295.6 S +3.514(na)419.772 295.6 S 1.014(rbitrary combina-)432.726 295.6 R 2.778 +(tion. Therefore,)72 315.6 R 2.778(ac)2.778 G .277 +(ontinuation must embody not only the e)151.694 315.6 R -.15(xe)-.15 G .277 +(cution state of the acti).15 F .577 -.15(ve S)-.25 H .277(cheme procedures,) +.15 F -.2(bu)72 335.6 S 2.868(ta).2 G .368(lso that of the currently acti) +91.888 335.6 R .668 -.15(ve l)-.25 H .368(ibrary functions \(such as local v) +.15 F .369(ariables used by the library functions\).)-.25 F .113(In the approa\ +ch used by Elk, a continuation is created by capturing the machine')72 355.6 R +2.613(sr)-.55 G -.15(eg)404.358 355.6 S .113(isters \212 lik).15 F(e)-.1 E F1 +(setjmp)2.613 E F0(in)2.613 E 3.006(Cd)72 375.6 S .507 +(oes \212 and the C runtime stack.)86.676 375.6 R .507 +(When a continuation is applied later)5.507 F 3.007(,t)-.4 G .507(he re)376.165 +375.6 R .507(gisters and the sa)-.15 F -.15(ve)-.2 G 3.007(ds).15 G(tack)487.34 +375.6 Q .197(contents are copied back.)72 395.6 R(Actually)5.197 E 2.697(,w) +-.65 G 2.697(ed)225.076 395.6 S .197(id not follo)237.213 395.6 R 2.697(wt)-.25 +G .197(he usual `)294.504 395.6 R .197(`abstract machine')-.74 F 2.697('t)-.74 +G .197(echnique in Elk at all;)415.442 395.6 R .285(instead, the Scheme e)72 +415.6 R -.25(va)-.25 G .285(luator directly interprets the intermediate repres\ +entation produced by the reader).25 F 5.286(.I)-.55 G(n)499 415.6 Q 3.412(as)72 +435.6 S .912(ense, it is the `)83.742 435.6 R(`real')-.74 E 3.412('m)-.74 G +.912(achine \(the hardw)180.132 435.6 R .912(are on which Elk is e)-.1 F -.15 +(xe)-.15 G .911(cuted\) that plays the role the abstract).15 F +(machine plays in implementations with byte-code compilation.)72 455.6 Q .463 +(Although the abstract machine technique usually yields f)97 479.2 R .463 +(aster e)-.1 F -.15(xe)-.15 G .463(cution of Scheme code, the perfor).15 F(-) +-.2 E .859(mance of Elk resembles that of e)72 499.2 R .859 +(xisting interpreters emplo)-.15 F .858 +(ying this technique, and the implementation of)-.1 F 1.178(Elk is simpler tha\ +n that of comparable interpreters using byte-code compilation.)72 519.2 R 1.179 +(While the technique to)6.179 F 2.486(implement continuations in Elk is not st\ +rictly portable \212 it is based on certain assumptions on the)72 539.2 R +(machine')72 559.2 Q 3.422(ss)-.55 G .922 +(tack layout and the C compiler and runtime en)119.862 559.2 R .923 +(vironment \212 it w)-.4 F .923(orks on most major machine)-.1 F +(architectures \(with tw)72 579.2 Q 2.5(oe)-.1 G +(xceptions, which are supported using)170.89 579.2 Q F1(asm)2.5 E F0 +(statements\).)2.5 E/F2 10/Times-Bold@0 SF 2.5(4.2. The)72 619.2 R +(Implementation of `)2.5 E(`dump')-.63 E(')-.63 E F0 1.01(Continuations pro)97 +642.8 R 1.01(vide a natural basis for implementing the e)-.15 F -.15(xe)-.15 G +1.01(cution-state preserving semantics of).15 F(the)72 662.8 Q F1(dump)3.205 E +F0(primiti)3.205 E -.15(ve)-.25 G 5.705(.W).15 G .705(hen called,)166.765 662.8 +R F1(dump)3.205 E F0(in)3.205 E -.2(vo)-.4 G -.1(ke).2 G(s).1 E F1 +(call-with-curr)3.205 E(ent-continuation)-.37 E F0 5.705(.T)C .706(he real w) +409.2 662.8 R .706(ork is done in)-.1 F(the)72 682.8 Q F1 -.37(re)3.605 G +(ceiver).37 E F0 1.105(procedure; it stores the ne)3.605 F 1.104 +(wly created continuation into a global v)-.25 F 1.104(ariable, sets a global) +-.25 F F1(was-)3.604 E(dumped)72 702.8 Q F0 .628 +(\215ag to indicate that a dump has tak)3.128 F .628(en place, creates an e)-.1 +F -.15(xe)-.15 G .629(cutable \214le from the image of the run-).15 F .361 +(ning process, and \214nally returns `)72 722.8 R(`f)-.74 E(alse')-.1 E 2.861 +('. The)-.74 F .361(return v)2.861 F .361(alue of the)-.25 F F1(dump)2.861 E F0 +(primiti)2.861 E .661 -.15(ve i)-.25 H 2.861(st).15 G .361(he return v)415.046 +722.8 R .361(alue of this)-.25 F EP +%%Page: 12 12 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(2-)288 56 S(call to)72 92 Q/F1 +10/Times-Italic@0 SF(call-with-curr)2.5 E(ent-continuation)-.37 E F0 2.5(,i)C +1.666(.e)228.85 92 S 2.5(.`)-1.666 G(`f)245.046 92 Q(alse')-.1 E 2.5('i)-.74 G +2.5(fad)278.356 92 S(ump has just been performed.)296.126 92 Q .175 +(When the interpreter \212 either the original program or a dumped e)97 115.6 R +-.15(xe)-.15 G .176(cutable \212 is started, it e).15 F(xamines)-.15 E(the)72 +135.6 Q F1(was-dumped)3.616 E F0 1.116(\215ag as its v)3.616 F 1.116 +(ery \214rst action.)-.15 F 1.116 +(If the \215ag is set, the running interpreter w)6.116 F 1.115 +(as started from a)-.1 F .335(dumped e)72 155.6 R -.15(xe)-.15 G 2.835 +(cutable. In).15 F .335(this case the interpreter immediately in)2.835 F -.2 +(vo)-.4 G -.1(ke).2 G .335(s, with an ar).1 F .336(gument of `)-.18 F(`true') +-.74 E .336(', the con-)-.74 F .242(tinuation that w)72 175.6 R .242(as sa)-.1 +F -.15(ve)-.2 G 2.742(da).15 G -.1(wa)175.688 175.6 S 2.742(yb).1 G 2.742(yac) +199.99 175.6 S .242(all to)219.354 175.6 R F1(dump)2.742 E F0 2.741(;t)C .241 +(his causes that call to)273.139 175.6 R F1(dump)2.741 E F0 .241 +(to \214nish and return `)2.741 F(`true')-.74 E 2.741('t)-.74 G(o)499 175.6 Q +1.092(its caller)72 195.6 R 6.092(.I)-.55 G 1.093(f, on the other hand, the) +118.624 195.6 R F1(was-dumped)3.593 E F0 1.093(\215ag is not set \(i.)3.593 F +1.093(e. the running process w)1.666 F 1.093(as not started)-.1 F +(from a dumped image\), the interpreter initializes and starts up as usual.)72 +215.6 Q .176(Before writing an image of the running process to disk,)97 239.2 R +F1(dump)2.676 E F0 .175(has to close all open Scheme \214le ports,)2.675 F +2.236(as open \214le descriptors w)72 259.2 R 2.236(ould not survi)-.1 F 2.537 +-.15(ve a)-.25 H F1(dump)4.887 E F0 4.737<8a74>4.737 G(he)309.954 259.2 Q 4.737 +(yw)-.15 G 2.237(ould no longer be v)336.101 259.2 R 2.237(alid in the dumped) +-.25 F -.15(exe)72 279.2 S 3.282(cutable. Generally).15 F 3.282(,t)-.65 G .781 +(his is true for all objects pointing to information maintained by the UNIX k) +170.084 279.2 R(ernel,)-.1 E .642(such as the current directory)72 299.2 R +3.142(,t)-.65 G .642 +(he current signal dispositions, resource limits, or interv)195.64 299.2 R .642 +(al timers.)-.25 F .642(Users and)5.642 F .389(implementors of Elk e)72 319.2 R +.389(xtensions must be a)-.15 F -.1(wa)-.15 G .389 +(re of this particular restriction.).1 F -.15(Fo)5.389 G 2.889(ri).15 G .388 +(nstance, users of the X11)401.638 319.2 R -.15(ex)72 339.2 S .486(tensions ha) +.15 F .786 -.15(ve t)-.2 H 2.986(om).15 G(ak)157.118 339.2 Q 2.986(es)-.1 G +.486(ure that, if)177.774 339.2 R F1(dump)2.987 E F0 .487 +(is to be used, connections to X-displays are only established in)2.987 F +(the dumped in)72 359.2 Q -.2(vo)-.4 G(cation.).2 E 1.871 -.8(To b)97 382.8 T +2.771(ea).8 G .271(ble to create an e)126.732 382.8 R -.15(xe)-.15 G .271 +(cutable from the running process,).15 F F1(dump)2.77 E F0 .27 +(has to open and read the a.out \214le)2.77 F .825 +(from which the running process w)72 402.8 R .825(as started \(actually)-.1 F +3.325(,i)-.65 G 3.325(ft)297.53 402.8 S .825(he system link)306.965 402.8 R +.825(er has been called to dynamically)-.1 F .291 +(load object \214les, the output of the most recent in)72 422.8 R -.2(vo)-.4 G +.29(cation of the link).2 F .29(er is used instead of the original a.out\).)-.1 +F .792(The symbol table of the ne)72 442.8 R 3.293(we)-.25 G -.15(xe)197.444 +442.8 S .793 +(cutable is copied from the a.out \214le of the running program; in addition,) +.15 F .431(the a.out header has to be read to obtain the length of the te)72 +462.8 R .43(xt se)-.15 F .43(gment and the start of the data se)-.15 F .43 +(gment of)-.15 F .282(the running process.)72 482.8 R 1.882 -.8(To d)5.282 H +2.782(os).8 G(o,)188.43 482.8 Q F1(dump)2.782 E F0 .282 +(has to determine the \214lename of the a.out \214le from which the process) +2.782 F -.1(wa)72 502.8 S 3.277(ss).1 G .777 +(tarted based on the information in)94.617 502.8 R F1(ar)3.277 E(gv[0])-.37 E +F0 .777(and in the P)3.277 F -1.11(AT)-.92 G 3.277(He)1.11 G -.4(nv)347.124 +502.8 S .777(ironment v).4 F 3.277(ariable. This)-.25 F .776(approach is)3.276 +F(ob)72 522.8 Q 1.314(viously based on se)-.15 F -.15(ve)-.25 G 1.314 +(ral prerequisites:).15 F F1(dump)3.814 E F0 1.314 +(must be able to access its a.out \214le \()3.814 F F1(ar)A(gv[0])-.37 E F0 +1.315(must carry)3.815 F .306(meaningful information; the \214le must be reada\ +ble\) and the running program')72 542.8 R 2.806(sa)-.55 G .306 +(.out \214le must not ha)392.27 542.8 R .606 -.15(ve b)-.2 H(een).15 E 3.871 +(stripped. It)72 562.8 R -.1(wo)3.871 G 1.371(uld ha).1 F 1.671 -.15(ve b)-.2 H +1.371(een adv).15 F 1.371(antageous for the implementation of)-.25 F F1(dump) +3.871 E F0 1.372(if the entire a.out \214le were)3.871 F +(automatically mapped into memory on startup, lik)72 582.8 Q 2.5(ei)-.1 G 2.5 +(ti)281.89 582.8 S 2.5(sd)289.95 582.8 S(one, for instance, in NeXT)301.34 +582.8 Q(-OS/Mach.)-.92 E F1(dump)97 606.4 Q F0 .042(combines the data se)2.542 +F .041(gment and the `)-.15 F(`bss')-.74 E 2.541('s)-.74 G -.15(eg)295.112 +606.4 S .041(ment of the running process into the data se).15 F(gment)-.15 E +.986(of the ne)72 626.4 R 3.486(we)-.25 G -.15(xe)123.708 626.4 S 3.486 +(cutable. If).15 F .987 +(Elk had a separate heap for storing constant objects \(future v)3.486 F .987 +(ersions may ha)-.15 F -.15(ve)-.2 G(one\),)72 646.4 Q F1(dump)2.653 E F0 .152 +(could place this read-only part of the memory into the ne)2.653 F 2.652(we) +-.25 G -.15(xe)362.97 646.4 S(cutable').15 E 2.652(st)-.55 G -.15(ex)413.242 +646.4 S 2.652(ts).15 G -.15(eg)431.854 646.4 S .152(ment to mak).15 F 2.652(ei) +-.1 G(t)501.22 646.4 Q 3.048(sharable. When)72 666.4 R .548(the interpreter') +3.048 F 3.048(sh)-.55 G .548(eap is written to disk,)211.932 666.4 R F1(dump) +3.048 E F0 .548(seeks o)3.048 F -.15(ve)-.15 G 3.048(rt).15 G .549 +(he unused portions of the heap,)376.276 666.4 R .032(so that f)72 686.4 R(ak) +-.1 E 2.531(eb)-.1 G .031 +(locks \(holes\) can be used for these parts of the \214le.)125.494 686.4 R +.031(This results in a considerable conserv)5.031 F(ation)-.25 E .051 +(of disk space in the \214nal e)72 706.4 R -.15(xe)-.15 G .052 +(cutable, as at least half of the interpreter').15 F 2.552(sh)-.55 G .052 +(eap is unused at an)360.974 706.4 R 2.552(yt)-.15 G .052(ime due to the) +446.904 706.4 R -.05(ga)72 726.4 S(rbage collection algorithm of Elk.).05 E EP +%%Page: 13 13 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(3-)288 56 S .149 +(Since the a.out formats used in the numerous v)97 92 R .149 +(ersions of UNIX dif)-.15 F .149(fer v)-.25 F(astly)-.25 E 2.649(,E)-.65 G .148 +(lk has to include sepa-)413.977 92 R 1.304(rate implementations of)72 112 R/F1 +10/Times-Italic@0 SF(dump)3.804 E F0 1.304 +(for the currently supported a.out formats.)3.804 F -1.11(Ve)6.304 G 1.304 +(rsion 2.2 of Elk handles the)1.11 F .672 +(BSD-style a.out format used in BSD and `)72 132 R(`deri)-.74 E -.15(ve)-.25 G +(d').15 E 3.171('U)-.74 G .671(NIX v)294.072 132 R .671 +(ersions \(such as SunOS 4.1\), the COFF a.out)-.15 F .29 +(format \(used in older releases of UNIX System V and in A/UX\), Con)72 152 R +.59 -.15(vex S)-.4 H(OFF).15 E 2.79(,E)-.8 G .29(xtended COFF of MIPS-)403.96 +152 R .327(based computers \(DEC, SGI\), and the ELF a.out format of System V \ +Release 4 and related UNIX v)72 172 R(ersions)-.15 E(\(Solaris 2.x, OSF/1\).)72 +192 Q/F2 10/Times-Bold@0 SF 2.5(4.3. Dynamic)72 232 R(Loading of Object Files) +2.5 E F0 1.358(When loading an object \214le during runtime, addresses within \ +this object \214le must be relocated to)97 255.6 R .534(their ne)72 275.6 R +3.034(wl)-.25 G .534(ocation in the program')115.588 275.6 R 3.034(sa)-.55 G +.534(ddress space.)222.154 275.6 R 2.134 -.8(To a)5.534 H(llo).8 E 3.034(we) +-.25 G .533(xtensions to directly reference objects of the)323.62 275.6 R .26 +(interpreter k)72 295.6 R .26(ernel, such as the heap and the b)-.1 F .261 +(uilt-in primiti)-.2 F -.15(ve)-.25 G .261(s, unresolv).15 F .261 +(ed references into the)-.15 F F1 .261(base pr)2.761 F -.1(og)-.45 G -.15(ra).1 +G(m).15 E F0 .274(must be resolv)72 315.6 R .274(ed during dynamic loading.) +-.15 F(Finally)5.274 E 2.773(,t)-.65 G .273 +(he object \214le needs to be able to e)282.557 315.6 R .273 +(xport its entry points)-.15 F(\(such as Elk')72 335.6 Q 2.5(se)-.55 G +(xtension initialization functions\) to the base program.)134.34 335.6 Q .565 +(More than one object \214le may ha)97 359.2 R .865 -.15(ve t)-.2 H 3.065(ob) +.15 G 3.065(el)260.59 359.2 S .565(oaded into one in)270.875 359.2 R -.2(vo)-.4 +G .566(cation of Elk.).2 F 2.166 -.8(To m)5.566 H .566(anage non-tri).8 F +(vial,)-.25 E .895(hierarchically structured sets of e)72 379.2 R .894 +(xtensions, where a number of high-le)-.15 F -.15(ve)-.25 G 3.394(le).15 G .894 +(xtensions require one or more)381.004 379.2 R(lo)72 399.2 Q(wer)-.25 E(-le)-.2 +E -.15(ve)-.25 G 2.721(le).15 G .222(xtensions to be loaded, it is essential t\ +hat object \214les loaded later can mak)123.701 399.2 R 2.722(eu)-.1 G .222 +(se of the symbols)433.614 399.2 R .914(de\214ned by pre)72 419.2 R .914 +(viously loaded object \214les.)-.25 F .913 +(As this style of dynamic loading allo)5.913 F .913(ws b)-.25 F .913 +(uilding comple)-.2 F 3.413(xs)-.15 G(ys-)491.78 419.2 Q +(tems from small components incrementally)72 439.2 Q 2.5(,w)-.65 G 2.5(ew) +256.89 439.2 S(ill use the term)271.05 439.2 Q F1(incr)2.5 E(emental loading) +-.37 E F0(.)A -.4(Wi)97 462.8 S 1.112(th the adv).4 F 1.112(ent of 4.0)-.15 F +1.112(BSD in 1980 [Jo)1.666 F 3.612(y1)-.1 G 1.112 +(980], support for incremental loading w)276.072 462.8 R 1.113(as added to the) +-.1 F 1.232(system link)72 482.8 R 1.231 +(er and has since been supported by most major UNIX v)-.1 F 1.231 +(ariants: when the \255A option and the)-.25 F .079(name of the base e)72 502.8 +R -.15(xe)-.15 G .079(cutable are supplied to the link).15 F(er)-.1 E 2.579(,l) +-.4 G .08(inking is performed in a w)294.44 502.8 R .08 +(ay that the object \214le pro-)-.1 F 1.405(duced by the link)72 522.8 R 1.404 +(er can be read into the already running e)-.1 F -.15(xe)-.15 G 3.904 +(cutable. The).15 F 1.404(symbol table of the resulting)3.904 F 1.196(object \ +\214le is a combination of the symbols de\214ned by the base program and the n\ +e)72 542.8 R 1.197(wly de\214ned symbols)-.25 F .426(added by the linking proc\ +ess, from the object \214le or from libraries used in linking.)72 562.8 R .425 +(Only this ne)5.425 F .425(wly link)-.25 F(ed)-.1 E .129 +(code and data is entered into the resulting object \214le.)72 582.8 R .129 +(The incremental style of dynamic loading is achie)5.129 F -.15(ve)-.25 G(d).15 +E .18(by sa)72 602.8 R .18(ving the resulting output \214le each time the link) +-.2 F .18(er is in)-.1 F -.2(vo)-.4 G -.1(ke).2 G 2.679(da).1 G .179 +(nd using this \214le as the base program for)339.808 602.8 R(the ne)72 622.8 Q +(xt incremental loading step, such that both old and ne)-.15 E 2.5(ws)-.25 G +(ymbols can be referenced.)323.24 622.8 Q .918 +(Incremental loading is generally supported by the link)97 646.4 R .919 +(ers of UNIX v)-.1 F .919(ersions that use the BSD-style)-.15 F .199 +(a.out format and by those of se)72 666.4 R -.15(ve)-.25 G .199 +(ral UNIX systems based on more modern a.out formats \(e.).15 F .199 +(g. Ultrix\).)1.666 F .199(It is)5.199 F 1.109(not supported by an)72 686.4 R +3.609(ye)-.15 G 1.109(xisting release of UNIX System V)167.236 686.4 R 6.109 +(.S)-1.29 G 1.11(ome ne)323.14 686.4 R 1.11(wer UNIX v)-.25 F 1.11 +(ersions that ha)-.15 F 1.41 -.15(ve s)-.2 H(hared).15 E 1.858 +(libraries and dynamic linking \(such as System V Release 4 or SunOS\) of)72 +706.4 R 1.858(fer a library interf)-.25 F 1.858(ace to the)-.1 F 1.909 +(dynamic link)72 726.4 R(er)-.1 E 6.909(.I)-.55 G 4.409(ns)146.268 726.4 S +1.909(ome systems this kind of interf)159.567 726.4 R 1.91 +(ace is intended to replace the incremental loading)-.1 F EP +%%Page: 14 14 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(4-)288 56 S .947 +(functionality of the system link)72 92 R(er)-.1 E 5.946(.T)-.55 G .946 +(hese dynamic link)222.464 92 R .946(er interf)-.1 F .946 +(aces usually come in the form of a library)-.1 F 1.094(that e)72 112 R 1.094 +(xports functions such as)-.15 F/F1 10/Times-Italic@0 SF(dlopen\(\))3.594 E F0 +1.095(to map a shared object module or shared library into the address)3.595 F +.911(space of the caller \(the base program\) and)72 132 R F1(dlsym\(\))3.411 E +F0 .91(to obtain the address of a function or data item in the)3.411 F(ne)72 +152 Q(wly attached object module.)-.25 E 1.074 +(In some implementations, object \214les attached through)97 175.6 R F1 +(dlopen\(\))3.574 E F0 1.074(may directly reference symbols in)3.574 F .028 +(the base program; in other implementations the)72 195.6 R 2.528(ym)-.15 G .028 +(ay not.)276.196 195.6 R .027(In an)5.027 F 2.527(yc)-.15 G .027 +(ase, object \214les cannot directly reference)340.585 195.6 R .291 +(symbols de\214ned by objects that ha)72 215.6 R .591 -.15(ve b)-.2 H .292 +(een placed into the program by pre).15 F .292(vious calls to)-.25 F F1 +(dlopen\(\))2.792 E F0(\(only)2.792 E 2.792(,i)-.65 G 2.792(fa)490.658 215.6 S +(t)501.22 215.6 Q .482(all, indirectly by calling)72 235.6 R F1(dlsym\(\))2.982 +E F0 2.982(\). Thus,)B .481(these dynamic link)2.982 F .481(er interf)-.1 F +.481(aces are clearly inferior to incremental)-.1 F .168(loading, as the)72 +255.6 R 2.668(yl)-.15 G .169 +(ack the important capability to load a set of object \214les)140.684 255.6 R +F1(incr)2.669 E(ementally)-.37 E F0 5.169(.M)C(an)435.642 255.6 Q 2.669(yv)-.15 +G .169(endors who)457.451 255.6 R(ha)72 275.6 Q .515 -.15(ve r)-.2 H .215 +(eplaced `).15 F .215(`/bin/ld \255A)-.74 F 1.695 -.74('' b)-1.11 H 2.715(ya) +.74 G F1(dlopen)A F0 .215 +(-style library in their UNIX systems, or who intend to do so, do not)B +(seem to be a)72 295.6 Q -.1(wa)-.15 G(re of the f).1 E(act that this change w\ +ill break applications that rely on incremental loading.)-.1 E -.15(Fo)97 319.2 +S 3.146(rE).15 G .647(lk, the consequence of being restricted to dynamic link) +119.996 319.2 R .647(er interf)-.1 F .647(aces of that kind is that, e)-.1 F +(xcept)-.15 E .886(for the simplest applications, one must pre-link all possib\ +le combinations of e)72 339.2 R .886(xtensions that are not com-)-.15 F .87 +(pletely independent of each other)72 359.2 R 5.87(.I)-.55 G 3.37(ng)219.93 +359.2 S .87(eneral, gi)233.3 359.2 R -.15(ve)-.25 G 3.37(nas).15 G .871(et of) +300.49 359.2 R F1(n)3.371 E F0 -.15(ex)3.371 G .871 +(tensions each of which can be based on).15 F .583(one out of)72 379.2 R F1(m) +3.083 E F0 .583(other e)3.083 F .583(xtensions, this means ha)-.15 F .583 +(ving to prepare and k)-.2 F .583(eep around)-.1 F F1(n)3.083 E/F2 10/Symbol SF +1.666 E F1(m)1.666 E F0(pre-link)3.082 E .582(ed object \214les;)-.1 F .558 +(not to mention the contortions one has to go through when the hierarch)72 +399.2 R 3.058(yo)-.05 G 3.058(fe)375.56 399.2 S .558 +(xtensions has a depth greater)386.238 399.2 R .552(than tw)72 419.2 R 3.052 +(o\()-.1 G .552(not an unlik)113.554 419.2 R .551(ely scenario in practice\).) +-.1 F .551(If the number of e)5.551 F .551 +(xtensions and relations between them is)-.15 F(lar)72 439.2 Q 1.418 +(ger than tri)-.18 F 1.418(vial, or if the e)-.25 F 1.418(xtensions are lar) +-.15 F 1.418(ge or require lar)-.18 F 1.418(ge libraries, k)-.18 F 1.419 +(eeping around all pre-link)-.1 F(ed)-.1 E .015 +(combinations of object modules will cause a maintenance problem and may w)72 +459.2 R .015(aste a considerable amount of)-.1 F(disk space.)72 479.2 Q +(Another)97 502.8 Q 2.746(,a)-.4 G .246(lthough minor)139.056 502.8 R 2.746(,p) +-.4 G .246(roblem with these dynamic link)206.098 502.8 R .246(er interf)-.1 F +.247(aces is that the)-.1 F 2.747(yu)-.15 G .247(sually of)437.656 502.8 R .247 +(fer only)-.25 F 2.692(as)72 522.8 S .191(imple-minded function \(such as) +83.022 522.8 R F1(dlsym\(\))2.691 E F0 2.691(\)t)C 2.691(ol)252.008 522.8 S +.191(ook up the address of a speci\214c symbol of a ne)262.479 522.8 R .191 +(wly accessed)-.25 F .007 +(object module \(typically some kind of module initialization function\); b)72 +542.8 R .008(ut the)-.2 F 2.508(yd)-.15 G 2.508(on)394.222 542.8 S .008(ot pro) +406.73 542.8 R .008(vide a w)-.15 F .008(ay to scan)-.1 F 1.058(all ne)72 562.8 +R 1.058(wly de\214ned symbols.)-.25 F 1.058(This functionality is insuf)6.058 F +1.058(\214cient to implement e)-.25 F 1.057(xtension initialization in Elk,) +-.15 F .296(where a dynamically loadable e)72 582.8 R .296 +(xtension often is composed from a number of small modules, each de\214ning) +-.15 F 2.013(its o)72 602.8 R 2.013(wn initialization function.)-.25 F 2.012 +(Requiring a single, common initialization function name for the entire)7.013 F +.16(object \214le implies that \(often con\214guration-dependent\) `)72 622.8 R +.16(`glue code')-.74 F 2.66('m)-.74 G .16(ust be added to call all the indi) +355.64 622.8 R(vidual)-.25 E +(initialization functions, including the C++ static constructors.)72 642.8 Q +-1.11(Ve)97 666.4 S .255(rsion 2.2 of Elk supports dynamic loading in en)1.11 F +.254(vironments with `)-.4 F .832(`ld \255A)-.74 F 1.734 -.74('' \()-1.11 H +.254(such as BSD, SunOS 4,).74 F 3.696(Ultrix, and certain v)72 686.4 R 3.697 +(ersions of SGI Irix and HP-UX\), in HP-UX 9 \(based on)-.15 F F1(shl_load) +6.197 E F0 3.697(\), and in)B(MA)72 706.4 Q(CH/NeXT)-.4 E .823(-OS \()-.92 F F1 +(rld_load)A F0 3.323(\). By)B .823(generating shared objects on the \215y)3.323 +F 3.323(,S)-.65 G .822(ystem V Release 4 and SunOS 5)369.077 706.4 R +(\(Solaris 2\) are also supported, although in a limited and not yet satisf)72 +726.4 Q(actory w)-.1 E(ay)-.1 E(.)-.65 E EP +%%Page: 15 15 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(5-)288 56 S/F1 10/Times-Bold@0 +SF 2.5(4.4. Non-Standard)72 92 R(Language F)2.5 E(eatur)-.25 E(es)-.18 E F0 +.625(As the current v)97 115.6 R .625 +(ersion of the Scheme standard \(deliberately\) does not specify se)-.15 F -.15 +(ve)-.25 G .625(ral important lan-).15 F .44 +(guage issues, such as error handling or syntactic e)72 135.6 R .44 +(xtensions, we ha)-.15 F .74 -.15(ve a)-.2 H .44 +(dded a number of non-standard lan-).15 F +(guage features to the Scheme interpreter of Elk to \214ll some of the holes.) +72 155.6 Q 3.975(Ap)97 179.2 S 1.475(roposal for a macro e)113.195 179.2 R +1.476(xtension has only recently been added as an addendum to the)-.15 F/F2 10 +/Times-Italic@0 SF(Re)3.976 E(vised)-.15 E/F3 9/Times-Italic@0 SF(4)499.5 174.2 +Q F2 1.045(Report on the Algorithmic Langua)72 199.2 R 1.245 -.1(ge S)-.1 H +-.15(ch).1 G(eme).15 E F0 1.044 +([Clinger et al. 1991] and is still being discussed contro)3.545 F -.15(ve)-.15 +G -.2(r-).15 G 1.413(sially within the Scheme community)72 219.2 R 6.413(.T) +-.65 G 3.913(oa)237.895 219.2 S -.2(vo)251.048 219.2 S 1.413(id ha).2 F 1.413 +(ving to w)-.2 F 1.413(ait for a \214nal v)-.1 F 1.414 +(ersion of a macro system to)-.15 F -2.2 -.25(ev o)72 239.2 T(lv).25 E 2.604 +(ea)-.15 G .103(nd be included in the Scheme standard, we implemented a simple\ +-minded macro mechanism in Elk)105.104 239.2 R(that resembles the macro f)72 +259.2 Q(acilities of)-.1 E(fered by v)-.25 E(arious e)-.25 E +(xisting Scheme and Lisp systems.)-.15 E .638 +(One area where the Scheme standard does not specify an)97 282.8 R 3.138(yl) +-.15 G .638(anguage features yet is error and e)340.94 282.8 R(xcep-)-.15 E +.265(tion handling; the standard merely states which error situations a confor\ +ming implementation is required to)72 302.8 R .129(detect and report.)72 322.8 +R .129(Since it is essential for a non-tri)5.129 F .13 +(vial application to be able to gracefully handle error situ-)-.25 F .141 +(ations \(such as f)72 342.8 R .141 +(ailures in interactions with the operating system\) and other e)-.1 F .14 +(xceptional conditions, we ha)-.15 F -.15(ve)-.2 G(added a simple error and e) +72 362.8 Q(xception handling f)-.15 E(acility to Elk.)-.1 E .152 +(When an error is detected by the interpreter)97 386.4 R 2.653(,au)-.4 G(ser) +289.022 386.4 Q .153(-supplied error handling procedure is in)-.2 F -.2(vo)-.4 +G -.1(ke).2 G 2.653(dw).1 G(ith)493.44 386.4 Q(ar)72 406.4 Q .407 +(guments identifying the type and source of the error)-.18 F 5.406(.T)-.55 G +.406(he standard interacti)304.05 406.4 R .706 -.15(ve e)-.25 H -.4(nv).15 G +.406(ironment \(top-le).4 F -.15(ve)-.25 G .406(l\) of).15 F .386(Elk pro)72 +426.4 R .386(vides a def)-.15 F .387(ault error handler that prints an error m\ +essage and then resumes the main read-e)-.1 F -.25(va)-.25 G(l-print).25 E .316 +(loop by means of a)72 446.4 R F2 -.37(re)2.816 G(set).37 E F0(primiti)2.816 E +-.15(ve)-.25 G 5.316(.M).15 G .316(ost primiti)227.042 446.4 R -.15(ve)-.25 G +2.816(so).15 G 2.816(fE)289.504 446.4 S .315(lk and the e)301.76 446.4 R .315 +(xtensions use this error handling f)-.15 F(acil-)-.1 E .115 +(ity to signal an error)72 466.4 R 2.616(,a)-.4 G 2.616(so)162.716 466.4 S .116 +(pposed to indicating f)174.222 466.4 R .116(ailure by a distincti)-.1 F .416 +-.15(ve r)-.25 H .116(eturn v).15 F .116(alue \(which w)-.25 F .116 +(ould be prone to)-.1 F 1.142(being ignored\).)72 486.4 R 2.742 -.8(To b)6.142 +H 1.141(y-pass the standard error handler and `).8 F(`catch')-.74 E 3.641('f) +-.74 G 1.141(ailure of a particular primiti)356.505 486.4 R -.15(ve)-.25 G +3.641(,p).15 G(ro-)492.34 486.4 Q 1.476 +(grams may enclose the call to the primiti)72 506.4 R 1.776 -.15(ve b)-.25 H(y) +.15 E F2(call-with-curr)3.976 E(ent-continuation)-.37 E F0 1.477 +(and dynamically bind the)3.976 F(error handler to the continuation \(as sho)72 +526.4 Q(wn in listing 3\).)-.25 E .943(Elk pro)97 550 R .943(vides a similar f) +-.15 F .943(acility to handle an)-.1 F F2(interrupt)3.443 E F0 -.15(ex)3.443 G +.943(ception: a user).15 F .942(-supplied interrupt handler is)-.2 F(in)72 570 +Q -.2(vo)-.4 G -.1(ke).2 G 3.528(dw).1 G 1.029(hen a SIGINT signal is sent to \ +the interpreter \(usually by typing the interrupt character on the)114.268 570 +R -.1(ke)72 590 S 2.5(yboard\). Support)-.05 F(for other e)2.5 E +(xceptions, such as timer interrupts, may be pro)-.15 E(vided in future v)-.15 +E(ersions.)-.15 E .006(Another non-standard primiti)97 613.6 R .306 -.15(ve t) +-.25 H .006(hat f).15 F .006(acilitates handling of errors is)-.1 F F2 +(dynamic-wind)2.506 E F0 2.506(,a)C .005(generalization of)-.001 F(the)72 633.6 +Q F2(unwind-pr)3.579 E(otect)-.45 E F0 1.079(form of)3.579 F 1.079 +(fered by man)-.25 F 3.579(yL)-.15 G 1.079(isp dialects.)252.594 633.6 R F2 +(dynamic-wind)6.079 E F0 1.08(is used to implement the)3.579 F F2(\215uid-let) +3.58 E F0 .692(special form \(to create)72 653.6 R F2(\215uid)3.192 E F0 .692 +(or dynamic v)3.192 F .692(ariable bindings\).)-.25 F(Both)5.692 E F2 +(dynamic-wind)3.192 E F0(and)3.192 E F2(\215uid-let)3.192 E F0 .692 +(are also pro-)3.192 F(vided by se)72 673.6 Q -.15(ve)-.25 G +(ral other Scheme dialects [MIT 1984, Dyb).15 E(vig 1987].)-.15 E .349 +(The current v)97 697.2 R .349(ersion of the Scheme standard does not pro)-.15 +F .349(vide an)-.15 F 2.85(yl)-.15 G .35(anguage features that w)366.17 697.2 R +.35(ould mak)-.1 F(e)-.1 E .017(it possible to implement a useful Scheme deb)72 +717.2 R .016(ugger \(apart from a deb)-.2 F .016 +(ugger based on source code instrumen-)-.2 F 2.55(tation\). T)72 737.2 R 2.55 +(oc)-.8 G .05(ompensate for this shortcoming, we ha)122.96 737.2 R .35 -.15 +(ve a)-.2 H .05(dded a fe).15 F 2.55(wp)-.25 G(rimiti)345.54 737.2 Q -.15(ve) +-.25 G 2.55(st).15 G .05(hat aid the implementation of)386.03 737.2 R EP +%%Page: 16 16 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(6-)288 56 S(___________________\ +___________________________________________________________________)74 105.6 Q +/F1 8/Courier@0 SF(\(define \(open-input-file-or-not name\))100.346 127.103 Q +(\(call-with-current-continuation)109.946 140.103 Q(\(lambda \(return\))119.546 +153.103 Q(;)277.946 153.103 Q/F2 8/Courier-Oblique@0 SF(return)4.8 E F1 +(becomes escape procedure)4.8 E(\(fluid-let \(\(error-handler)129.146 166.103 Q +4.8(;r)277.946 166.103 S(ebind)292.346 166.103 Q F2(error-handler)4.8 E F1 +(\(lambda args \(return #f\)\)\)\))196.346 179.103 Q +(\(open-input-file name\)\)\)\)\))138.746 192.103 Q/F3 9/Times-Bold@0 SF +(Listing 3:)112.707 226.103 Q/F4 9/Times-Roman@0 SF 2.25(Av)4.5 G +(ersion of open-input-\214le that returns the ne)167.076 226.103 Q +(wly opened port on success, #f on error)-.225 E F0(__________________________\ +____________________________________________________________)74 249.703 Q 4.016 +(as)72 289.703 S 1.516(imple interacti)84.346 289.703 R 1.816 -.15(ve d)-.25 H +(eb).15 E(ugger)-.2 E 4.016(,a)-.4 G 1.516(mong them an)204.534 289.703 R/F5 10 +/Times-Italic@0 SF -.15(ev)4.016 G(al).15 E F0(primiti)4.016 E 1.816 -.15 +(ve \()-.25 H 1.516(although, in theory).15 F(,)-.65 E F5 -.15(ev)4.016 G(al) +.15 E F0 1.516(could be imple-)4.016 F .898(mented by writing an e)72 309.703 R +.898(xpression into a temporary \214le and then loading this \214le\).)-.15 F +.899(In addition, Elk, lik)5.899 F 3.399(ea)-.1 G(fe)72 329.703 Q 2.67(wo)-.25 +G .17(ther Scheme dialects, pro)94.41 329.703 R .17(vides le)-.15 F .17 +(xical en)-.15 F .17(vironments as \214rst class \(b)-.4 F .17 +(ut immutable\) objects.)-.2 F .17(Other non-)5.17 F .813(standard primiti)72 +349.703 R -.15(ve)-.25 G 3.313(st).15 G .813(hat aid writing deb)155.446 +349.703 R .813(uggers are)-.2 F F5(pr)3.313 E(ocedur)-.45 E(e-lambda)-.37 E F0 +.813(to obtain the lambda e)3.313 F .814(xpression that)-.15 F -.25(eva)72 +369.703 S .672(luated to a gi).25 F -.15(ve)-.25 G 3.172(np).15 G .671 +(rocedure, and a primiti)161.548 369.703 R .971 -.15(ve t)-.25 H .671 +(hat returns the list of currently acti).15 F .971 -.15(ve p)-.25 H .671 +(rocedures together).15 F .744(with their actual ar)72 389.703 R .744 +(guments and the le)-.18 F .744(xical en)-.15 F .745 +(vironments in which the procedure calls took place \(a)-.4 F F5(bac)3.245 E +(k-)-.2 E(tr)72 409.703 Q(ace)-.15 E F0(\).)A/F6 10/Times-Bold@0 SF 2.5 +(4.5. Garbage)72 449.703 R(Collection)2.5 E F0 2.105(The g)97 473.303 R 2.105 +(arbage collector of Elk is based on the)-.05 F F5(stop-and-copy)4.605 E F0 +2.105(algorithm \(see e.)4.605 F 2.105(g. [Abelson et al.)1.666 F 2.649 +(1985]\). The)72 493.303 R .149(heap area is di)2.649 F .149(vided into tw)-.25 +F(o)-.1 E F5(semispaces)2.649 E F0 2.649(,o)C .15(nly one of which is acti) +297.951 493.303 R .45 -.15(ve d)-.25 H .15(uring normal operation.).15 F .551 +(In a g)72 513.303 R .551 +(arbage collection, all objects that are still reachable are mo)-.05 F -.15(ve) +-.15 G 3.05(di).15 G .55(nto the unused semispace; the pre)355.69 513.303 R +(vi-)-.25 E .474(ously used semispace then remains unused until the ne)72 +533.303 R .474(xt g)-.15 F .474(arbage collection.)-.05 F .474 +(An incremental, generational)5.474 F -.05(ga)72 553.303 S .09 +(rbage collector for Elk, inspired by Y).05 F(ip')-.55 E 2.59(sg)-.55 G .09 +(arbage collector [Y)253.06 553.303 R .09 +(ip 1991], has recently been implemented as)-.55 F(an alternati)72 573.303 Q .3 +-.15(ve t)-.25 H 2.5(ot).15 G(he stop-and-cop)141.31 573.303 Q 2.5(yg)-.1 G +(arbage collector)217.81 573.303 Q/F7 8/Times-Roman@0 SF(2)-3.2 I F0(.)3.2 I +.235(Extensions to Elk can re)97 596.903 R(gister)-.15 E F5(befor)2.735 E(e-GC) +-.37 E F0(and)2.735 E F5(after)2.735 E(-GC)-.2 E F0 .234 +(functions with the interpreter; these functions)2.735 F 1.506(are in)72 +616.903 R -.2(vo)-.4 G -.1(ke).2 G 4.006(db).1 G 4.006(yt)128.742 616.903 S +1.506(he g)140.528 616.903 R 1.506 +(arbage collector immediately before and after each g)-.05 F 1.507 +(arbage collection run.)-.05 F -.4(Wi)6.507 G(thin).4 E F5(after)72 636.903 Q +(-GC)-.2 E F0 .342(functions, e)2.842 F .342 +(xtensions can determine whether a particular Scheme object has become g)-.15 F +.341(arbage, i.)-.05 F(e.)1.666 E .32 LW 76 646.903 72 646.903 DL 80 646.903 76 +646.903 DL 84 646.903 80 646.903 DL 88 646.903 84 646.903 DL 92 646.903 88 +646.903 DL 96 646.903 92 646.903 DL 100 646.903 96 646.903 DL 104 646.903 100 +646.903 DL 108 646.903 104 646.903 DL 112 646.903 108 646.903 DL 116 646.903 +112 646.903 DL 120 646.903 116 646.903 DL 124 646.903 120 646.903 DL 128 +646.903 124 646.903 DL 132 646.903 128 646.903 DL 136 646.903 132 646.903 DL +140 646.903 136 646.903 DL 144 646.903 140 646.903 DL/F8 6/Times-Roman@0 SF(2) +82 656.303 Q F7 -.32(Wi)4 2.4 O .737(th a generational g).32 F .737 +(arbage collector)-.04 F 2.737(,o)-.32 G .737(bjects survi)220.413 658.703 R +.737(ving g)-.2 F .738(arbage collections will not be touched ag)-.04 F .738 +(ain until there is)-.04 F .79 +(only a certain amount of memory left on the heap, triggering a full g)72 +668.703 R .79(arbage collection.)-.04 F -.12(Pa)4.789 G .789 +(rticularly in applications with).12 F(lar)72 678.703 Q .011 +(ge amounts of Scheme code or other constant data, partial GCs run much f)-.144 +F .012(aster than full GCs.)-.08 F -.32(Wi)4.012 G .012(th incremental g).32 F +(arbage)-.04 E .153(collection, starting a g)72 688.703 R .153(arbage collecti\ +on does not suspend the application until the GC is done; instead, the collect\ +or returns)-.04 F .485 +(control to the application almost immediately \(after ha)72 698.703 R .485 +(ving mark)-.16 F .486(ed pages of interest unreadable with the)-.08 F/F9 8 +/Times-Italic@0 SF(mpr)2.486 E(otect)-.36 E F7(system)2.486 E(call\) and re)72 +708.703 Q -.04(ga)-.12 G(ins control with a SIGSEGV signal.).04 E EP +%%Page: 17 17 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(7-)288 56 S .403 +(no references to the object e)72 92 R .403(xist an)-.15 F 2.903(yl)-.15 G +(onger)223.651 92 Q 5.403(.I)-.55 G 2.903(nt)257.104 92 S .403(his case, an e) +267.787 92 R .404(xtension may perform some kind of clean-up)-.15 F +(action; for e)72 112 Q(xample, if the no)-.15 E 2.5(wu)-.25 G +(nreferenced object contains a handle to an open \214le, close this \214le.) +202.41 112 Q .522(The Elk distrib)97 135.6 R .521 +(ution contains a library based on this mechanism that enables e)-.2 F .521 +(xtensions to re)-.15 F .521(gister a)-.15 F/F1 10/Times-Italic@0 SF .488 +(termination function)72 155.6 R F0 .488(for objects of a particular type.) +2.988 F .489(The termination function associated with an object is)5.489 F .49 +(then in)72 175.6 R -.2(vo)-.4 G -.1(ke).2 G 2.99(db).1 G 2.99(yt)131.72 175.6 +S .49(he g)142.49 175.6 R .489(arbage collector automatically when this object\ + has been detected to be unused.)-.05 F(The)5.489 E .519(Xlib e)72 195.6 R .519 +(xtension of Elk uses this library to perform suitable \214nalization operatio\ +ns on objects created by the)-.15 F -.15(ex)72 215.6 S .229(tensions, for e).15 +F .229(xample, close windo)-.15 F .229 +(ws, unload fonts, and free colormap objects that ha)-.25 F .528 -.15(ve b)-.2 +H .228(ecome unrefer).15 F(-)-.2 E 2.793(enced. This)72 235.6 R .294 +(mechanism is slightly complicated by the f)2.793 F .294 +(act that objects may ha)-.1 F .594 -.15(ve t)-.2 H 2.794(ob).15 G 2.794(et) +417.294 235.6 S .294(erminated in a pre-)427.308 235.6 R .494 +(de\214ned order; for instance, when an X11 display becomes g)72 255.6 R .493 +(arbage, all objects associated with this display)-.05 F +(must be terminated before the display itself is \214nally closed.)72 275.6 Q +/F2 10/Times-Bold@0 SF 2.5(4.6. Library)72 315.6 R(Extensions)2.5 E F0 .075 +(The problems we encountered when designing and implementing Elk')97 339.2 R +2.575(si)-.55 G(nterf)387.365 339.2 Q .075(aces to the C libraries of)-.1 F +.334(X11 are lik)72 359.2 R .334(ely to apply to a wide range of similar APIs.) +-.1 F .333(The X11 libraries, especially Xlib, are quite com-)5.334 F(ple)72 +379.2 Q 1.323(x; the core Xlib alone e)-.15 F 1.323 +(xports more than 600 functions and macros, with numerous dif)-.15 F 1.324 +(ferent mecha-)-.25 F .692(nisms for passing ar)72 399.2 R .692(guments and fo\ +r manipulating objects, some of which could be considered rather v)-.18 F(er) +-.15 E(-)-.2 E 1.085(bose and error)72 419.2 R 3.585(-prone. This)-.2 F(comple) +3.585 E 1.085(xity is, at least partly)-.15 F 3.585(,c)-.65 G 1.085 +(aused by the semantic restricti)314.335 419.2 R -.15(ve)-.25 G 1.085 +(ness of the C).15 F .83(programming language.)72 439.2 R .829 +(Thus, when designing the Scheme language interf)5.83 F .829 +(ace, we had the opportunity to)-.1 F(eliminate some of the `)72 459.2 Q(`w) +-.74 E(arts.)-.1 E -.74('')-.7 G .07(If inte)97 482.8 R .07 +(gration of a library with an e)-.15 F .07(xtension language \(or interacti) +-.15 F .37 -.15(ve l)-.25 H .07(anguage in general\) is not antici-).15 F 1.812 +(pated at the time the programmer')72 502.8 R 4.311(si)-.55 G(nterf)227.851 +502.8 Q 1.811(ace of the library is designed, writing a properly functioning) +-.1 F -.15(ex)72 522.8 S .671(tension language interf).15 F .671 +(ace to this library can become rather challenging or e)-.1 F -.15(ve)-.25 G +3.172(ni).15 G 3.172(mpossible. This)412.656 522.8 R(prob-)3.172 E 1.28 +(lem is e)72 542.8 R -.15(xe)-.15 G 1.28(mpli\214ed by the `).15 F(`Xt')-.74 E +3.78('t)-.74 G 1.279 +(oolkit intrinsics library of X11, in particular by earlier v)210.11 542.8 R +1.279(ersions of this)-.15 F(library)72 562.8 Q 5.231(.T)-.65 G .231(he follo) +111.851 562.8 R .231(wing e)-.25 F .231(xample illustrates a typical dif)-.15 F +.231(\214culty caused by the `)-.25 F(`static')-.74 E 2.732('n)-.74 G .232 +(ature of the program-)418.054 562.8 R(mer')72 582.8 Q 2.5(si)-.55 G(nterf)99.5 +582.8 Q(ace to `)-.1 E(`Xt')-.74 E(':)-.74 E .497 +(Each class of graphical objects \()97 606.4 R F1(widg)A(ets)-.1 E F0 .497 +(in `)2.997 F(`Xt')-.74 E 2.997('t)-.74 G .497(erminology\) e)300.468 606.4 R +.497(xports a list of attrib)-.15 F .497(utes \()-.2 F F1 -.37(re)C(sour).37 E +(ces)-.37 E F0(\))A .267(that are associated with objects of this class.)72 +626.4 R 2.767(Af)5.267 G .267(unction is pro)269.093 626.4 R .267(vided by `) +-.15 F(`Xt')-.74 E 2.768('t)-.74 G 2.768(oo)389.62 626.4 S .268 +(btain the list of resources)402.388 626.4 R .601 +(of a widget class together with the name and C type \(inte)72 646.4 R(ger)-.15 +E 3.101(,s)-.4 G .601(tring, pixmap, color)328.344 646.4 R 3.101(,e)-.4 G .601 +(tc.\) of each resource.)418.627 646.4 R .991(On this basis, operations lik)72 +666.4 R 3.491(es)-.1 G .991(etting the v)199.075 666.4 R .991 +(alue of a widget')-.25 F 3.491(sr)-.55 G .991 +(esource from within Scheme can be imple-)326.421 666.4 R .522 +(mented in a straightforw)72 686.4 R .522(ard w)-.1 F(ay)-.1 E 5.522(.T)-.65 G +.522(he `)217.34 686.4 R(`Xt')-.74 E 3.022('e)-.74 G .522 +(xtension just has to check if the user)258.954 686.4 R .521 +(-supplied Scheme v)-.2 F(alue)-.25 E .269(can be con)72 706.4 R -.15(ve)-.4 G +.269(rted into a C object of the resource').15 F 2.769(st)-.55 G .27 +(ype, perform this con)276.87 706.4 R -.15(ve)-.4 G .27 +(rsion, and call the Xt-function to).15 F 1.129 +(set the resource, or complain to the user if the v)72 726.4 R 1.128 +(alue is not suitable for this resource.)-.25 F(Ho)6.128 E(we)-.25 E -.15(ve) +-.25 G 1.928 -.4(r, i).15 H 3.628(ne).4 G(arly)488.45 726.4 Q EP +%%Page: 18 18 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(8-)288 56 S -.15(ve)72 92 S .698 +(rsions of Xt, some classes of widgets had a subset of resources \(the).15 F/F1 +10/Times-Italic@0 SF(constr)3.198 E .698(aint r)-.15 F(esour)-.37 E(ces)-.37 E +F0 3.199(\)w)C .699(hose names)456.921 92 R .319 +(and types could not be obtained by an `)72 112 R(`Xt')-.74 E 2.819('a)-.74 G +2.819(pplication. While)257.521 112 R .319(this omission w)2.819 F .318 +(as usually not percei)-.1 F -.15(ve)-.25 G 2.818(da).15 G(s)500.11 112 Q 3.276 +(ap)72 132 S .777(roblem for C programmers \(who w)84.716 132 R .777(ould kno) +-.1 F 3.277(we)-.25 G .777(ach widget')279.494 132 R 3.277(sr)-.55 G(esources) +337.148 132 Q F1 3.277(ap)3.277 G(riori)388.132 132 Q F0 .777 +(from reading the docu-)3.277 F .592(mentation\), it had a dramatic ef)72 152 R +.592(fect on Elk')-.25 F 3.092(s`)-.55 G(`Xt')257.656 152 Q 3.092('e)-.74 G +.592(xtension, as no)284.288 152 R 3.092(wt)-.25 G .592(he kno)358.034 152 R +.591(wledge about these resources)-.25 F 1.072(had to be hard-wired into the e) +72 172 R 3.573(xtension. As)-.15 F 3.573(ar)3.573 G 1.073(esult, the e)269.523 +172 R(xtension')-.15 E 3.573(ss)-.55 G 1.073 +(ource code had to be modi\214ed for)362.592 172 R(each ne)72 192 Q 2.5(ww)-.25 +G(idget set to be made usable from within Scheme code.)118.95 192 Q .039(This \ +particular problem has been remedied in recent releases of X11, though se)97 +215.6 R -.15(ve)-.25 G .038(ral similar problems).15 F .096(remain; e)72 235.6 +R -.15(ve)-.25 G 2.596(ni).15 G 2.596(nt)129.002 235.6 S .096 +(he UNIX C library)139.378 235.6 R 5.096(.W)-.65 G .096(hile design \215a) +231.312 235.6 R .096(ws of library interf)-.15 F .096 +(aces often go unnoticed or are con-)-.1 F .297 +(sidered minor when writing C or C++ programs \(e.)72 255.6 R .297(g. the f) +1.666 F .297(act that implementations of the)-.1 F F1(qsort\(\))2.797 E F0 +(functions)2.797 E .451(are non-reentrant\), the)72 275.6 R 2.951(yb)-.15 G +.451(ecome crucial when these libraries are made accessible to an e)174.833 +275.6 R .452(xtension language.)-.15 F 2.283(As the importance of e)72 295.6 R +2.283(xtension languages is gro)-.15 F 2.282 +(wing, it is essential that future library interf)-.25 F 2.282(aces are)-.1 F +(designed with the particular requirements of e)72 315.6 Q +(xtensions languages in mind.)-.15 E/F2 10/Times-Bold@0 SF 2.5(5. Practical)72 +359.2 R(Experiences with Elk)2.5 E 2.5(5.1. Elk)72 399.2 R(and ISO)2.5 E(TEXT) +-.4 E F0 .575(In de)97 422.8 R -.15(ve)-.25 G .575 +(loping the document processing system ISO).15 F(TEXT)-.4 E 3.076(,E)-.74 G +.576(lk pro)342.238 422.8 R -.15(ve)-.15 G 3.076(dt).15 G 3.076(ob)386.42 422.8 +S 3.076(eam)399.496 422.8 S .576(ajor asset [Bormann)422.308 422.8 R 2.674 +(1991]. Scheme)72 442.8 R -.1(wa)2.674 G 2.674(su).1 G .173 +(sed as the implementation language for all user interf)160.462 442.8 R .173 +(ace aspects of ISO)-.1 F(TEXT)-.4 E 5.173(.A)-.74 G(part)488.45 442.8 Q .456 +(from pro)72 462.8 R .456(viding e)-.15 F .456(xtensibility to users of ISO) +-.15 F(TEXT)-.4 E 2.956(,u)-.74 G .457(sing Elk as the base for ISO)284.852 +462.8 R .457(TEXT made it possible to)-.4 F .472 +(write the shell code in a high le)72 482.8 R -.15(ve)-.25 G 2.971(ll).15 G +.471(anguage with all its amenities, e.)218.135 482.8 R .471 +(g. automatic storage reclamation.)1.666 F(As)5.471 E 1.091 +(no recompilation and relinking is necessary)72 502.8 R 3.591(,i)-.65 G 3.592 +(ti)259.816 502.8 S 3.592(saq)268.968 502.8 S 1.092 +(uick operation to apply and test changes to the user)289.482 502.8 R(interf)72 +522.8 Q(ace.)-.1 E .77(Elk pro)97 546.4 R .77(vides for a strong `)-.15 F +(`\214re)-.74 E -.1(wa)-.25 G(ll').1 E 3.27('i)-.74 G 3.27(nt)250.72 546.4 S +.77(he ISO)261.77 546.4 R .77(TEXT system: b)-.4 F .77 +(ugs in the Scheme code gi)-.2 F 1.07 -.15(ve r)-.25 H .77(ise to).15 F 1.804 +(errors at the Scheme le)72 566.4 R -.15(ve)-.25 G 1.805 +(l, which can easily be deb).15 F 1.805(ugged using the \(primiti)-.2 F -.15 +(ve)-.25 G 4.305(,b).15 G 1.805(ut functional\) b)414.48 566.4 R(uilt-in)-.2 E +(deb)72 586.4 Q .192(ugger of Elk, while conditions such as core dumps al)-.2 F +-.1(wa)-.1 G .192(ys are the result of b).1 F .191(ugs in the ISO)-.2 F .191 +(TEXT k)-.4 F(ernel)-.1 E(implementation.)72 606.4 Q .139 +(All this assistance for the de)97 630 R -.15(ve)-.25 G .139(lopment of ISO).15 +F .14(TEXT could be obtained without sacri\214cing the perfor)-.4 F(-)-.2 E +(mance of the ISO)72 650 Q(TEXT k)-.4 E +(ernel system, which is still written in ef)-.1 E(\214cient C++.)-.25 E .989 +(Elk also allo)97 673.6 R .989(wed us to isolate the ISO)-.25 F .989(TEXT k)-.4 +F .989(ernel from the choice of an X toolkit: the ISO)-.1 F(TEXT)-.4 E -.1(ke) +72 693.6 S .53(rnel is una).1 F -.1(wa)-.15 G .53 +(re of the toolkit being used \(`).1 F(`Xt')-.74 E 3.031('w)-.74 G .531 +(ith OSF/Motif\).)284.062 693.6 R .531(The Scheme code b)5.531 F .531 +(uilds a user inter)-.2 F(-)-.2 E -.1(fa)72 713.6 S .442 +(ce using the Motif library interf).1 F .442(ace and pro)-.1 F .442 +(vides X windo)-.15 F .442(ws to the ISO)-.25 F .442(TEXT k)-.4 F 2.942 +(ernel. Input)-.1 F .441(is processed)2.941 F .115 +(by the Scheme code which calls editor primiti)72 733.6 R -.15(ve)-.25 G 2.615 +(sp).15 G(ro)276.94 733.6 Q .115(vided by the ISO)-.15 F .116(TEXT k)-.4 F .116 +(ernel and schedules redisplay)-.1 F EP +%%Page: 19 19 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-1)277.17 56 S 2.5(9-)288 56 S 2.799 +(operations. Replacing)72 92 R .299(Xt and OSF/Motif by e.)2.799 F(g.)1.666 E +/F1 10/Times-Italic@0 SF(Xvie)2.798 E(w)-.15 E F0 -.1(wo)2.798 G .298 +(uld require no changes in the ISO).1 F .298(TEXT k)-.4 F(ernel.)-.1 E .546 +(The w)97 115.6 R .546(ork on ISO)-.1 F .546 +(TEXT clearly identi\214ed one single main problem in writing non-tri)-.4 F +.547(vial e)-.25 F(xtensions:)-.15 E .169(as an)72 135.6 R 2.669(yr)-.15 G .169 +(equest for ne)103.288 135.6 R 2.668(wh)-.25 G .168(eap space can trigger a g) +169.914 135.6 R .168(arbage collection, e)-.05 F .168(xtensions must re)-.15 F +.168(gister local or tempo-)-.15 F 1.626(rary Scheme objects with the g)72 +155.6 R 1.626 +(arbage collector to protect them from being discarded during a GC run)-.05 F +.259(caused by an)72 175.6 R 2.759(yn)-.15 G .259(ested procedure call.)136.777 +175.6 R .259(While this scheme has the adv)5.259 F .258 +(antage that maximum utilization of the)-.25 F -.2(av)72 195.6 S .854 +(ailable heap space is guaranteed, it imposes a strict discipline on the e)-.05 +F .854(xtension programmer)-.15 F 5.854(.F)-.55 G .854(ailure to)470.096 195.6 +R 1.339(properly protect temporary Scheme objects usually results in delayed c\ +rashes of the application that are)72 215.6 R .015 +(hard to trace back to the actual source of the problem.)72 235.6 R -.15(Fo) +5.016 G 2.516(ri).15 G .016(nstance, when de)311.424 235.6 R -.15(ve)-.25 G +.016(loping the X11 e).15 F .016(xtensions to)-.15 F +(Elk, most of the time spent for deb)72 255.6 Q(ugging w)-.2 E +(as due to GC-related b)-.1 E(ugs.)-.2 E/F2 10/Times-Bold@0 SF 2.5(5.2. Elk)72 +295.6 R(and TELES.VISION)2.5 E F0 .753(Another e)97 319.2 R .752 +(xample for using Elk and its X interf)-.15 F .752 +(ace as the basis for a user interf)-.1 F .752(ace subsystem is the)-.1 F 1.145 +(TELES.VISION desktop video conferencing system [TELES 1991].)72 339.2 R 1.146 +(First, a some)6.146 F 1.146(what generalized User)-.25 F(Interf)72 359.2 Q +1.43(ace Management System w)-.1 F 1.43(as b)-.1 F 1.429 +(uilt in about 1500 lines of Scheme, which w)-.2 F 1.429 +(as then instantiated to)-.1 F -.2(bu)72 379.2 S .81(ild a number of re).2 F +.811(visions of the TELES.VISION user interf)-.25 F 3.311(ace. The)-.1 F .811 +(user interf)3.311 F .811(ace communicates with)-.1 F .488 +(the rest of the conferencing system via a remote procedure call C library)72 +399.2 R 2.987(,u)-.65 G .487(sing Scheme continuations as a)377.062 399.2 R +.178(basis for a simple form of multithreading.)72 419.2 R .179 +(According to the TELES.VISION implementors [Bastian 1993],)5.178 F .096(Elk w) +72 439.2 R .096(as a `)-.1 F .096(`perfect \214t')-.74 F 2.596('f)-.74 G .096 +(or this application, with the single e)170.03 439.2 R .096 +(xception that its initial g)-.15 F .095(arbage collector placed)-.05 F .723 +(too hea)72 459.2 R .723(vy a b)-.2 F .723(urden on the memory starv)-.2 F .723 +(ed initial en)-.15 F .724(vironment \(where 8 MB of memory had to be shared) +-.4 F .012(between an operating system, v)72 479.2 R .012(arious realtime de) +-.25 F .012(vice dri)-.25 F -.15(ve)-.25 G .012(rs, dri).15 F -.15(ve)-.25 G +.012(rs for video codec hardw).15 F .012(are, and an MS-)-.1 F -.4(Wi)72 499.2 +S(ndo).4 E .437(ws emulation subsystem\).)-.25 F .437 +(This has since been remedied by adding memory)5.437 F 5.437(.U)-.65 G .438 +(sing Elk also helped)421.857 499.2 R .775(when TELES.VISION w)72 519.2 R .775 +(as ported to OS/2 \212 in particular)-.1 F 3.275(,i)-.4 G .774 +(ts continuations ported easily)319.835 519.2 R 5.774(.A)-.65 G .774 +(lso, Elk w)453.942 519.2 R(as)-.1 E .708 +(used in the TELES.VISION project to b)72 539.2 R .708 +(uild a rapid prototype of the central conference management sub-)-.2 F +(system \(ag)72 559.2 Q(ain using continuations to pro)-.05 E +(vide multithreading\) within less than tw)-.15 E 2.5(ow)-.1 G(eeks.)408.08 +559.2 Q F2 2.5(5.3. Other)72 599.2 R(Pr)2.5 E(ojects)-.18 E F0 .625 +(While Elk has been used in the ISO)97 622.8 R .625 +(TEXT project since 1987, le)-.4 F -.05(ga)-.15 G 3.125(li).05 G .625 +(ssues pre)377.47 622.8 R -.15(ve)-.25 G .625(nted making it pub-).15 F 1.472 +(licly a)72 642.8 R -.25(va)-.2 G 1.472(ilable until the f).25 F 1.472 +(all of 1989.)-.1 F 1.473(Since, Elk has g)6.472 F 1.473 +(ained acceptance, in f)-.05 F 1.473(act suf)-.1 F 1.473(\214cient momentum to) +-.25 F 1.337(encourage others to contrib)72 662.8 R 1.337(ute softw)-.2 F 3.837 +(are. Elk)-.1 F 1.337(has been used successfully as an e)3.837 F 1.336 +(xtension language for a)-.15 F -.05(hy)72 682.8 S(perte).05 E .677 +(xt database, a distrib)-.15 F .677(uted v)-.2 F .677 +(ersion management system, v)-.15 F .678 +(arious CAD programs, testing and simula-)-.25 F .228 +(tion systems for digital circuits as well as en)72 702.8 R .228 +(vironmental models.)-.4 F .228(It also has found use simply as a Scheme)5.228 +F(programming en)72 722.8 Q +(vironment, in particular for its X and Motif interf)-.4 E(ace.)-.1 E EP +%%Page: 20 20 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(0-)288 56 S 1.634(The X e)97 92 +R 1.634(xtensions ha)-.15 F 1.934 -.15(ve p)-.2 H(ro).15 E -.15(ve)-.15 G 4.134 +(nu).15 G 1.634 +(seful in particular for writers of applications with graphical user)233.51 92 +R(interf)72 112 Q .336 +(aces based on X; Elk enables them to write their user interf)-.1 F .335 +(aces or parts thereof in Scheme to achie)-.1 F -.15(ve)-.25 G 2.5(ah)72 132 S +(igh de)83.94 132 Q(gree of customizability)-.15 E(.)-.65 E .276 +(Elk also has found use as a free-standing Scheme implementation.)97 155.6 R +.277(In combination with the X e)5.277 F(xten-)-.15 E .336 +(sions it is well-suited for teaching X to be)72 175.6 R .335 +(ginners, as a tool for interacti)-.15 F -.15(ve)-.25 G .335(ly e).15 F .335 +(xploring X, and as a platform)-.15 F +(for rapid prototyping of X-based applications.)72 195.6 Q .839 +(Outside of the UNIX w)97 219.2 R .839(orld, we are a)-.1 F -.1(wa)-.15 G .839 +(re of user).1 F .84(-done ports to DOS \(both 16 bit and 32 bit using)-.2 F +(DJGPP\), OS/2, and MacOS.)72 239.2 Q .229(Users cited the follo)97 262.8 R +.229(wing features as signi\214cant for their choice of Elk: dynamic object co\ +de loading,)-.25 F .586(dumping of ready-to-run e)72 282.8 R -.15(xe)-.15 G +.586(cutables, Elk').15 F 3.086(sp)-.55 G .586(erformance, its le)255.71 282.8 +R -.05(ga)-.15 G .587(lly unencumbered a).05 F -.25(va)-.2 G(ilability).25 E +3.087(,a)-.65 G .587(nd \214nally)465.353 282.8 R +(its simplicity and adaptability \(and, as users say)72 302.8 Q 2.5(,i)-.65 G +(ts consistent, clean and well-structured code\).)270.23 302.8 Q .516 +(Users are not happ)97 326.4 R 3.016(yw)-.1 G .516(ith v)188.384 326.4 R .516(\ +arious arti\214cial limitations still in the system \(such as the static heap \ +size)-.25 F 1.211(which with the stop-and-cop)72 346.4 R 3.711(yg)-.1 G 1.211 +(arbage collector needs to be \214x)203.344 346.4 R 1.211(ed at in)-.15 F -.2 +(vo)-.4 G 1.212(cation time\), with Elk').2 F 3.712(sp)-.55 G(erfor)481.44 +346.4 Q(-)-.2 E .964(mance, and with the f)72 366.4 R .964(act that Elk `)-.1 F +(`lik)-.74 E .964(es to be in control')-.1 F 3.464('\()-.74 G .964 +(i.e., supplies the main program\).)317.678 366.4 R .963(In addition,)5.963 F +(prospecti)72 386.4 Q .628 -.15(ve u)-.25 H .328 +(sers tend to ponder acceptance problems with their fello).15 F 2.829(ww)-.25 G +(ork)368.914 386.4 Q .329(ers and customers \(who might)-.1 F .395 +(not be well v)72 406.4 R .395 +(ersed in Lisp/Scheme\) before committing to Elk.)-.15 F(Finally)5.395 E 2.894 +(,f)-.65 G .394(or man)364.414 406.4 R 2.894(ye)-.15 G .394 +(xtension language appli-)404.892 406.4 R .62(cations, Elk is `)72 426.4 R .62 +(`too big')-.74 F .62(', and users ha)-.74 F .92 -.15(ve a)-.2 H(sk).15 E .62 +(ed for v)-.1 F .62(ersions without the more e)-.15 F(xpensi)-.15 E .92 -.15 +(ve E)-.25 H .62(lk features such).15 F .628 +(as arbitrary size number support or continuations.)72 446.4 R .627 +(On the other hand, users ha)5.628 F .927 -.15(ve a)-.2 H(sk).15 E .627 +(ed for additional fea-)-.1 F .382(tures such as an inter)72 466.4 R .382 +(-process communication interf)-.2 F .382(ace, or a better deb)-.1 F(ugger)-.2 +E 5.382(.A)-.55 G .382(lso, a port to MS-W)394.512 466.4 R(indo)-.4 E(ws)-.25 E +(has been acti)72 486.4 Q -.15(ve)-.25 G(ly sought.).15 E/F1 10/Times-Bold@0 SF +2.5(6. Conclusions)72 526.4 R F0 .286(Since the Elk project be)97 550 R -.05 +(ga)-.15 G .286 +(n, both the research community and signi\214cant industry projects ha).05 F +.585 -.15(ve g)-.2 H(en-).15 E 2.594(erated increasing numbers of `)72 570 R +2.594(`embeddable language')-.74 F 5.094('i)-.74 G 5.094(mplementations. While) +309.904 570 R(man)5.094 E 5.094(ys)-.15 G 2.594(uch languages)444.476 570 R +.367(inherit the syntactic \215a)72 590 R -.2(vo)-.2 G 2.867(ro).2 G 2.867(fB) +185.278 590 S .367(ASIC, those projects that focus on the ability to b)197.795 +590 R .366(uild non-tri)-.2 F .366(vial e)-.25 F(xtensions)-.15 E +(recently seem to almost e)72 610 Q(xclusi)-.15 E -.15(ve)-.25 G +(ly turn to the Scheme language.).15 E .315(Scheme has pro)97 633.6 R -.15(ve) +-.15 G 2.815(nt).15 G 2.815(ob)180.685 633.6 S 2.815(ea)193.5 633.6 S 2.815(ne) +205.195 633.6 S -.25(ff)217.45 633.6 S(ecti).25 E .615 -.15(ve l)-.25 H .315 +(anguage for e).15 F .315(xtension language purposes.)-.15 F .316(In the be) +5.316 F .316(ginning of)-.15 F .802(the ISO)72 653.6 R .802(TEXT project, ther\ +e were concerns that an implementation of the full Scheme language w)-.4 F .802 +(ould be)-.1 F .296(both too lar)72 673.6 R .296(ge and too slo)-.18 F 4.096 +-.65(w. T)-.25 H .296(hese reserv).65 F .296(ations pro)-.25 F -.15(ve)-.15 G +2.796(dt).15 G 2.796(ob)299.944 673.6 S 2.796(eu)312.74 673.6 S .297 +(nfounded: the binary code size of Elk is still)324.976 673.6 R 1.199 +(signi\214cantly belo)72 693.6 R 3.699(wt)-.25 G 1.198 +(hat of a medium size application such as)155.818 693.6 R/F2 10/Times-Italic@0 +SF(vi)3.698 E F0 6.198(.W)C 1.198(hile the performance of Elk may be)355.182 +693.6 R .085(uninspiring \(no compiler is a)72 713.6 R -.25(va)-.2 G .086 +(ilable\), this turned out not to be a critical issue, as an).25 F 2.586(yb) +-.15 G .086(ottlenecks can easily)421.068 713.6 R(be replaced by a primiti)72 +733.6 Q .3 -.15(ve r)-.25 H(ecoded in C or C++.).15 E EP +%%Page: 21 21 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(1-)288 56 S .789 +(There also were concerns that Scheme w)97 92 R .789 +(as going to be hard to learn for UNIX users f)-.1 F .788(amiliar with,)-.1 F +(say)72 112 Q 2.871(,t)-.65 G .371(he Bourne Shell and C.)92.831 112 R .372 +(This seems to be more of a problem with initial acceptance than with a steep) +5.371 F .366(learning curv)72 132 R .366(e: after ha)-.15 F .366(ving o)-.2 F +-.15(ve)-.15 G .366 +(rcome the initial barrier \(which generally had to do mainly with percei).15 F +(ving)-.25 E .918 +(the syntax as queer\), users reported the same rapid increase in producti)72 +152 R .918(vity the)-.25 F 3.418(ya)-.15 G .918(lready kne)409.014 152 R 3.419 +(wf)-.25 G .919(rom shell)465.581 152 R 2.64(programming. It)72 172 R .14 +(certainly has not been necessary to recruit Lisp programmers to be able to e) +2.64 F .14(xtend applica-)-.15 F(tions with Elk.)72 192 Q(Finally)97 215.6 Q +3.232(,E)-.65 G .732(lk w)136.532 215.6 R .732(as an e)-.1 F -.15(xe)-.15 G +.732(rcise in writing portable softw).15 F .732 +(are without being restricted to what is consid-)-.1 F .091 +(ered portable today)72 235.6 R 5.091(.A)-.65 G .091(part from the well-kno) +163.543 235.6 R .091(wn problem that true portability between current rele)-.25 +F -.25(va)-.25 G .09(nt plat-).25 F .065 +(forms cannot be attained by just picking one of the proclaimed `)72 255.6 R +(`standards')-.74 E .065(', and the unwieldy situation that)-.74 F .32 +(there are too man)72 275.6 R 2.82(ys)-.15 G .32 +(tandards for \(auto-\)con\214guration of softw)154.22 275.6 R .319 +(are, a signi\214cant part of the ef)-.1 F .319(fort in generat-)-.25 F 1.881 +(ing Elk w)72 295.6 R 1.881(as consumed by de)-.1 F 1.881 +(vising support for each ne)-.25 F 4.381(wp)-.25 G 1.882 +(latform for dynamic loading, generation of)323.51 295.6 R -.15(exe)72 315.6 S +1.054(cutables from running programs, and switching between threads of control\ + \(continuations\).).15 F 1.054(Note that)6.054 F(man)72 335.6 Q 2.848(yn)-.15 +G(on-tri)101.918 335.6 Q .348 +(vial applications of today \(apart from Lisp programming en)-.25 F .349 +(vironments, GNU emacs and T)-.4 F(E)2 I(X)-2 I 1.039 +(come to mind\) need one or more of these features; also note that most rele)72 +355.6 R -.25(va)-.25 G 1.039(nt current platforms can be).25 F +(made to support these features quite well \212 just in wildly dif)72 375.6 Q +(ferent w)-.25 E(ays.)-.1 E/F1 10/Times-Bold@0 SF 2.5(7. A)72 415.6 R -.1(va)-1 +G(ilability).1 E F0 1.341(Elk is a)97 439.2 R -.25(va)-.2 G 1.342(ilable in le) +.25 F -.05(ga)-.15 G 1.342(lly unencumbered status.).05 F 1.342(The current v) +6.342 F 1.342(ersion as of June 1994 is 2.2.)-.15 F(The)6.342 E 1.245 +(most recent v)72 459.2 R 1.245(ersion of Elk is a)-.15 F -.25(va)-.2 G 1.245 +(ilable via anon).25 F 1.245(ymous FTP from ftp.x.or)-.15 F 3.745(g\()-.18 G +1.245(/contrib\) and ftp.fu-berlin.de)387.09 459.2 R +(\(/pub/unix/languages/scheme\).)72 479.2 Q F1 2.5(8. Ackno)72 519.2 R +(wledgments)-.1 E F0 .2(An early v)97 542.8 R .2(ersion of Elk w)-.15 F .2 +(as written while one of us w)-.1 F .2(as emplo)-.1 F .2 +(yed at TELES GmbH, Berlin.)-.1 F 1.8 -.8(We a)5.2 H(re).8 E 1.107 +(grateful to Prof. Dr)72 562.8 R 3.607(.S)-.55 G 1.106 +(igram Schindler of TELES and TU Berlin for pro)163.088 562.8 R 1.106 +(viding the w)-.15 F 1.106(ork en)-.1 F 1.106(vironment for)-.4 F(ISO)72 582.8 +Q(TEXT and Elk and for the permission to publish this softw)-.4 E(are.)-.1 E +.231(The present v)97 606.4 R .232(ersion is a result of our research w)-.15 F +.232(ork at T)-.1 F .232(echnische Uni)-.7 F -.15(ve)-.25 G .232 +(rsit\344t Berlin, with the bene\214t).15 F .925(of the w)72 626.4 R .925 +(ork of man)-.1 F 3.425(yc)-.15 G(ontrib)164.965 626.4 Q 3.425(utors. In)-.2 F +(particular)3.425 E 3.425(,w)-.4 G 3.425(ew)279.9 626.4 S .924 +(ish to thank Marco Scheibe who wrote the genera-)294.985 626.4 R +(tional, incremental g)72 646.4 Q(arbage collector)-.05 E(.)-.55 E EP +%%Page: 22 22 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(2-)288 56 S/F1 10/Times-Bold@0 +SF 2.5(9. Refer)72 92 R(ences)-.18 E F0([Abelson et al. 1985])72 115.6 Q 1.344 +(Harold Abelson and Gerald J. Sussman with Julie Sussman,)97 135.6 R/F2 10 +/Times-Italic@0 SF(Structur)3.845 E 3.845(ea)-.37 G 1.345(nd Interpr)396.725 +135.6 R 1.345(etation of Com-)-.37 F(puter Pr)97 155.6 Q -.1(og)-.45 G -.15(ra) +.1 G(ms).15 E F0 2.5(,M)C(IT Press, Cambridge, Mass., 1985.)173.8 155.6 Q +([Bastian 1993])72 179.2 Q(Personal communication with Jan Bastian, TELES.)97 +199.2 Q([Bormann et al. 1988])72 222.8 Q .915 +(Ute Bormann, Carsten Bormann, C. Bathe, SDE \212 A WYSIWYG Editing and F)97 +242.8 R .914(ormatting System)-.15 F .813(for OD)97 262.8 R 3.313(Aa)-.4 G .814 +(nd SGML Documents, ESPRIT '88,)140.986 262.8 R F2(Pr)3.314 E .814 +(oceedings of the 5th Annual ESPRIT Confer)-.45 F(ence)-.37 E(,)-.1 E(Brussels) +97 282.8 Q F0 2.5(,N)C -.15(ove)143.11 282.8 S(mber 14-17, 1988.).15 E +([Bormann 1991])72 306.4 Q .021 +(Carsten Bormann, Open Document Processing and the ISO)97 326.4 R .021 +(TEXT System, Doctoral Dissertation, TU-)-.4 F(Berlin, 1991.)97 346.4 Q +([CFI 1991a])72 370 Q 2.583(CAD Frame)97 390 R -.1(wo)-.25 G 2.583(rk Initiati) +.1 F -.15(ve)-.25 G 5.083(,C).15 G 2.583(FI Extension Language Sub-Committee,) +223.989 390 R F2 2.584(CFI Extension Langua)5.084 F -.1(ge)-.1 G 1.974 +(Selection Document)97 410 R F0 4.474(,C)C 1.974 +(FI Document Number 87, CAD Frame)192.878 410 R -.1(wo)-.25 G 1.973 +(rk Initiati).1 F 2.273 -.15(ve I)-.25 H 1.973(nc., Austin, T).15 F -.15(ex)-.7 +G(as,).15 E(1991.)97 430 Q([CFI 1991b])72 453.6 Q 3.257(CAD Frame)97 473.6 R +-.1(wo)-.25 G 3.257(rk Initiati).1 F -.15(ve)-.25 G 5.758(,E).15 G 3.258 +(xtension Language W)225.452 473.6 R 3.258(orking Group: Architecture T)-.8 F +3.258(echnical Sub-)-.7 F(Committee,)97 493.6 Q F2 .836(Extension Langua)3.336 +F -.1(ge)-.1 G 3.336(:C).1 G(or)243.198 493.6 Q 3.336(eL)-.37 G(angua)265.054 +493.6 Q 1.036 -.1(ge S)-.1 H(election).1 E F0 3.335(,D)C .835(raft Proposal V) +352.345 493.6 R .835(ersion 0.7, CFI Docu-)-1.11 F +(ment Number ARCH-91-G-1, CAD Frame)97 513.6 Q -.1(wo)-.25 G(rk Initiati).1 E +.3 -.15(ve I)-.25 H(nc., Austin, T).15 E -.15(ex)-.7 G(as, 1991.).15 E +([Clinger et al. 1991])72 537.2 Q -.4(Wi)97 557.2 S .023 +(lliam Clinger and Jonathan Rees \(Editors\),).4 F F2(Re)2.523 E(vised)-.15 E +/F3 9/Times-Italic@0 SF(4)314.448 552.2 Q F2 .024 +(Report on the Algorithmic Langua)321.471 557.2 R .224 -.1(ge S)-.1 H -.15(ch) +.1 G(eme).15 E F0(,)A(No)97 577.2 Q -.15(ve)-.15 G(mber 2, 1991.).15 E -1.27 +-.74(Av a)5 H +(ilable as ftp://cs.indiana.edu/pub/scheme-repository/doc/r4rs.ps.Z.).74 E +([CLX 1991])72 600.8 Q .167(CLX \212 Common LISP X Interf)97 620.8 R .167 +(ace, 1991.)-.1 F(\(P)5.167 E .167(art of the X11 Release 5 distrib)-.15 F .167 +(ution a)-.2 F -.25(va)-.2 G .166(ilable from the).25 F(MIT softw)97 640.8 Q +(are distrib)-.1 E(ution center)-.2 E(.\))-.55 E([Co)72 664.4 Q(wlisha)-.25 E +2.5(w1)-.15 G(985])127.43 664.4 Q 1.813(M. F)97 684.4 R 4.313(.C)-.8 G -.25(ow) +130.946 684.4 S(lisha).25 E -.65(w,)-.15 G F2 1.813(The REXX Langua)4.963 F +2.013 -.1(ge \212 A P)-.1 H -.15(ra).1 G 1.813(ctical Appr).15 F(oac)-.45 E +4.313(ht)-.15 G 4.313(oP)378.16 684.4 S -1.7 -.45(ro g)393.583 684.4 T -.15(ra) +.45 G(mming).15 E F0 1.814(Prentice Hall,)4.313 F(Engle)97 704.4 Q -.1(wo)-.25 +G(od Clif).1 E(fs, NJ, 1985.)-.25 E EP +%%Page: 23 23 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(3-)288 56 S([Dyb)72 92 Q +(vig 1987])-.15 E(R. K)97 112 Q(ent Dyb)-.25 E(vig,)-.15 E/F1 10/Times-Italic@0 +SF(The Sc)2.5 E(heme Pr)-.15 E -.1(og)-.45 G -.15(ra).1 G(mming Langua).15 E +-.1(ge)-.1 G F0 2.5(,P).1 G(rentice Hall, Engle)323.87 112 Q -.1(wo)-.25 G +(od Clif).1 E(fs, NJ, 1987.)-.25 E([Hansen 1990])72 135.6 Q -.4(Wi)97 155.6 S +.583(lfred J. Hansen, Enhancing documents with embedded programs: Ho).4 F 3.083 +(wN)-.25 G .583(ess e)406.268 155.6 R .583(xtends insets in the)-.15 F(Andre)97 +175.6 Q 3.916(wT)-.25 G(oolKit,)138.186 175.6 Q F1(Pr)3.916 E 1.416 +(oceedings of IEEE Computer Society 1990 International Confer)-.45 F 1.417 +(ence on Com-)-.37 F(puter Langua)97 195.6 Q -.1(ge)-.1 G(s).1 E F0 2.5(,M)C +(arch 12-15, 1990, Ne)178.19 195.6 Q 2.5(wO)-.25 G(rleans.)279.58 195.6 Q -.834 +([IEEE Std 1178-1990])72 219.2 R F1 .097(IEEE Standar)97 239.2 R 2.597(df)-.37 +G .096(or the Sc)162.934 239.2 R .096(heme Pr)-.15 F -.1(og)-.45 G -.15(ra).1 G +.096(mming Langua).15 F -.1(ge)-.1 G F0 2.596(,N).1 G .596 -.25(ew Y)332.344 +239.2 T .096(ork, May 28, 1991 \(appro)-.85 F -.15(ve)-.15 G 2.596(dD).15 G +(ecem-)479.57 239.2 Q(ber 10, 1990\).)97 259.2 Q([Jo)72 282.8 Q 2.5(y1)-.1 G +(980])96.62 282.8 Q 2.69(Bill Jo)97 302.8 R 3.99 -.65(y, C)-.1 H 2.69 +(hanges in the V).65 F 2.69(AX system in the F)-1.35 F 2.69(ourth Berk)-.15 F +(ele)-.1 E 5.19(yD)-.15 G(istrib)376.86 302.8 Q 2.69(ution, Computer Systems) +-.2 F(Research Group, Uni)97 322.8 Q -.15(ve)-.25 G(rsity of California, Berk) +.15 E(ele)-.1 E 1.3 -.65(y, N)-.15 H -.15(ove).65 G(mber 1980.).15 E([Le)72 +346.4 Q(wis et al. 1990])-.25 E 1.184(Bil Le)97 366.4 R 1.183(wis, Dan LaLiber\ +te, the GNU Manual Group, GNU Emacs Lisp Reference Manual, Edition)-.25 F +(1.03, Free Softw)97 386.4 Q(are F)-.1 E +(oundation, Cambridge, Mass., December 1990.)-.15 E([MIT 1984])72 410 Q .173 +(MIT Scheme Manual, Se)97 430 R -.15(ve)-.25 G .174 +(nth Edition, Department of Electrical Engineering and Computer Science,).15 F +(Massachusetts Institute of T)97 450 Q(echnology)-.7 E 2.5(,C)-.65 G +(ambridge, Mass., September 1984.)261.47 450 Q([Ossanna 1979])72 473.6 Q .224 +(J. F)97 493.6 R 2.724(.O)-.8 G .224(ssanna, Nrof)123.318 493.6 R(f/T)-.25 E +(rof)-.35 E 2.724(fU)-.25 G(ser')210.386 493.6 Q 2.724(sM)-.55 G .224 +(anual, UNIX Programmer')240.33 493.6 R 2.724(sM)-.55 G .224(anual, Se)363.202 +493.6 R -.15(ve)-.25 G .224(nth Edition, v).15 F .223(ol. 2, Bell)-.2 F -.7(Te) +97 513.6 S(lephone Laboratories, Murray Hill, NJ, January 1979.).7 E +([Ousterhout 1990])72 537.2 Q 1.296 +(John K. Ousterhout, Tcl: An Embeddable Command Language,)97 557.2 R F1(Pr) +3.796 E 1.296(oceedings of the USENIX 1990)-.45 F -.55(Wi)97 577.2 S +(nter Confer).55 E(ence)-.37 E F0 2.5(,J)C(anuary 1990, pp. 133-146.)180.79 +577.2 Q([Schei\215er et al. 1986])72 600.8 Q .348(Robert W)97 620.8 R 2.848(.S) +-.92 G .348(chei\215er and Jim Gettys, The X W)146.496 620.8 R(indo)-.4 E 2.847 +(wS)-.25 G(ystem,)316.038 620.8 Q F1 -.3(AC)2.847 G 2.847(MT).3 G -.15(ra) +373.942 620.8 S .347(nsactions on Gr).15 F(aphics)-.15 E F0 2.847(,v)C .347 +(ol. 5,)483.373 620.8 R(no. 2, pp. 79-109, 1986.)97 640.8 Q +([Schei\215er et al. 1992])72 664.4 Q(Robert Schei\215er and James Gettys,)97 +684.4 Q F1 2.5(XW)2.5 G(indow System)256.15 684.4 Q F0 2.5(,T)C +(hird Edition, Digital Press, 1992.)321.98 684.4 Q([Springer et al. 1989])72 +708 Q(Geor)97 728 Q 3.164(ge Springer and Daniel O. Friedman,)-.18 F F1(Sc) +5.665 E 3.165(heme and the Art of Pr)-.15 F -.1(og)-.45 G -.15(ra).1 G(mming) +.15 E F0 5.665(,M)C 3.165(IT Press,)465.285 728 R EP +%%Page: 24 24 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(4-)288 56 S +(Cambridge, Mass., 1989.)97 92 Q([Stallman 1981])72 115.6 Q 1.13 +(Richard M. Stallman, EMA)97 135.6 R 1.13 +(CS \212 The Extensible, Customizable, Self-documenting Display Editor)-.4 F +2.405(Production System,)97 155.6 R/F1 10/Times-Italic@0 SF 2.405 +(SIGPLAN Notices)4.905 F F0 4.905(,v)C 2.405 +(ol. 16, no. 6, pp. 147-156, Association for Computing)269.76 155.6 R +(Machinery)97 175.6 Q 2.5(,N)-.65 G .5 -.25(ew Y)151.89 175.6 T(ork, 1981.)-.85 +E([TELES 1991])72 199.2 Q .429(Das TELES.VISION System \212 Philosophie und T) +97 219.2 R .429(echnologie, TELES GmbH, Berlin, 1991 \(in Ger)-.7 F(-)-.2 E +(man\).)97 239.2 Q([Y)72 262.8 Q(ip 1991])-.55 E .546(G. May Y)97 282.8 R .546 +(ip, Incremental, Generational Mostly-Cop)-.55 F .546 +(ying Garbage Collection in Uncooperati)-.1 F .846 -.15(ve E)-.25 H -.4(nv).15 +G(i-).4 E 1.546(ronments, WRL Research Report 91/8, DEC W)97 302.8 R 1.545 +(estern Research Laboratory)-.8 F 4.045(,P)-.65 G 1.545(alo Alto, California,) +420.36 302.8 R(1991.)97 322.8 Q EP +%%Page: 25 25 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(5-)288 56 S/F1 10/Times-Bold@0 +SF -.25(Ap)72 92 S(pendix A:).25 E(Extending Elk \212 An Example)5 E 2.5 +(A.1. The)72 132 R -.63(``)2.5 G(ndbm').63 E 2.5('L)-.63 G(ibrary Extension) +159.63 132 Q F0 .535(The e)97 155.6 R .536 +(xtensibility mechanisms of Elk can be demonstrated best by e)-.15 F .536 +(xamining a simple library e)-.15 F(xten-)-.15 E 2.665(sion. Consider)72 175.6 +R(the)2.665 E/F2 10/Times-Italic@0 SF(ndbm)2.665 E F0 .165(library that is a) +2.665 F -.25(va)-.2 G .165(ilable on most v).25 F .165(ersions of UNIX.)-.15 F +.165(This library implements func-)5.165 F +(tions to maintain a simple database \214le of k)72 195.6 Q -.15(ey)-.1 G +(/contents pairs.).15 E 1.002(As sho)97 219.2 R 1.002 +(wn in Listing 4, both the k)-.25 F -.15(ey)-.1 G 3.502(sa).15 G 1.002 +(nd the data to be stored are described by the type)258.126 219.2 R F2(datum) +3.502 E F0 3.502(;i)C(t)501.22 219.2 Q 1.089 +(consists of the data \(a string of bytes\) and the length of the data.)72 +239.2 R F2(dbm_open\(\))6.089 E F0 1.089(opens a database \214le and)3.589 F +1.001(returns a handle to that \214le to be used in subsequent operations on t\ +hat database \(a pointer to an opaque)72 259.2 R 1.683 +(data type, similar to the)72 279.2 R F2(fopen)4.182 E F0(and)4.182 E F2 -.37 +(re)4.182 G(addir).37 E F0(interf)4.182 E 1.682 +(aces\); it returns a null pointer if the \214le could not be)-.1 F 3.244 +(opened. A)72 299.2 R .744(database is closed by a call to)3.244 F F2 +(dbm_close\(\))3.244 E F0 5.744(.T)C .744(he data stored under a gi)309.39 +299.2 R -.15(ve)-.25 G 3.245(nk).15 G 1.045 -.15(ey i)433.325 299.2 T 3.245(sa) +.15 G .745(ccessed by)460.215 299.2 R .192(the function)72 319.2 R F2(dbm_fetc) +2.692 E(h\(\))-.15 E F0 2.692(;i)C 2.692(tr)179.356 319.2 S .192 +(eturns an object of type)188.158 319.2 R F2(datum)2.692 E F0 .192 +(\(with a null)2.692 F F2(dptr)2.692 E F0 .192(if the k)2.692 F .492 -.15(ey c) +-.1 H .192(ould not be found\).).15 F F2(dbm_stor)72 339.2 Q(e)-.37 E F0 .406 +(is used to insert an entry into a database and to modify an e)2.906 F .407 +(xisting entry; it returns zero on suc-)-.15 F(cess and a non-zero v)72 359.2 Q +(alue on error)-.25 E(.)-.55 E(_______________________________________________\ +_______________________________________)74 392.8 Q/F3 8/Courier@0 SF +(#include )100.346 414.303 Q(typedef struct {)100.346 440.823 Q +(char *dptr;)119.546 453.823 Q(int dsize;)119.546 466.823 Q 4.8(}d)100.346 +479.823 S(atum;)114.746 479.823 Q +(DBM *dbm_open\(char *file, int flags, int mode\);)100.346 506.343 Q +(void dbm_close\(DBM *db\);)100.346 526.103 Q +(datum dbm_fetch\(DBM *db, datum key\);)100.346 545.863 Q +(int dbm_store\(DBM *db, datum key, datum data, int flags\);)100.346 565.623 Q +/F4 9/Times-Bold@0 SF(Listing 4:)223.758 599.623 Q/F5 9/Times-Roman@0 SF +(The UNIX)4.5 E/F6 9/Times-Italic@0 SF(ndbm)2.25 E F5(library)2.25 E/F7 8 +/Times-Italic@0 SF(Note:)100.346 637.623 Q/F8 8/Times-Roman@0 SF -.12(Fo)2.623 +G 2.623(rs).12 G(implicity)137.472 637.623 Q 2.623(,s)-.52 G -1.72 -.2(ev e) +173.583 637.623 T .623(ral functions ha).2 F .864 -.12(ve b)-.16 H .624 +(een omitted.).12 F(The)4.624 E F7<8d61>2.624 E(gs)-.08 E F8(and)2.624 E F7 +(mode)2.624 E F8(ar)2.624 E .624(guments of)-.144 F F7(dbm_open)2.624 E F8 .624 +(are that of)2.624 F(the)100.346 655.623 Q F7(open)2.065 E F8 .065 +(system call.)2.065 F(The)4.065 E F7<8d61>2.065 E(gs)-.08 E F8(ar)2.065 E .065 +(gument of)-.144 F F7(dbm_stor)2.065 E(e)-.296 E F8 .065(can be DBM_INSER)2.065 +F 2.065(Tt)-.48 G 2.064(oi)356.542 655.623 S .064(nsert a ne)364.83 655.623 R +2.064(we)-.2 G .064(ntry into the database)406.806 655.623 R(or DBM_REPLA) +100.346 673.623 Q(CE to change an e)-.32 E(xisting entry)-.12 E(.)-.52 E F0(__\ +______________________________________________________________________________\ +______)74 691.223 Q EP +%%Page: 26 26 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(6-)288 56 S 1.163 +(The straightforw)97 92 R 1.163(ard w)-.1 F 1.163(ay to write an)-.1 F/F1 10 +/Times-Italic@0 SF(ndbm)3.663 E F0 -.15(ex)3.662 G 1.162 +(tension to Elk is to pro).15 F 1.162(vide a ne)-.15 F 3.662(wS)-.25 G 1.162 +(cheme data type)436.696 92 R F1(dbm-\214le)72 112 Q F0 .942 +(together with the oblig)3.442 F .942(atory type predicate)-.05 F F1 +(dbm-\214le?)3.442 E F0 .943(and the Scheme primiti)3.442 F 1.243 -.15(ve p) +-.25 H(rocedures).15 E F1(dbm-)3.443 E(open)72 132 Q F0(,)A F1(dbm-close)2.5 E +F0(,)A F1(dbm-fetc)2.5 E(h)-.15 E F0(and)2.5 E F1(dbm-stor)2.5 E(e)-.37 E F0 +(that operate on objects of type)2.5 E F1(dbm-\214le)2.5 E F0(.)A F1(dbm-open) +97 155.6 Q F0(recei)3.534 E -.15(ve)-.25 G 3.534(st).15 G 1.033 +(he \214lename \(a string or a symbol\); the second ar)179.198 155.6 R 1.033 +(gument is one of the symbols)-.18 F F1 -.37(re)72 175.6 S(ader).37 E F0 .996 +(\(open the \214le read-only\),)3.496 F F1(writer)3.496 E F0 .996 +(\(read and write access\), and)3.496 F F1(cr)3.496 E(eate)-.37 E F0 .997 +(\(read and write access, create)3.496 F(ne)72 195.6 Q 2.994<778c>-.25 G .494 +(le if it does not e)96.964 195.6 R 2.994(xist\). The)-.15 F .494 +(optional \214lemode ar)2.994 F .494(gument is an inte)-.18 F(ger)-.15 E(.)-.55 +E F1(dbm-open)5.494 E F0 .493(returns an object of)2.994 F(type)72 215.6 Q F1 +(dbm-\214le)2.59 E F0 .09(or #f \(f)2.59 F .09 +(alse\) if the \214le could not be opened.)-.1 F F1(dbm-close)5.091 E F0 .091 +(closes the database \214le associated with)2.591 F 1.248(its ar)72 235.6 R +1.248(gument of type)-.18 F F1(dbm-\214le)3.748 E F0 6.248(.A)C 3.748(st)208.32 +235.6 S 1.248(his function is called for its side-ef)218.738 235.6 R 1.248 +(fect only)-.25 F 3.748(,a)-.65 G 1.248(nd for lack of a better)411.402 235.6 R +(result, it returns a non-printing object.)72 255.6 Q F1(dbm-fetc)97 279.2 Q(h) +-.15 E F0 -.15(ex)2.977 G .477(pects a).15 F F1(dbm-\214le)2.977 E F0 .477 +(and a string ar)2.977 F .477(gument \(the k)-.18 F .777 -.15(ey t)-.1 H 2.977 +(ob).15 G 2.977(es)358.407 279.2 S .477(earched\) and returns a string \(the) +369.714 279.2 R 1.025(data stored under the k)72 299.2 R -.15(ey)-.1 G 3.525 +(\)o).15 G 3.525(r#)188.235 299.2 S 3.525(fi)200.09 299.2 S 3.525(ft)209.725 +299.2 S 1.025(he k)219.36 299.2 R 1.325 -.15(ey d)-.1 H 1.024(oes not e).15 F +3.524(xist. Note)-.15 F 1.024(that in Elk strings may contain arbitrary)3.524 F +.213(8-bit characters, including the null byte.)72 319.2 R F1(dbm-stor)5.213 E +(e)-.37 E F0 .213(is called with a)2.713 F F1(dbm-\214le)2.713 E F0 2.713(,t)C +.413 -.1(wo s)385.255 319.2 T .213(trings \(k).1 F .513 -.15(ey a)-.1 H .213 +(nd data\) and).15 F(one of the symbols)72 339.2 Q F1(insert)2.5 E F0(and)2.5 E +F1 -.37(re)2.5 G(place).37 E F0 5(.I)C(ts inte)233 339.2 Q(ger return v)-.15 E +(alue is the return v)-.25 E(alue of)-.25 E F1(dbm_stor)2.5 E(e\(\))-.37 E F0 +(.)A .683(These procedures and the ne)97 362.8 R(w)-.25 E F1(dbm-\214le)3.183 E +F0 .683(type can be used by application programmers to manipulate)3.183 F .198 +(database \214les in those parts of their applications that are written in Sch\ +eme.)72 382.8 R .198(Listing 5 sho)5.198 F .198(ws a small e)-.25 F(xam-)-.15 E +(ple.)72 402.8 Q(_____________________________________________________________\ +_________________________)74 436.4 Q/F2 8/Courier@0 SF +(\(define expand-mail-alias)100.346 457.903 Q(\(lambda \(alias\))109.946 +470.903 Q(\(let \(\(d \(dbm-open "/etc/aliases" 'reader\)\)\))119.546 483.903 Q +(\(if \(not d\))129.146 496.903 Q +(\(error 'expand-mail-alias "cannot open database"\)\))148.346 509.903 Q +(\(unwind-protect)129.146 522.903 Q(\(dbm-fetch d alias\))138.746 535.903 Q +(\(dbm-close d\)\)\)\)\))138.746 548.903 Q +(\(define address-of-staff \(expand-mail-alias "staff"\)\))100.346 568.663 Q/F3 +9/Times-Bold@0 SF(Listing 5:)220.315 602.663 Q/F4 9/Times-Roman@0 SF +(Using the ndbm e)4.5 E(xtension)-.135 E/F5 8/Times-Italic@0 SF(Note:)100.346 +640.663 Q/F6 8/Times-Roman@0 SF(The)2 E F5(unwind-pr)2 E(otect)-.36 E F6 +(and the)2 E F5(err)2 E(or)-.36 E F6(form are not present in standard Scheme.)2 +E F0(_________________________________________________________________________\ +_____________)74 658.263 Q EP +%%Page: 27 27 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(7-)288 56 S/F1 10/Times-Bold@0 +SF 2.5(A.2. The)72 92 R(Anatomy of a Scheme T)2.5 E(ype)-.74 E F0 .22 +(Listing 6 sho)97 115.6 R .22(ws the part of the e)-.25 F .22 +(xtension that deals with the ne)-.15 F 2.72(wd)-.25 G .22(ata type)363.91 +115.6 R/F2 10/Times-Italic@0 SF(dbm-\214le)2.72 E F0 .22(and the e)2.72 F +(xtension)-.15 E .484(initialization function.)72 135.6 R .484(The v)5.484 F +(ariable)-.25 E F2(T_Dbm)2.984 E F0 .484 +(will hold the unique identi\214er of the ne)2.984 F .484(wly de\214ned type.) +-.25 F(The)5.484 E(structure)72 155.6 Q F2(S_Dbm)2.575 E F0 .074(de\214nes the\ + C representation of the type; one such C structure is declared for each compo\ +s-)2.575 F .707(ite Scheme type.)72 175.6 R .708(Its main component is the han\ +dle of the database \214le that is contained in each object of)5.708 F(type)72 +195.6 Q F2(dbm-\214le)2.5 E F0(.)A .415(Scheme objects can usually li)97 219.2 +R .715 -.15(ve l)-.25 H .414(onger than their underlying C objects.).15 F .414 +(In case of the)5.414 F F2(dbm-\214le)2.914 E F0(type,)2.914 E 2.633(aS)72 +239.2 S .133(cheme object of that type can ob)84.633 239.2 R .133 +(viously still be referenced after its database handle has been closed by a) +-.15 F 1.152(call to)72 259.2 R F2(dbm-close)3.652 E F0 6.152(.A)C 3.652(sE) +158.496 259.2 S 1.152(lk e)172.148 259.2 R 1.152 +(xtensions must not crash the application, we must pre)-.15 F -.15(ve)-.25 G +1.151(nt such stale objects).15 F 1.341(from being used in further calls to)72 +279.2 R F2(dbm-fetc)3.842 E(h)-.15 E F0(,)A F2(dbm-stor)3.842 E(e)-.37 E F0 +3.842(,a)C(nd)317.124 279.2 Q F2(dbm-close)3.842 E F0 6.342(.O)C 1.342(ne w) +388.128 279.2 R 1.342(ay to achie)-.1 F 1.642 -.15(ve t)-.25 H 1.342(his is to) +.15 F 1.077 +(record in each Scheme object whether the underlying C object is still ali)72 +299.2 R 1.377 -.15(ve o)-.25 H 3.577(rh).15 G 1.077(as been terminated.)402.739 +299.2 R(The)6.077 E 1.078(boolean component)72 319.2 R F2(alive)3.578 E F0 +1.078(in the)3.578 F F2(dbm-\214le)3.578 E F0 1.078(type serv)3.578 F 1.078 +(es this purpose.)-.15 F 1.079(It is initialized with true and is set to)6.078 +F -.1(fa)72 339.2 S(lse in).1 E F2(dbm-close)2.5 E F0 5(.F)C +(urther operations on objects with)157.72 339.2 Q F2(alive)2.5 E F0(being f)2.5 +E(alse are rejected.)-.1 E .423(The interpreter stores all Scheme objects in v) +97 362.8 R .423(ariables of type)-.25 F F2(Object)2.922 E F0 5.422(.A)C(n) +387.73 362.8 Q F2(Object)2.922 E F0 .422(is typically a 32-bit)2.922 F -.25(va) +72 382.8 S .354(lue; it is composed of a).25 F F2(ta)2.854 E(g)-.1 E F0 .354 +(part and a)2.854 F F2(pointer)2.854 E F0 2.854(part. The)2.854 F F2(ta)2.854 E +(g)-.1 E F0 .354(part indicates the type of the object, and the)2.854 F .937 +(remaining bits hold the actual memory address of the object \(the)72 402.8 R +3.437(yp)-.15 G .937(oint into the interpreter')352.397 402.8 R 3.436(sh)-.55 G +3.436(eap\). The)462.804 402.8 R(macros)72 422.8 Q F2(TYPE)3.966 E F0(and)3.966 +E F2(POINTER)3.966 E F0 1.466(are pro)3.966 F 1.466(vided to e)-.15 F 1.466 +(xtract the \214elds of an)-.15 F F2(Object)3.966 E F0 6.467(.E)C 1.467 +(ach type de\214nition must)403.209 422.8 R .9(de\214ne a macro to e)72 442.8 R +.9(xtract the object')-.15 F 3.4(sm)-.55 G .899(emory address from an)235.62 +442.8 R F2(Object)3.399 E F0 .899(\(by means of)3.399 F F2(POINTER)3.399 E F0 +3.399(\)a)C .899(nd then)473.381 442.8 R +(cast it into a pointer to the underlying C structure \(see)72 462.8 Q F2 +(#de\214ne DBMF)2.5 E F0(in Listing 6\).)2.5 E F2(Dbm_Equal\(\))97 486.4 Q F0 +.008(implements both the)2.508 F F2(eqv?)2.508 E F0 .008(and the)2.508 F F2 +(equal?)2.509 E F0 .009(predicates for)5.009 F F2(dbm-\214le)2.509 E F0 .009 +(objects; it returns true)2.509 F(if both objects being compared are ali)72 +506.4 Q .3 -.15(ve a)-.25 H(nd contain identical).15 E F2(DBM)2.5 E F0 +(handles.)2.5 E F2(Dbm_Print\(\))97 530 Q F0 1.133 +(is called by the interpreter each time an object of type)3.633 F F2 +(dbm-\214le)3.633 E F0 1.132(is to be printed; it is)3.633 F(in)72 550 Q -.2 +(vo)-.4 G -.1(ke).2 G 2.5(dw).1 G +(ith the object and the Scheme port to which the output is to be sent.)113.24 +550 Q F2(P_Is_Dbm\(\))97 573.6 Q F0 .876(implements the primiti)3.376 F 1.176 +-.15(ve p)-.25 H(rocedure).15 E F2(dbm-\214le?)3.377 E F0 .877 +(\(the type predicate\).)5.877 F .877(As with all primi-)5.877 F(ti)72 593.6 Q +-.15(ve)-.25 G(s, it recei).15 E -.15(ve)-.25 G 2.5(sa).15 G -.18(rg)142.85 +593.6 S(uments of type).18 E F2(Object)2.5 E F0(and returns an)2.5 E F2(Object) +2.5 E F0 2.5(,a)C(nd it has a name be)337.35 593.6 Q(ginning with `)-.15 E +(`P_')-.74 E('.)-.74 E 5.782(The de\214nition of the initialization function)97 +617.2 R F2(elk_init_dbm\(\))8.282 E F0 5.782(is straightforw)8.282 F 5.782 +(ard; it in)-.1 F -.2(vo)-.4 G -.1(ke).2 G(s).1 E F2(De\214ne_Primitive\(\))72 +637.2 Q F0 2.135(once for each primiti)4.635 F 2.435 -.15(ve p)-.25 H 2.135 +(rocedure and \214nally).15 F F2(De\214ne_T)4.635 E(ype\(\))-.74 E F0 2.136 +(to mak)4.636 F 4.636(et)-.1 G 2.136(he ne)451.658 637.2 R 4.636(wt)-.25 G(ype) +489.56 637.2 Q(kno)72 657.2 Q(wn to the interpreter)-.25 E(.)-.55 E .438 +(The ar)97 680.8 R .438(guments that can be supplied to)-.18 F F2 +(De\214ne_Primitive\(\))2.938 E F0 .438 +(are a pointer to the function implementing)2.938 F .85(the primiti)72 700.8 R +1.15 -.15(ve p)-.25 H .85(rocedure, the Scheme name of the primiti).15 F -.15 +(ve)-.25 G 3.35(,t).15 G .85(he minimum and maximum number of ar)320.76 700.8 R +(gu-)-.18 E 1.229(ments, and a symbol indicating the)72 720.8 R F2 1.228 +(calling discipline)3.728 F F0 1.228(of the primiti)3.728 F -.15(ve)-.25 G +6.228(.F).15 G 1.228(or most of the functions in this)373.852 720.8 R EP +%%Page: 28 28 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(8-)288 56 S(___________________\ +___________________________________________________________________)74 105.6 Q +/F1 8/Courier@0 SF(#include )100.346 127.103 Q(#include ) +100.346 140.103 Q(int T_Dbm;)100.346 159.863 Q(struct S_Dbm {)100.346 179.623 Q +(DBM *dbm;)119.546 192.623 Q(char alive;)119.546 205.623 Q(/* 0 or 1 */)186.746 +205.623 Q(};)100.346 218.623 Q +(#define DBMF\(obj\) \(\(struct S_Dbm *\)POINTER\(obj\)\))100.346 238.383 Q +(int Dbm_Equal\(a, b\) Object a, b; {)100.346 258.143 Q(return DBMF\(a\)->aliv\ +e && DBMF\(b\)->alive && DBMF\(a\)->dbm == DBMF\(b\)->dbm;)119.546 271.143 Q(}) +100.346 284.143 Q(void Dbm_Print\(d, port\) Object d, port; {)100.346 303.903 Q +(Printf\(port, "#[dbm-file %lu]", DBMF\(d\)->dbm\);)119.546 316.903 Q(})100.346 +329.903 Q(Object P_Is_Dbm\(x\) Object x; {)100.346 349.663 Q +(return TYPE\(x\) == T_Dbm ? True : False;)119.546 362.663 Q(})100.346 375.663 +Q(void elk_init_dbm\(\) {)100.346 395.423 Q 14.4 +(Define_Primitive\(P_Is_Dbm, "dbm-file?",)119.546 408.423 R(1, 1, EVAL\);)4.8 E +4.8(Define_Primitive\(P_Dbm_Open, "dbm-open", 2,)119.546 421.423 R +(3, VARARGS\);)4.8 E(Define_Primitive\(P_Dbm_Close, "dbm-close", 1, 1, EVAL\);) +119.546 434.423 Q(Define_Primitive\(P_Dbm_Store, "dbm-store", 4, 4, EVAL\);) +119.546 447.423 Q(Define_Primitive\(P_Dbm_Fetch, "dbm-fetch", 2, 2, EVAL\);) +119.546 460.423 Q(T_Dbm = Define_Type\("dbm-file", sizeof\(struct S_Dbm\),) +119.546 480.183 Q(Dbm_Equal, Dbm_Equal, Dbm_Print, NOFUNC\);)138.746 493.183 Q +(})100.346 506.183 Q/F2 9/Times-Bold@0 SF(Listing 6:)210.487 540.183 Q/F3 9 +/Times-Roman@0 SF(Sk)4.5 E(eleton of the ndbm e)-.09 E(xtension)-.135 E/F4 8 +/Times-Italic@0 SF(Note:)100.346 578.183 Q/F5 8/Times-Roman@0 SF -.12(Fo)2.643 +G 2.643(rs).12 G .643(implicity some details ha)137.512 578.183 R .884 -.12 +(ve b)-.16 H .644(een omitted in this listing, and the calling interf).12 F +.644(ace of some functions has)-.08 F .176(been simpli\214ed; the program w) +100.346 596.183 R .176(ould not compile in this form.)-.08 F 2.176(Aw)4.176 G +(orking)315.226 596.183 Q F4(gdbm)2.176 E F5 .176(\(GNU dbm\) e)2.176 F .175 +(xtension is included in)-.12 F(the Elk distrib)100.346 614.183 Q(ution.)-.16 E +F0(___________________________________________________________________________\ +___________)74 631.783 Q -.15(ex)72 671.783 S .653 +(ample, the calling discipline is).15 F/F6 10/Times-Italic@0 SF(EV)3.153 E(AL) +-.6 E F0 3.153(,i)C .653(ndicating a normal procedure with a \214x)240.718 +671.783 R .654(ed number of ar)-.15 F(guments,)-.18 E .558(such as)72 691.783 R +F6(car)3.058 E F0 5.558(.E)C .558(lk also supports procedures with v)132.274 +691.783 R .557(ariable ar)-.25 F .557(gument list, such as)-.18 F F6(list)3.057 +E F0(\()3.057 E F6 -.6(VA)C(RARGS).6 E F0 .557(\); and)B F6(NOE-)3.057 E -.6 +(VA)72 711.783 S(L).6 E F0(for)2.5 E F6(special forms)2.5 E F0(\(v)2.5 E +(ariable number of une)-.25 E -.25(va)-.25 G(luated ar).25 E(guments\).)-.18 E +EP +%%Page: 29 29 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-2)277.17 56 S 2.5(9-)288 56 S/F1 10/Times-Italic@0 +SF(De\214ne_T)97 92 Q(ype\(\))-.74 E F0 .173(is in)2.673 F -.2(vo)-.4 G -.1(ke) +.2 G 2.673(dw).1 G .174(ith the Scheme name of the type, the size of the type') +206.889 92 R 2.674(sr)-.55 G .174(epresentation in C)430.882 92 R .632 +(or C++ \(gi)72 112 R -.15(ve)-.25 G 3.132(na).15 G 3.131(sac)137.266 112 S +.631(onstant or as a function\), tw)156.298 112 R 3.131(of)-.1 G .631 +(unctions implementing the)282.464 112 R F1(eqv?)3.131 E F0(and)3.131 E F1 +(equal?)3.131 E F0(predicates)3.131 E .93(for objects of this type, a function\ + that is called by the interpreter to print an object of the ne)72 132 R 3.431 +(wt)-.25 G .931(ype \(the)470.579 132 R(type')72 152 Q(s)-.55 E F1 1.076 +(print function)3.576 F F0 1.076(\), and a function pro)B 1.075 +(viding information about the type to the g)-.15 F 1.075(arbage collector)-.05 +F 6.075(.T)-.55 G(he)494.56 152 Q .977(return v)72 172 R .977(alue of)-.25 F F1 +(De\214ne_T)3.477 E(ype\(\))-.74 E F0 .977(is a `)3.477 F(`handle')-.74 E 3.478 +('t)-.74 G 3.478(ot)258.81 172 S .978(he ne)270.068 172 R .978 +(wly de\214ned type \(a small, unique inte)-.25 F .978(ger\); its main)-.15 F +.793(uses are to check the type of ar)72 192 R .792 +(guments supplied to primiti)-.18 F 1.092 -.15(ve p)-.25 H .792 +(rocedures and to instantiate objects of this).15 F(type.)72 212 Q/F2 10 +/Times-Bold@0 SF 2.5(A.3. Primiti)72 252 R .2 -.1(ve P)-.1 H -.18(ro).1 G +(cedur).18 E(es \212 The Details)-.18 E F0(Listing 7 gi)97 275.6 Q -.15(ve)-.25 +G 2.5(st).15 G(he de\214nitions of the primiti)161.33 275.6 Q -.15(ve)-.25 G(s) +.15 E F1(dbm-open)2.5 E F0(and)2.5 E F1(dbm-close)2.5 E F0(.)A F1(dbm-open)97 +299.2 Q F0 3.196(,a)C 3.196(si)147.126 299.2 S 3.197(th)156.992 299.2 S .697 +(as an optional ar)167.969 299.2 R .697(gument, is a function with)-.18 F F1 +-.6(VA)3.197 G(RARGS).6 E F0 .697(calling discipline \(not to be)3.197 F 2.682 +(confused with the C language feature of the same name\), as indicated by the \ +last ar)72 319.2 R 2.681(gument to the)-.18 F F1(De\214ne_Primitive)72 339.2 Q +F0 2.5(call. Primiti)2.5 F -.15(ve)-.25 G 2.5(so).15 G 2.5(ft)212.98 339.2 S +(his type recei)221.59 339.2 Q .3 -.15(ve a)-.25 H 2.5(na).15 G(rray of)302.83 +339.2 Q F1(Objects)2.5 E F0(and a count.)2.5 E .222 +(The initial call to the macro)97 362.8 R F1(Mak)2.722 E(e_C_String)-.1 E F0 +.222(checks if the \214rst ar)2.722 F .222(gument to)-.18 F F1(dbm-open)2.722 E +F0 .223(is a string \(or a)2.722 F .368(symbol\) and con)72 382.8 R -.15(ve)-.4 +G .368(rts it to a C string.).15 F 1.968 -.8(To o)5.368 H .368 +(btain the second ar).8 F .368(gument to)-.18 F F1(dbm_open\(\))2.868 E F0 +2.867(,t)C .367(he symbol passed to)422.069 382.8 R 2.661(the Scheme primiti)72 +402.8 R 2.961 -.15(ve \()-.25 H F1 -.37(re).15 G(ader).37 E F0(,)A F1(writer) +5.161 E F0 5.161(,e)C 5.161(tc.\) has)241.465 402.8 R 2.662 +(to be mapped to a corresponding \215ags combination)5.161 F(\()72 422.8 Q F1 +(O_RDONL)A(Y)-.2 E F0(,)A F1(O_RD)3.126 E(WR)-.4 E F0 3.126(,e)C 3.126 +(tc.\). This)180.972 422.8 R .625(is accomplished by the Elk function)3.126 F +F1(Symbols_T)3.125 E(o_Bits\(\))-.92 E F0 3.125(;i)C 3.125(ti)456.78 422.8 S +3.125(si)465.465 422.8 S -1.9 -.4(nv o)475.26 422.8 T -.1(ke).4 G(d).1 E .176(\ +with a Scheme symbol, a \215ag indicating whether a single symbol or a list of\ + symbols \(a mask\) is to be con-)72 442.8 R -.15(ve)72 462.8 S .719 +(rted, and a table of pairs of symbol names and C inte).15 F 3.218(gers. The) +-.15 F .718(third ar)3.218 F .718(gument to)-.18 F F1(dbm_open)3.218 E F0 .718 +(is the \214le-)3.218 F(mode;)72 482.8 Q F1(Get_Inte)3.235 E -.1(ge)-.4 G +(r\(\)).1 E F0(con)3.235 E -.15(ve)-.4 G .735(rts a Scheme number to a C inte) +.15 F(ger)-.15 E(.)-.55 E F1(dbm-open)5.735 E F0 .736(\214nally allocates a ne) +3.236 F 3.236(wS)-.25 G(cheme)477.9 482.8 Q(object of type)72 502.8 Q F1(T_Dbm) +2.5 E F0 +(on the heap, initializes the components of the object, and returns it.)2.5 E +1.013(The auxiliary function)97 526.4 R F1(Chec)3.513 E(k_Dbm\(\))-.2 E F0 +1.013(is used by the remaining primiti)3.513 F -.15(ve)-.25 G 3.513(st).15 G +3.513(oc)403.16 526.4 S 1.012(heck whether a gi)416.113 526.4 R -.15(ve)-.25 G +(n).15 E .658(object is of type)72 546.4 R F1(dbm-\214le)3.158 E F0 .658 +(and if so, whether it is stale.)3.158 F .659 +(In this case an error is signaled;)5.659 F F1(Primitive_Err)3.159 E(or\(\)) +-.45 E F0(enters the error handler of Elk.)72 566.4 Q F1(P_Dbm_Close\(\))97 590 +Q F0(just marks the object as stale by setting)2.5 E F1(alive)2.5 E F0(to f)2.5 +E(alse and closes the database \214le.)-.1 E .795(Listing 8 sho)97 613.6 R .795 +(ws the implementation of)-.25 F F1(dbm-stor)3.295 E(e)-.37 E F0(and)3.295 E F1 +(dbm-fetc)3.295 E(h)-.15 E F0(.)A F1(Mak)5.795 E(e_Inte)-.1 E -.1(ge)-.4 G +(r\(\)).1 E F0 .795(is the counterpart)3.295 F(to)72 633.6 Q F1(Get_Inte)4.08 E +-.1(ge)-.4 G(r\(\)).1 E F0 4.08(;i)C 4.08(tc)147.98 633.6 S(on)159.28 633.6 Q +-.15(ve)-.4 G 1.58(rts a C inte).15 F 1.581(ger into a Scheme number)-.15 F +6.581(.L)-.55 G(ik)352.316 633.6 Q -.25(ew)-.1 G(ise,).25 E F1(Mak)4.081 E +(e_String\(\))-.1 E F0(con)4.081 E -.15(ve)-.4 G 1.581(rts a C).15 F +(string into a Scheme string.)72 653.6 Q EP +%%Page: 30 30 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-3)277.17 56 S 2.5(0-)288 56 S(___________________\ +___________________________________________________________________)74 105.6 Q +/F1 8/Courier@0 SF(static SYMDESCR Flag_Syms[] = {)100.346 127.103 Q 4.8({") +119.546 140.103 S(reader", O_RDONLY },)133.946 140.103 Q 4.8({")119.546 153.103 +S(writer", O_RDWR },)133.946 153.103 Q 4.8({")119.546 166.103 S +(create", O_RDWR|O_CREAT },)133.946 166.103 Q 4.8({0)119.546 179.103 S 4.8(,0}) +133.946 179.103 S(};)100.346 192.103 Q +(Object P_Dbm_Open\(argc, argv\) int argc; Object *argv; {)100.346 211.863 Q +(char *p;)119.546 224.863 Q(DBM *dp;)119.546 237.863 Q(Object d;)119.546 +250.863 Q(Make_C_String\(argv[0], p\);)119.546 270.623 Q +(dp = dbm_open\(p, Symbols_To_Bits\(argv[1], 0, Flag_Syms\),)119.546 283.623 Q +(argc == 3 ? Get_Integer\(argv[2]\) : 0666\);)186.746 296.623 Q(if \(dp == 0\)) +119.546 309.623 Q(return False;)138.746 322.623 Q 4.8(d=A)119.546 335.623 S +(lloc_Object\(sizeof\(struct S_Dbm\), T_Dbm, 0\);)143.546 335.623 Q +(DBMF\(d\)->dbm = dp;)119.546 348.623 Q(DBMF\(d\)->alive = 1;)119.546 361.623 Q +(return d;)119.546 374.623 Q(})100.346 387.623 Q +(void Check_Dbm\(d\) Object d; {)100.346 407.383 Q(Check_Type\(d, T_Dbm\);) +119.546 420.383 Q(if \(!DBMF\(d\)->alive\))119.546 433.383 Q +(Primitive_Error\("invalid dbm-file: ~s", d\);)138.746 446.383 Q(})100.346 +459.383 Q(Object P_Dbm_Close\(d\) Object d; {)100.346 479.143 Q +(Check_Dbm\(d\);)119.546 492.143 Q(DBMF\(d\)->alive = 0;)119.546 505.143 Q +(dbm_close\(DBMF\(d\)->dbm\);)119.546 518.143 Q(return Void;)119.546 531.143 Q +(})100.346 544.143 Q/F2 9/Times-Bold@0 SF(Listing 7:)152.577 578.143 Q/F3 9 +/Times-Roman@0 SF(ndbm e)4.5 E(xtension \212 implementation of)-.135 E/F4 9 +/Times-Italic@0 SF(dbm-open)2.25 E F3(and)2.25 E F4(dbm-close)2.25 E F0(______\ +______________________________________________________________________________\ +__)74 601.743 Q EP +%%Page: 31 31 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 10/Times-Roman@0 SF 2.5(-3)277.17 56 S 2.5(1-)288 56 S(___________________\ +___________________________________________________________________)74 105.6 Q +/F1 8/Courier@0 SF(static SYMDESCR Store_Syms[] = {)100.346 127.103 Q 4.8({") +119.546 140.103 S 4.8(insert", DBM_INSERT)133.946 140.103 R(},)4.8 E 4.8({") +119.546 153.103 S(replace", DBM_REPLACE },)133.946 153.103 Q 4.8({0)119.546 +166.103 S 4.8(,0})133.946 166.103 S(};)100.346 179.103 Q +(Object P_Dbm_Store\(d, key, content, flag\) Object d, key, content, flag; {) +100.346 198.863 Q(datum k, c;)119.546 211.863 Q(int result;)119.546 224.863 Q +(Check_Dbm\(d\);)119.546 244.623 Q(Check_Type\(key, T_String\);)119.546 257.623 +Q(Check_Type\(content, T_String\);)119.546 270.623 Q +(k.dptr = STRING\(key\)->data;)119.546 283.623 Q +(k.dsize = STRING\(key\)->size;)282.746 283.623 Q +(c.dptr = STRING\(content\)->data;)119.546 296.623 Q +(c.dsize = STRING\(content\)->size;)282.746 296.623 Q +(result = dbm_store\(DBMF\(d\)->dbm, k, c,)119.546 309.623 Q +(Symbols_To_Bits\(flag, 0, Store_Syms\)\);)210.746 322.623 Q +(return Make_Integer\(result\);)119.546 335.623 Q(})100.346 348.623 Q +(Object P_Dbm_Fetch\(d, key\) Object d, key; {)100.346 368.383 Q(datum k, c;) +119.546 381.383 Q(Check_Dbm\(d\);)119.546 401.143 Q +(Check_Type\(key, T_String\);)119.546 414.143 Q(k.dptr = STRING\(key\)->data;) +119.546 427.143 Q(k.dsize = STRING\(key\)->size;)282.746 427.143 Q 4.8(c=d) +119.546 440.143 S(bm_fetch\(DBMF\(d\)->dbm, k\);)143.546 440.143 Q +(return c.dptr ? Make_String\(c.dptr, c.dsize\) : False;)119.546 453.143 Q(}) +100.346 466.143 Q/F2 9/Times-Bold@0 SF(Listing 8:)153.058 500.143 Q/F3 9 +/Times-Roman@0 SF(ndbm e)4.5 E(xtension \212 implementation of)-.135 E/F4 9 +/Times-Italic@0 SF(dbm-stor)2.25 E(e)-.333 E F3(and)2.25 E F4(dbm-fetc)2.25 E +(h)-.135 E F0(________________________________________________________________\ +______________________)74 523.743 Q 2.5(-3)277.17 563.743 S 2.5(1-)288 563.743 +S EP +%%Trailer +end +%%EOF diff --git a/doc/util/Makefile b/doc/util/Makefile new file mode 100644 index 0000000..0d85a9a --- /dev/null +++ b/doc/util/Makefile @@ -0,0 +1,2 @@ +mkindex: mkindex.c + $(CC) $(CFLAGS) -o $@ $? diff --git a/doc/util/block.awk b/doc/util/block.awk new file mode 100644 index 0000000..0dd75f3 --- /dev/null +++ b/doc/util/block.awk @@ -0,0 +1,22 @@ +BEGIN { + firstchar = "@"; + a["a"] = "A"; a["b"] = "B"; a["c"] = "C"; + a["d"] = "D"; a["e"] = "E"; a["f"] = "F"; + a["g"] = "G"; a["h"] = "H"; a["i"] = "I"; + a["j"] = "J"; a["k"] = "K"; a["l"] = "L"; + a["m"] = "M"; a["n"] = "N"; a["o"] = "O"; + a["p"] = "P"; a["q"] = "Q"; a["r"] = "R"; + a["s"] = "S"; a["t"] = "T"; a["u"] = "U"; + a["v"] = "V"; a["w"] = "W"; a["x"] = "X"; + a["y"] = "Y"; a["z"] = "Z"; +} + +{ + c = substr($2,2,1); + if (c >= "a" && c <= "z") + c = a[c]; + if (c != firstchar) + printf(".LB %s\n", c); + firstchar = c; + print; +} diff --git a/doc/util/fixindex.awk b/doc/util/fixindex.awk new file mode 100644 index 0000000..02daf1d --- /dev/null +++ b/doc/util/fixindex.awk @@ -0,0 +1,73 @@ +BEGIN { + FS = "#"; + BD = "\\s+1\\f3"; + ED = "\\fP\\s-1"; +} + +NR == 1 { + if ($3 != "") + printf(".Ib \"%s\"\n", $2); + major = $2; + minor = $3; + if ($4 == "@DEF@") { + pagelist = BD $1 ED; + } + else { + pagelist = $1; + } + pageno = $1; + oldpageno = $1; + oldpagelist = ""; +} + +NR != 1 { + if ($2 == major && $3 == minor) # neither has changed + { + if ($1 != pageno) { # new page number, append + oldpageno = $1; + oldpagelist = pagelist; + if ($4 == "@DEF@") { + pagelist = pagelist ", " BD $1 ED; + } + else { + pagelist = pagelist ", " $1; + } + } + else { # old page, but check for def + if ($4 == "@DEF@") { + if (pageno == oldpageno) { + if (oldpagelist != "") + oldpagelist = oldpagelist ", " + } + pagelist = oldpagelist BD $1 ED; + } + } + } + else # one has changed + { + if (minor != "") # dump full record + printf(".I< \"%s\" \"%s\" \"%s\"\n", major, minor, pagelist); + else + printf(".I> \"%s\" \"%s\"\n", major, pagelist); + if ($4 == "@DEF@") { # restart pagelist + pagelist = BD $1 ED; + } + else { + pagelist = $1; + } + oldpagelist = ""; + oldpageno = $1; + if ($2 != major && $3 != "") # major has changed, minor not null + printf(".Ib \"%s\"\n", $2); + } + major = $2; + minor = $3; + pageno = $1; +} + +END { + if (minor != "") # dump full record + printf(".I< \"%s\" \"%s\" \"%s\"\n", major, minor, pagelist); + else + printf(".I> \"%s\" \"%s\"\n", major, pagelist); +} diff --git a/doc/util/mkindex.c b/doc/util/mkindex.c new file mode 100644 index 0000000..4fd2730 --- /dev/null +++ b/doc/util/mkindex.c @@ -0,0 +1,146 @@ +/* mkindex + * + * Copy named files or standard input (if no arguments are given) to + * standard output, replacing @[something] by troff macro calls. + * + * These replacements are performed: + * + * @[.something] --> \n.Ix "something"\nsomething + * @[!something] --> \n.Id "something"\nsomething + * + * @[.some|thing] --> \n.Ix "thing, some"\nsome thing + * @[!some|thing] --> \n.Id "thing, some"\nsome thing + * + * @[.=something] --> \n.Ix "something"\n + * @[!=something] --> \n.Id "something"\n + * + * + * 1) initial \n is omitted at the beginning of an output line + * + * 2) initial \n is prefixed by \c if @[ follows "(" in input + * + * 3) omit final \n if @[...] is at end of input line + * + * 4) within @[...], \] is replaced by ] + * + * 5) in the macro argument ("something"), all sequences of the form + * `` or '' or \fX or \% are removed + */ + +#include + +char *index(); + +char buf[10000]; +long line; +char *fn; + +main(ac, av) char **av; { + FILE *fp; + + if (ac < 2) { + fn = "stdin"; + doit(stdin); + } else { + while (--ac > 0) { + fn = *++av; + if ((fp = fopen(fn, "r")) == 0) { + perror(fn); exit(1); + } + doit(fp); + fclose(fp); + } + } + return 0; +} + +doit(fp) FILE *fp; { + char *p, *q, *start, *macro; + char inx[1000], arg[1000]; + int n, need_nl = 0; + + line = 1; + while (fgets(buf, 10000, fp) != NULL) { + if (p = index(buf, '\n')) + *p = 0; + p = buf; + while (*p) { + if (*p == '@' && p[1] == '[') { + start = p; + p += 2; + switch (*p) { + case '.': + macro = "Ix"; break; + case '!': + macro = "Id"; break; + case 0: + error("index truncated"); + default: + error("invalid index type"); + } + p++; + q = inx; + while (*p != ']') { + if (*p == 0) + error("missing ]"); + if (*p == '\\' && p[1] == ']') + p++; + *q++ = *p++; + } + if (q == inx) + error("empty index"); + *q = 0; + eatfont(inx, arg); + if (start > buf && start[-1] == '(') + printf("\\c"); + if (need_nl) + putchar('\n'); + printf(".%s ", macro); + p++; + if (arg[0] == '=') { + printf("\"%s\"", arg+1); + if (*p) { + putchar('\n'); + need_nl = 0; + if (*p == ' ') + p++; + } + } else if (q = index(arg, '|')) { + *q = 0; q++; + printf("\"%s, %s\"\n%s %s", q, arg, arg, q); + need_nl = 1; + } else { + printf("\"%s\"\n%s", arg, inx); + need_nl = 1; + } + } else { + putchar(*p); + need_nl = 1; + p++; + } + } + putchar('\n'); + need_nl = 0; + line++; + } +} + +eatfont(from, to) char *from, *to; { + while (*from) { + if (*from == '\\' && from[1] == 'f' && from[2]) { + from += 3; + } else if (*from == '\'' && from[1] == '\'') { + from += 2; + } else if (*from == '`' && from[1] == '`') { + from += 2; + } else if (*from == '\\' && from[1] == '%') { + from += 2; + } else *to++ = *from++; + } + *to = 0; +} + +error(s) char *s; { + fprintf(stderr, "Error in %s line %d, %s:\n%s\n", fn, line, s, buf); + exit(1); +} diff --git a/doc/util/tmac.index b/doc/util/tmac.index new file mode 100644 index 0000000..7feeb05 --- /dev/null +++ b/doc/util/tmac.index @@ -0,0 +1,33 @@ +. \" Macros for the index +.de Ib \" blank major entry +.br +.ne 2v +\\$1# +.. +.de I> \" major entry +.br +\\$1, \\$2 +.. +.de I< \" minor entry +.br + \\$2, \\$3 +.. +.de LB \" new letter starts here +.di DT \" start diverted text +.sp +\s+2\f3\\$1\fP\s-2 +.sp +.di \" end diverted text +.ne \\n(dnu+1v \" get enough space for it +.DT \" output it +.. +. +.bp +.XS +Index +.XE +.rs +.sp .5i +.tl '\&'\f3\s+2Index\s0\fP'\&' +.sp .5i +.2C diff --git a/doc/util/tmac.scheme b/doc/util/tmac.scheme new file mode 100644 index 0000000..25a7a9f --- /dev/null +++ b/doc/util/tmac.scheme @@ -0,0 +1,150 @@ +.\" Conditional requests using \n(.U have been added to most macros +.\" for unroff support; the number register .U is non-zero if the file +.\" is processed by unroff, else zero. +.\" +.\" A font suitable for Scheme keywords and program examples must be +.\" mounted on font position 5. +.\" For example: .fp 5 TT (Typewriter font) +.\" or: .fp 5 HR (Helvetica Roman) +.\" or: .fp 5 C (Courier) +.\" +.fp 5 C +.\" +.nr PS 11 +.nr VS 5i/24u +.\" US paper format. +.pl 11i +.\" The subscripts 1 and 2. +.ie \n(.U .ds 1 1 +.el .ds 1 "\v'.3m'\s-11\s0\v'-.3m' +.ie \n(.U .ds 2 2 +.el .ds 2 "\v'.3m'\s-12\s0\v'-.3m' +.\" +.\" The digit 4 as a superscript (used in R^4RS). +.ie \n(.U .ds ^4 ^4 +.el .ds ^4 \u\s-2\&4\s0\d +.\" +.\" Underline page top. +.de Ul +.am PT +.if \\\\n%-1 .tl ?\\\\v'-.6v'\\\\l'\\\\n(LLu\(ru'\\\\v'.6v' +\\.. +.. +.\" Index entry. +.de Ix +.if !\n(.U .tm \\n%#\\$1#\\$2#\\$3 +.. +.\" Index entry (definition). +.de Id +.Ix "\\$1" "\\$2" @DEF@ +.. +.\" Scheme code start. +.de Ss +.KS +.nr sF \\n(.f +.ft 5 +.ps -1 +.vs -1 +.ie \n(.U .RS +.el .in 1c +.nf +.if !\n(.U .sp .3c +.. +.\" Scheme code end. +.de Se +.sp .5 +.fi +.ie \n(.U .RE +.el .in +.ps +.vs +.ft \\n(sF +.KE +.. +.\" Scheme keyword in text. Inline font switches to italics +.\" should be used instead, but at least one document +.\" (oops/oops.ms) still uses this macro. +.de S +.ft 5 +.ps -1 +.if \\n(.$=1 \&\\$1 +.if \\n(.$>1 \&\\$1\c +.ft +.ps +.if \\n(.$>1 \&\\$2 +.. +.\" Chapter with TOC entry. +.de Ch +.br +.ne 3c +.NH +\\$1 +.XS +\\$1 +.XE +.. +.\" Called before first in a group of .Pr/.Sy/.Va. +.de Sh +.ie \n(.U .LP +.el .SH +.. +.\" Scheme procedure. +.de Pr +.ds xx " +.if \\n(.$>=2 .as xx " \f2\\$2\fP +.if \\n(.$>=3 .as xx " \f2\\$3\fP +.if \\n(.$>=4 .as xx " \f2\\$4\fP +.if \\n(.$>=5 .as xx " \f2\\$5\fP +.if \\n(.$>=6 .as xx " \f2\\$6\fP +.if \\n(.$>=7 .as xx " \f2\\$7\fP +.if \\n(.$>=8 .as xx " \f2\\$8\fP +.if \\n(.$>=9 .as xx " \f2\\$9\fP +.if !\\nP .Sh +.if \\n+P>2 .br +.ie \n(.U (\f3\\$1\fP\|\\*(xx) +.el .tl '(\\$1\|\\*(xx)'\&'procedure' +.Id "\\$1" +.. +.\" Scheme syntax form. +.de Sy +.ds xx " +.if \\n(.$>=2 .as xx " \f2\\$2\fP +.if \\n(.$>=3 .as xx " \f2\\$3\fP +.if \\n(.$>=4 .as xx " \f2\\$4\fP +.if \\n(.$>=5 .as xx " \f2\\$5\fP +.if \\n(.$>=6 .as xx " \f2\\$6\fP +.if \\n(.$>=7 .as xx " \f2\\$7\fP +.if \\n(.$>=8 .as xx " \f2\\$8\fP +.if \\n(.$>=9 .as xx " \f2\\$9\fP +.if !\\nP .Sh +.if \\n+P>2 .br +.ie \n(.U (\f3\\$1\fP\|\\*(xx) +.el .tl '(\\$1\|\\*(xx)'\&'syntax' +.Id "\\$1" +.. +.\" Scheme variable. +.de Va +.if !\\nP .Sh +.if \\n+P>2 .br +.ie \n(.U \f3\\$1\fP +.el .tl '\\$1'\&'variable' +.Id "\\$1" +.. +.nr P 0 +.\" .[[ and .]] enclose a group of .Pr/.Sy/.Va requests. +.de [[ +.nr P 1 1 +.Sh +.. +.de ]] +.nr P 0 0 +.. +.\" Output the table of contents. +.de Tc +.de PT +\\.. +.1C +.bp +.ie \n(.U .## (if (zero? (option 'split)) (parse-line ".PX")) +.el .PX +.. diff --git a/doc/xlib/Makefile b/doc/xlib/Makefile new file mode 100644 index 0000000..9380e78 --- /dev/null +++ b/doc/xlib/Makefile @@ -0,0 +1,24 @@ +MANUAL= xlib +TROFF= groff -ms -t +UNROFF= unroff -ms + +$(MANUAL).ps: $(MANUAL).ms index.ms + (cat $(MANUAL).ms ../util/tmac.index index.ms; echo ".Tc")\ + | $(TROFF) 2> /dev/null > $(MANUAL).ps + +$(MANUAL).html: $(MANUAL).ms + (cat $?; echo ".Tc") | $(UNROFF) document=$(MANUAL) + +index.ms: $(MANUAL).ms index.raw + sort -f -t# +1 -3 +0n index.raw | awk -f ../util/fixindex.awk\ + | awk -f ../util/block.awk >index.ms + +index.raw: $(MANUAL).ms + $(TROFF) $(MANUAL).ms 2> index.raw >/dev/null + +check: + checknr -c.Ul.Pr.Sy.Va.Sh.Ix.Id.Ch -a.Ss.Se.[[.]] $(MANUAL).ms |\ + grep -v "Empty command" + +clean: + rm -f index.raw index.ms $(MANUAL).ps $(MANUAL).html diff --git a/doc/xlib/xlib.ms b/doc/xlib/xlib.ms new file mode 100644 index 0000000..0fd8945 --- /dev/null +++ b/doc/xlib/xlib.ms @@ -0,0 +1,1904 @@ +.so ../util/tmac.scheme +.Ul +.TL +Elk/Xlib Reference Manual +.AU +Oliver Laumann +. +.Ch "Introduction" +.PP +This manual lists the functions, special forms, and variables +defined by the Xlib extension included in the Elk distribution. +Most of the functions are directly equivalent to a function of the +Xlib C library, so that the description need not be repeated. +In such cases, only the name of the corresponding Xlib function is +mentioned. +Thus, you should have the \f2Xlib \- C Language X Interface\fP +manual within reach when using this reference manual. +.PP +The functions listed in this document can be loaded by evaluating +the expression +.DS +.ft 5 +(require 'xlib). +.ft +.DE +.Ix xlib +in the interpreter's top level or in a Scheme program. +.PP +The types of arguments of the procedures listed below are not described +when they are obvious from the context or from the name. +For instance, an argument named \f2window\fP is always of type \f2window\fP, +an argument named \f2atom\fP is an object of type \f2atom\fP, etc. +Arguments the names of which end in ``?'' are always of type \f2boolean\fP. +.PP +If a function returns several items of the same type (for instance, +a list of windows), the return value is a vector of objects of this type. +If a function returns a collection of items of different types or +of different semantics, the return value is a list of objects +(or a pair). +In this case, \f2multiple-value-bind\fP +.Ix multiple-value-bind +can be used to bind variables to the return values. +.if !\n(.U \{\ +.PP +In the following, each description of a procedure, special form, or +variable lists the kind of object in boldface. +Here, \f3procedure\fP denotes either a primitive procedure or a +compound procedure, \f3syntax\fP denotes a special form or a macro, +and \f3variable\fP denotes a global variable that has some initial +value and can be re-assigned a new value by the user (by means +of \f2set!\fP or \f2fluid-let\fP). +.\} +. +.Ch "Display Functions" +. +.Pr display? x +.LP +Returns #t iff \f2x\fP is an object of type \f2display\fP. +. +.Pr open-display . name-of-display +.LP +See \f2XOpenDisplay\fP. +\f2name-of-display\fP is a string or a symbol. +If no name is specified, a NULL name will be passed to \f2XOpenDisplay\fP. +. +.Pr close-display display +.LP +See \f2XCloseDisplay\fP. +Finalizes all objects associated with the display, then closes +the display. +. +.[[ +.Pr display-default-root-window display +.Pr display-root-window display +.]] +.LP +See \f2XDefaultRootWindow\fP. +. +.[[ +.Pr display-default-colormap display +.Pr display-colormap display +.]] +.LP +See \f2XDefaultColormap\fP. +Returns the default colormap of the display's default screen. +. +.Pr display-default-gcontext display +.LP +See \f2XDefaultGC\fP. +Returns the default graphics context of the display's default screen. +. +.Pr display-default-depth display +.LP +See \f2XDefaultDepth\fP. +Returns the default depth of the display's default screen. +. +.Pr display-default-screen-number display +.LP +See \f2XDefaultScreen\fP. +Returns an integer. +. +.Pr display-cells display screen-number +.LP +See \f2XDisplayCells\fP. +Returns an integer. +. +.Pr display-planes display screen-number +.LP +See \f2XDisplayPlanes\fP. +Returns an integer. +. +.Pr display-string display +.LP +See \f2XDisplayString\fP. +Returns a string. +. +.Pr display-vendor display +.LP +See \f2XServerVendor\fP, \f2XVendorRelease\fP. +Returns a pair; the car is a string (the vendor identification), +and the cdr is an integer (the vendor release number). +. +.Pr display-protocol-version display +.LP +See \f2XProtocolVersion\fP, \f2XProtocolRevision\fP. +Returns a pair of integers (the X protocol's major and minor version numbers). +. +.Pr display-screen-count display +.LP +See \f2XScreenCount\fP. +Returns an integer. +. +.Pr display-image-byte-order display +.LP +See \f2XImageByteOrder\fP. +Returns a symbol (\f5lsb-first\fP or \f5msb-first\fP). +. +.Pr display-bitmap-unit display +.LP +See \f2XBitmapUnit\fP. +Returns an integer. +. +.Pr display-bitmap-bit-order display +.LP +See \f2XBitmapBitOrder\fP. +Returns a symbol (\f5lsb-first\fP or \f5msb-first\fP). +. +.Pr display-bitmap-pad display +.LP +See \f2XBitmapPad\fP. +Returns an integer. +. +.[[ +.Pr display-width display +.Pr display-height display +.]] +.LP +See \f2XDisplayWidth\fP, \f2XDisplayHeight\fP. +Returns the width/height of the display's default screen. +. +.[[ +.Pr display-width-mm display +.Pr display-height-mm display +.]] +.LP +See \f2XDisplayWidthMM\fP, \f2XDisplayHeightMM\fP. +Returns the width/height of the display's default screen in millimeters. +. +.Pr display-motion-buffer-size display +.LP +See \f2XDisplayMotionBufferSize\fP. +Returns an integer. +. +.Pr display-flush-output display +.LP +See \f2XFlush\fP. +. +.Pr display-wait-output display discard-events? +.LP +See \f2XSync\fP. +. +.Pr no-op display +.LP +See \f2XNoOp\fP. +. +.Pr list-depths display screen-number +.LP +See \f2XListDepths\fP. +Returns a vector of integers. +. +.Pr list-pixmap-formats display +.LP +See \f2XListPixmapFormats\fP. +Returns a vector of lists of three integers (depth, bits per pixel, +and scanline pad). +. +.Pr set-after-function! display procedure +.LP +See \f2XSetAfterFunction\fP. +Returns the old after function. +If \f2procedure\fP is #f, the current after function is disassociated +from the display. +. +.Pr after-function display +.LP +Returns the after function currently associated with the given +display (#f if there is none). +. +.Pr synchronize display +.LP +Sets the display's after function to \f2display-wait-output\fP. +. +.Ch "Window Functions" +. +.Pr window? x +.LP +Returns #t iff \f2x\fP is an object of type \f2window\fP. +. +.Pr drawable? x +.LP +Returns #t iff \f2x\fP is a ``drawable'' (window or pixmap). +. +.Pr window-display window +.LP +Returns the display associated with the window. +. +.Pr create-window . args +.LP +See \f2XCreateWindow\fP. +This function is used to create a new window. +.LP +The number of arguments must be even. +The 1st, 3rd, etc. argument is the name (a symbol) of an attribute +to be set when the window is created, the 2nd, 4th, etc.\& argument +is the corresponding value. +The attributes can be specified in any order. +.LP +Attributes are \f2x\fP, \f2y\fP, \f2width\fP, \f2height\fP, +\f2border\fP (each of which has an integer value), \f2parent\fP +(the parent window), and all attributes that can be set by means +of the \f5set-window-\fP\f2attribute\fP\f5!\fP functions below +except \f2sibling\fP and \f2stack-mode\fP. +The attributes \f2parent\fP, \f2width\fP, and \f2height\fP are +mandatory. +The default for \f2x\fP and \f2y\fP is 0, the default for +\f2border\fP is 2. +. +.[[ +.Pr set-window-x! window value +.Pr set-window-y! window value +.Pr set-window-width! window value +.Pr set-window-height! window value +.Pr set-window-border-width! window value +.Pr set-window-sibling! window value +.Pr set-window-stack-mode! window value +.Pr set-window-background-pixmap! window value +.Pr set-window-background-pixel! window value +.Pr set-window-border-pixmap! window value +.Pr set-window-border-pixel! window value +.Pr set-window-bit-gravity! window value +.Pr set-window-gravity! window value +.Pr set-window-backing-store! window value +.Pr set-window-backing-planes! window value +.Pr set-window-backing-pixel! window value +.Pr set-window-save-under! window value +.Pr set-window-event-mask! window value +.Pr set-window-do-not-propagate-mask! window value +.Pr set-window-override-redirect! window value +.Pr set-window-colormap! window value +.Pr set-window-cursor! window value +.]] +.LP +See \f2XConfigureWindow\fP, \f2XChangeWindowAttributes\fP. +Set the sibling window, stacking mode, background pixmap, background +pixel, border pixel, cursor, and other attributes (see +the \f5window-\fP functions below) of the specified window. +.LP +The stacking mode is a symbol (\f5above\fP, \f5below\fP, \f5top-if\fP, +\f5bottom-if\fP, \f5opposite\fP). +The \f2value\fP argument to \f2set-window-sibling!\fP must be a window, +\f2set-window-background-pixmap!\fP expects a pixmap, +\f2set-window-background-pixel!\fP and \f2set-window-border-pixel!\fP +expect a pixel, and \f2set-window-cursor!\fP expects a cursor argument. +For the types of the \f2value\fP argument of the other functions +see the return values of the \f2window-\fP functions below. +. +.[[ +.Pr window-x window +.Pr window-y window +.Pr window-width window +.Pr window-height window +.Pr window-border-width window +.Pr window-depth window +.Pr window-visual window +.Pr window-root window +.Pr window-class window +.Pr window-bit-gravity window +.Pr window-gravity window +.Pr window-backing-store window +.Pr window-backing-planes window +.Pr window-backing-pixel window +.Pr window-save-under window +.Pr window-colormap window +.Pr window-map-installed window +.Pr window-map-state window +.Pr window-all-event-masks window +.Pr window-your-event-mask window +.Pr window-do-not-propagate-mask window +.Pr window-override-redirect window +.Pr window-screen window +.]] +.LP +See \f2XGetWindowAttributes\fP. +Returns the x and y coordinates, width, height, border width, +depth, visual, root window, class, bit gravity, window gravity, +backing store availability, backing planes, backing pixel, +save under availability, colormap, colormap installation information, +map state, global event mask, local event mask, ``do-not-propagate'' mask, +override redirect attribute, and screen of the specified window. +.LP +\f2window-visual\fP and \f2window-screen\fP always return the empty +list in the current release of the software. +\f2window-root\fP returns a window. +\f2window-class\fP returns a symbol (\f5input-output\fP, \f5input-only\fP). +\f2window-bit-gravity\fP returns a symbol (\f5forget\fP, \f5north-west\fP, +\f5north\fP, \f5north-east\fP, \f5west\fP, \f5center\fP, \f5east\fP, +\f5south-west\fP, \f5south\fP, \f5south-east\fP, \f5static\fP). +\f2window-gravity\fP returns a symbol (same as \f2window-bit-gravity\fP +with \f5unmap\fP instead of \f5forget\fP). +\f2window-backing-store\fP returns a symbol (\f5not-useful\fP, +\f5when-mapped\fP, \f5always\fP). +\f2window-backing-planes\fP and \f2window-backing-pixel\fP return +a pixel. +\f2window-save-under\fP, \f2window-map-installed\fP and +\f2window-override-redirect\fP return #t or #f. +\f2window-colormap\fP returns a colormap. +\f2window-map-state\fP returns a symbol (\f5unmapped\fP, +\f5unviewable\fP, \f5viewable\fP). +\f2window-all-event-masks\fP, \f2window-your-event-mask\fP, and +\f2window-do-not-propagate-mask\fP return a list of symbols +(event mask names such as \f5enter-window\fP, \f5pointer-motion\fP, etc.). +All other functions return an integer. +. +.[[ +.Pr drawable-root drawable +.Pr drawable-x drawable +.Pr drawable-y drawable +.Pr drawable-width drawable +.Pr drawable-height drawable +.Pr drawable-border-width drawable +.Pr drawable-depth drawable +.]] +.LP +See \f2XGetGeometry\fP. +Returns the root window, x and y coordinates, width, height, +border width, and depth of the specified drawable. +\f2drawable-root\fP returns a window, all other functions return +an integer. +. +.Pr map-window window +.LP +See \f2XMapWindow\fP. +. +.Pr unmap-window window +.LP +See \f2XUnmapWindow\fP. +. +.Pr destroy-window window +.LP +See \f2XDestroyWindow\fP. +. +.Pr destroy-subwindows window +.LP +See \f2XDestroySubwindows\fP. +. +.Pr map-subwindows window +.LP +See \f2XMapSubwindows\fP. +. +.Pr unmap-subwindows window +.LP +See \f2XUnmapSubwindows\fP. +. +.Pr circulate-subwindows window direction +.LP +See \f2XCirculateSubwindows\fP. +\f2direction\fP is a symbol (\f5raise-lowest\fP or \f5lower-highest\fP). +. +.Pr clear-window window +.LP +Performs a \f2clear-area\fP on the entire window. +. +.Pr raise-window window +.LP +See \f2XRaiseWindow\fP. +. +.Pr lower-window window +.LP +See \f2XLowerWindow\fP. +. +.Pr restack-windows list-of-windows +.LP +See \f2XRestackWindows\fP. +. +.Pr query-tree window +.LP +See\f2 XQueryTree\fP. +Returns a list of three elements: root window, parent window, and +children (a vector of windows). +. +.Pr translate-coordinates src-window x y dst-window +.LP +See \f2XTranslateCoordinates\fP. +Returns a list of three elements: destination x and y, and child window. +. +.Pr query-pointer window +.LP +See \f2XQueryPointer\fP. +Returns a list of eight elements: x and y, a boolean indicating whether +the pointer is on the same screen as the specified window, the root +window, the root window's x and y coordinates, the child window, +and a list of modifier names (see \f2grab-button\fP +.Ix grab-button +below). +. +.Ch "Window Property and Selection Functions" +. +.Pr atom? x +.LP +Returns #t iff \f2x\fP is an object of type \f2atom\fP. +. +.Pr make-atom value +.LP +Returns an atom with the given \f2value\fP. +\f2value\fP is an integer. +. +.Pr intern-atom display name +.LP +See \f2XInternAtom\fP. +\f2name\fP is a string or a symbol. +The atom is created if it does not yet exist. +. +.Pr find-atom display name +.LP +See \f2XInternAtom\fP. +\f2name\fP is a string or a symbol. +If the atom does not exist, the symbol \f5none\fP is returned. +. +.Pr atom-name display atom +.LP +See \f2XGetAtomName\fP. +Returns a string. +. +.Pr list-properties window +.LP +See \f2XListProperties\fP. +Returns a vector of atoms. +. +.Pr get-property window property request-type offset length delete? +.LP +See \f2XGetWindowProperty\fP. +\f2property\fP is an object of type \f2atom\fP. +\f2request-type\fP is an atom or #f in which case \f2AnyPropertyType\fP +will be used. +\f2offset\fP and \f2length\fP are integers. +An error is signaled if \f2XGetWindowProperty\fP fails. +.LP +\f2get-property\fP returns a list of four items: the ``actual type'' +(an atom), the format (an integer), the data (if any, the empty list +otherwise), and the number of bytes left (an integer). +.LP +The data returned is either a string (if the format indicates +8-bit data) or a vector of integers. +. +.Pr change-property window property type format mode data +.LP +See \f2XChangeProperty\fP. +\f2property\fP and \f2type\fP are atoms. +\f2format\fP is an integer (8, 16, or 32). +If \f2format\fP is 8 \f2data\fP must be a string, otherwise a vector of +integers of the appropriate size. +An error is signaled if the +value of \f2format\fP is invalid or if \f2data\fP holds an integer +that exceeds the size indicated by \f2format\fP. +\f2mode\fP is a symbol (\f5replace\fP, \f5prepend\fP, or \f5append\fP). +. +.Pr delete-property window property +.LP +See \f2XDeleteProperty\fP. +. +.Pr rotate-properties window vector-of-atoms delta +.LP +See \f2XRotateWindowProperties\fP. +\f2delta\fP is the amount to rotate (an integer). +. +.Pr set-selection-owner! display selection owner time +.LP +See \f2XSetSelectionOwner\fP. +\f2selection\fP is an atom; \f2owner\fP is a window; \f2time\fP is an +integer or the symbol \f5now\fP (for \f2CurrentTime\fP). +. +.Pr selection-owner display selection +.LP +See \f2XGetSelectionOwner\fP. +. +.Pr convert-selection selection target property requestor-window time +.LP +See \f2XConvertSelection\fP. +\f2selection\fP and \f2target\fP are atoms; +\f2property\fP is an atom or the symbol \f5none\fP. +. +.Ch "Colormap Functions" +. +.Pr color? x +.LP +Returns #t iff \f2x\fP is an object of type \f2color\fP. +. +.Pr make-color r g b +.LP +Returns an object of type \f2color\fP with the specified RGB components. +\f2r\fP, \f2g\fP, and \f2b\fP are reals in the range 0.0 to 1.0. +. +.Pr color-rgb-values color +.LP +Returns a list of three elements, the RGB components of the +given color (see \f2make-color\fP +.Ix make-color +above). +. +.Pr query-color colormap pixel +.LP +See \f2XQueryColor\fP. +. +.Pr query-colors colormap pixels +.LP +See \f2XQueryColors\fP. +\f2pixels\fP is a vector of pixels. +Returns a vector of colors of the same size as \f2pixels\fP. +. +.Pr lookup-color colormap color-name +.LP +See \f2XLookupColor\fP. +\f2color-name\fP is a string or a symbol. +Returns a pair of colors. +. +.Pr alloc-color colormap color +.LP +See \f2XAllocColor\fP. +Returns a pixel (or #f in case of an error). +. +.Pr alloc-named-color colormap color-name +.LP +See \f2AllocNamedColor\fP. +\f2color-name\fP is a string or a symbol. +Returns a list of three elements: a pixel, and two colors (the closest +color and the exact color); or #f in case of an error. +. +.Pr colormap? x +.LP +Returns #t iff \f2x\fP is an object of type \f2colormap\fP. +. +.Pr colormap-display colormap +.LP +Returns the display associated with the given colormap. +. +.Pr free-colormap colormap +.LP +See \f2XFreeColormap\fP. +. +.Ch "Pixel Functions" +. +.Pr pixel? x +.LP +Returns #t iff \f2x\fP is an object of type \f2pixel\fP. +. +.Pr pixel-value pixel +.LP +Returns the value of the pixel as an unsigned integer. +. +.[[ +.Pr black-pixel display +.Pr white-pixel display +.]] +.LP +See \f2XBlackPixel\fP, \f2XWhitePixel\fP. +Returns the black/white pixel of the display's default screen. +. +.Ch "Pixmap Functions" +. +.Pr pixmap? x +.LP +Returns #t iff \f2x\fP is an object of type \f2pixmap\fP. +. +.Pr pixmap-display pixmap +.LP +Returns the display associated with the pixmap. +. +.Pr free-pixmap pixmap +.LP +See \f2XFreePixmap\fP. +. +.Pr create-pixmap drawable width height depth +.LP +See \f2XCreatePixmap\fP. +. +.Pr create-bitmap-from-data window data width height +.LP +See \f2XCreateBitmapFromData\fP. +\f2data\fP is a string. +\f5(* width height)\fP must not exceed the number of bits in \f2string\fP. +. +.Pr create-pixmap-from-bitmap-data win data width height foregrnd backgrnd depth +.LP +See \f2XCreatePixmapFromBitmapData\fP. +\f2data\fP is a string. +\f5(* width height)\fP must not exceed the number of bits in \f2string\fP. +. +.Pr read-bitmap-file drawable filename +.LP +See \f2XReadBitmapFile\fP. +\f2filename\fP is a string or a symbol. +If \f2XReadBitmapFile\fP signals an error, \f2read-bitmap-file\fP +returns a symbol (\f5open-failed\fP, \f5file-invalid\fP, or \f5no-memory\fP). +If it succeeds, \f2read-bitmap-file\fP returns a list of five elements: +the bitmap (an object of type \f2pixmap\fP), the width and height of the +bitmap, and the x and y coordinates of the hotspot. +. +.Pr write-bitmap-file filename pixmap width height x-hot y-hot +.LP +See \f2XWriteBitmapFile\fP. +\f2filename\fP is a string or a symbol. +\f2x-hot\fP and \f2y-hot\fP are optional +(\(mi1 is used if they are omitted), but either both or none of them +must be given. +\f2write-bitmap-file\fP returns a symbol (\f5success\fP, \f5open-failed\fP, +\f5file-invalid\fP, or \f5no-memory\fP). +. +.Ch "Graphics Context Functions" +. +.Pr gcontext? x +.LP +Returns #t iff \f2x\fP is an object of type \f2gcontext\fP. +. +.Pr gcontext-display gcontext +.LP +Returns the display associated with the given GC. +. +.Pr create-gcontext . args +.LP +See \f2XCreateGC\fP. +This function is used to create a new GC. +.LP +The number of arguments must be even. +The 1st, 3rd, etc. argument is the name (a symbol) of an attribute +to be set when the graphics context is created, the 2nd, 4th, etc.\& argument +is the corresponding value. +The attributes can be specified in any order. +.LP +Attributes are \f2window\fP (a drawable; mandatory) and all the attributes +that can be set by the \f5set-gcontext-\fP\f2attribute\fP\f5!\fP functions +below. +. +.Pr copy-gcontext gcontext drawable +.LP +See \f2XCopyGC\fP. +Returns a copy of \f2gcontext\fP (associated with the specified drawable). +. +.Pr free-gcontext gcontext +.LP +See \f2XFreeGC\fP. +. +.Pr query-best-size display width height shape +.LP +See \f2XQueryBestSize\fP. +\f2shape\fP is a symbol (\f5cursor\fP, \f5tile\fP, or \f5stipple\fP). +Returns a pair of integers (result width and result height). +. +.[[ +.Pr query-best-cursor display width height +.Pr query-best-tile display width height +.Pr query-best-stipple display width height +.]] +.LP +See \f2XQueryBestSize\fP. +Invokes \f2query-best-size\fP with the given arguments and a shape +of \f5cursor\fP, \f5tile\fP, or \f5stipple\fP, respectively. +. +.[[ +.Pr gcontext-function gcontext +.Pr gcontext-plane-mask gcontext +.Pr gcontext-foreground gcontext +.Pr gcontext-background gcontext +.Pr gcontext-line-width gcontext +.Pr gcontext-line-style gcontext +.Pr gcontext-cap-style gcontext +.Pr gcontext-join-style gcontext +.Pr gcontext-fill-style gcontext +.Pr gcontext-fill-rule gcontext +.Pr gcontext-arc-mode gcontext +.Pr gcontext-tile gcontext +.Pr gcontext-stipple gcontext +.Pr gcontext-ts-x gcontext +.Pr gcontext-ts-y gcontext +.Pr gcontext-subwindow-mode gcontext +.Pr gcontext-exposures gcontext +.Pr gcontext-clip-x gcontext +.Pr gcontext-clip-y gcontext +.Pr gcontext-dash-offset gcontext +.]] +.LP +See \f2XGetGCValues\fP. +Returns the +logical operation, plane mask, foreground and background pixel +value, line width and style, cap and join style, fill style and rule, +arc mode, tiling and stippling pixmap, tiling x- and y-origin, +subwindow mode, clipping x- and y-origin, and dashed line +information of the specified graphics context. +.LP +\f2gcontext-function\fP returns a symbol +(\f5clear\fP, \f5and\fP, \f5and-reverse\fP, \f5copy\fP, \f5and-inverted\fP, +\f5no-op\fP, \f5xor\fP, \f5or\fP, \f5nor\fP, \f5equiv\fP, \f5invert\fP, +\f5or-reverse\fP, \f5copy-inverted\fP, \f5nand\fP, or \f5set\fP). +\f2gcontext-plane-mask\fP, \f2gcontext-foreground\fP, +and \f2gcontext-background\fP return a pixel. +\f2gcontext-tile\fP and \f2gcontext-stipple\fP return a pixmap. +The line style is a symbol (\f5solid\fP, \f5dash\fP, \f5double-dash\fP); +the cap style is a symbol (\f5not-last\fP, \f5butt\fP, \f5round\fP, +\f5projecting\fP); the join style is a symbol (\f5miter\fP, \f5round\fP, +\f5bevel\fP); the fill style is a symbol (\f5solid\fP, \f5tiled\fP, +\f5stippled\fP, \f5opaque-stippled\fP); the fill rule is a symbol +(\f5even-odd\fP, \f5winding\fP); the arc mode is a symbol (\f5chord\fP, +\f5pie-slice\fP); the subwindow-mode is a symbol +(\f5clip-by-children\fP, \f5include-inferiors\fP). +\f2gcontext-exposures\fP returns a boolean. +All other functions return an integer. +. +.[[ +.Pr set-gcontext-function! gcontext value +.Pr set-gcontext-plane-mask! gcontext value +.Pr set-gcontext-foreground! gcontext value +.Pr set-gcontext-background! gcontext value +.Pr set-gcontext-line-width! gcontext value +.Pr set-gcontext-line-style! gcontext value +.Pr set-gcontext-cap-style! gcontext value +.Pr set-gcontext-join-style! gcontext value +.Pr set-gcontext-fill-style! gcontext value +.Pr set-gcontext-fill-rule! gcontext value +.Pr set-gcontext-arc-mode! gcontext value +.Pr set-gcontext-tile! gcontext value +.Pr set-gcontext-stipple! gcontext value +.Pr set-gcontext-ts-x! gcontext value +.Pr set-gcontext-ts-y! gcontext value +.Pr set-gcontext-font! gcontext value +.Pr set-gcontext-subwindow-mode! gcontext value +.Pr set-gcontext-exposures! gcontext value +.Pr set-gcontext-clip-x! gcontext value +.Pr set-gcontext-clip-y! gcontext value +.Pr set-gcontext-clip-mask! gcontext value +.Pr set-gcontext-dash-offset! gcontext value +.]] +.LP +See \f2XChangeGC\fP. +Sets the logical operation, plane mask, foreground and background pixel +value, line width and style, cap and join style, fill style and rule, +arc mode, tiling and stippling pixmap, tiling x- and y-origin, font, +subwindow mode, clipping x- and y-origin, clipping bitmap, and dashed line +information for the specified graphics context. +.LP +The \f2value\fP argument to \f2set-gcontext-font!\fP is a font, +and the \f2value\fP argument to \f2set-gcontext-clip-mask!\fP +is a pixmap. +For the types of the \f2value\fP argument of the other functions +see the return values of the \f2gcontext-\fP functions above. +. +.Pr set-gcontext-clip-rectangles! gcontext x y rectangles ordering +.LP +See \f2XSetClipRectangles\fP. +\f2x\fP and \f2y\fP are integers (the coordinates of the clip-mask origin). +\f2rectangles\fP is a vector of lists of four integers (x, y, width, +and height of each rectangle). +\f2ordering\fP is a symbol (\f5unsorted\fP, \f5y-sorted\fP, \f5yx-sorted\fP, +or \f5yx-banded\fP). +. +.Pr set-gcontext-dashlist! gcontext dash-offset dash-list +.LP +See \f2XSetDashes\fP. +\f2dash-offset\fP is an integer. +\f2dash-list\fP is a vector of integers between 0 and 255. +. +.Ch "Graphics Functions" +. +.Pr clear-area window x y width height exposures? +.LP +See \f2XClearArea\fP. +. +.Pr copy-area src-drawable gcontext src-x src-y width height dst-drawable "dst-x dst-y" +.LP +See \f2XCopyArea\fP. +. +.Pr copy-plane src-drawable gcontext plane src-x src-y width height "dst-drawable dst-x dst-y" +.LP +See \f2XCopyPlane\fP. +\f2plane\fP is an integer. +An error is signaled unless exactly one bit is set in \f2plane\fP. +. +.Pr draw-point drawable gcontext x y +.LP +See \f2XDrawPoint\fP. +. +.Pr draw-points drawable gcontext vector-of-points relative? +.LP +See \f2XDrawPoints\fP. +\f2vector-of-points\fP is a vector of pairs consisting of two integers +(the x and y coordinates). +If \f2relative?\fP is #t, \f2CoordModePrevious\fP +is passed to \f2XDrawPoints\fP, otherwise \f2CoordModeOrigin\fP is used. +. +.Pr draw-line drawable gcontext x1 y1 x2 y2 +.LP +See \f2XDrawLine\fP. +. +.Pr draw-lines drawable gcontext vector-of-points relative? +.LP +See \f2XDrawLines\fP. +See \f2draw-points\fP +.Ix draw-points +above. +. +.Pr draw-segments drawable gcontext vector-of-points +.LP +See \f2XDrawSegments\fP. +\f2vector-of-points\fP is a vector of lists of four integers +(x1, y1, x2, and y2). +. +.Pr draw-rectangle drawable gcontext x y width height +.LP +See \f2XDrawRectangle\fP. +. +.Pr fill-rectangle drawable gcontext x y width height +.LP +See \f2XFillRectangle\fP. +. +.Pr draw-rectangles drawable gcontext vector-of-rectangles +.LP +See \f2XDrawRectangles\fP. +\f2vector-of-rectangles\fP is a vector of lists of four integers +(x, y, width, and height of each rectangle). +. +.Pr fill-rectangles drawable gcontext vector-of-rectangles +.LP +See \f2XFillRectangles\fP. +See \f2draw-rectangles\fP +.Ix draw-rectangles +above. +. +.Pr draw-arc drawable gcontext x y width height angle1 angle2 +.LP +See \f2XDrawArc\fP. +. +.Pr fill-arc drawable gcontext x y width height angle1 angle2 +.LP +See \f2XFillArc\fP. +. +.Pr draw-arcs drawable gcontext vector-of-data +.LP +See \f2XDrawArcs\fP. +\f2vector-of-data\fP is a vector of lists of six integers +(x, y, width, height, angle1, and angle2). +. +.Pr fill-arcs drawable gcontext vector-of-data +.LP +See \f2XFillArcs\fP. +See \f2draw-arcs\fP +.Ix draw-arcs +above. +. +.Pr fill-polygon drawable gcontext vector-of-points relative? shape +.LP +See \f2XFillPolygon\fP. +See \f2draw-points\fP +.Ix draw-points +above. +\f2shape\fP is a symbol (\f5complex\fP, \f5non-convex\fP, or \f5convex\fP). +. +.Ch "Font Functions" +. +.Pr font? x +.LP +Returns #t iff \f2x\fP is an object of type \f2font\fP. +. +.Pr font-display +.LP +Returns the display associated with the given font. +. +.Pr open-font display font-name +.LP +See \f2XLoadQueryFont\fP. +\f2font-name\fP is a string or a symbol. +. +.Pr close-font font +.LP +See \f2XUnloadFont\fP. +. +.Pr font-name font +.LP +Returns the name of the specified font (a string) or #f if the name could +not be determined (e.\|g.\& when the font has been obtained by a call +to \f2gcontext-font\fP). +. +.Pr gcontext-font gcontext +.LP +Calls \f2XQueryFont\fP with the GC obtained by \f2XGContextFromGC\fP. +Only a limited number of functions can be applied to a font +returned by \f2gcontext-font\fP, since it has neither a name nor +a font-ID. +. +.Pr list-font-names display pattern +.LP +See \f2XListFonts\fP. +\f2pattern\fP is a string or a symbol. +Returns a vector of font names (strings). +. +.Pr list-fonts display pattern +.LP +See \f2XListFontsWithInfo\fP. +\f2pattern\fP is a string or a symbol. +Returns a vector of fonts. +These fonts are ``pseudo fonts'' which do not have a font-ID. +A pseudo font is loaded automatically and turned into a ``real'' +font the first time it is passed to a function that makes use +of the font-ID. +. +.[[ +.Pr font-direction font +.Pr font-min-byte2 font +.Pr font-max-byte2 font +.Pr font-min-byte1 font +.Pr font-max-byte1 font +.Pr font-all-chars-exist? font +.Pr font-default-char font +.Pr font-ascent font +.Pr font-descent font +.]] +.LP +These functions return the font direction as a symbol (\f5left-to-right\fP +or \f5right-to-left\fP), the first and last character (as an integer), +the first and last row (integer), an indication whether all characters +have non-zero size (boolean), the default character (integer), and the +ascent and descent (integer) of the specified font. +. +.[[ +.Pr char-rbearing font index +.Pr char-lbearing font index +.Pr char-width font index +.Pr char-ascent font index +.Pr char-descent font index +.]] +.LP +These functions return the metrics of +the character specified by the integer \f2index\fP of the given font. +Each function returns an integer. +\f2font\fP can be a 1-byte as well as a 2-byte font. +. +.[[ +.Pr max-char-lbearing font +.Pr max-char-rbearing font +.Pr max-char-width font +.Pr max-char-ascent font +.Pr max-char-descent font +.]] +.LP +These functions return the maximum metrics over all characters +in the specified font. +Each function returns an integer. +. +.[[ +.Pr min-char-lbearing font +.Pr min-char-rbearing font +.Pr min-char-width font +.Pr min-char-ascent font +.Pr min-char-descent font +.]] +.LP +These functions return the minimum metrics over all characters +in the specified font. +Each function returns an integer. +. +.Pr font-properties font +.LP +Returns a vector of font properties; each element of the vector +is a pair consisting of the property name (an atom) and an +unsigned integer (the value of the property). +. +.Pr font-property font property-name +.LP +Returns the value of the specified property associated with the +specified font. +\f2property-name\fP is a string or a symbol. +. +.Pr font-path display +.LP +See \f2XGetFontPath\fP. +Returns the current font path as a vector of strings. +. +.Pr set-font-path! display path +.LP +See \f2XSetFontPath\fP. +\f2path\fP is a list; each element is a string or a symbol. +. +.Ch "Text Metrics and Text Drawing Functions" +. +.Pr text-width font text format +.LP +See \f2XTextWidth\fP, \f2XTextWidth16\fP. +\f2format\fP indicates whether 8-bit or 16-bit text is used; it is either +the symbol \f51-byte\fP or the symbol \f52-byte\fP. +\f2text\fP is a vector of integers; the integers must not exceed the +size indicated by the format. +. +.[[ +.Pr extents-lbearing font text format +.Pr extents-rbearing font text format +.Pr extents-width font text format +.Pr extents-ascent font text format +.Pr extents-descent font text format +.]] +.LP +See \f2XTextExtents\fP, \f2XTextExtents16\fP. +These functions are used to compute the overall metrics of an 8-bit +or 16-bit character string. +Each function returns an integer. +For the format of \f2text\fP and \f2format\fP see \f2text-width\fP +.Ix text-width +above. +. +.Pr draw-image-text drawable gcontext x y text format +.LP +See \f2XDrawImageString\fP, \f2XDrawImageString16\fP. +See \f2text-width\fP +.Ix text-width +above. +. +.Pr draw-poly-text drawable gcontext x y text format +.LP +See \f2XDrawText\fP, \f2XDrawText16\fP. +See \f2text-width\fP +.Ix text-width +above. +\f2text\fP is a vector of integers with intermixed objects of type \f2font\fP. +. +.Pr translate-text string +.LP +Converts the string into a representation suitable as an argument +to \f2text-width\fP, \f2draw-image-text\fP, or \f2draw-poly-text\fP +(a vector of integers obtained by applying \f2char\(mi>integer\fP +to the characters of the string argument). +. +.Ch "Cursor Functions" +. +.Pr cursor? x +.LP +Returns #t iff \f2x\fP is an object of type \f2cursor\fP. +. +.Pr cursor-display cursor +.LP +Returns the display associated with the given cursor. +. +.Pr free-cursor +.LP +See \f2XFreeCursor\fP. +. +.Pr create-cursor src mask x y foreground background +.LP +See \f2XCreatePixmapCursor\fP. +\f2src\fP and \f2mask\fP are pixmaps. +\f2mask\fP can be the symbol \f5none\fP. +. +.Pr create-glyph-cursor src src-char mask mask-char foreground background +.LP +See \f2XCreateGlyphCursor\fP. +\f2src\fP and \f2mask\fP are fonts. +\f2mask\fP can be the symbol \f5none\fP. +The display is obtained from \f2src\fP. +\f2src-char\fP and \f2mask-char\fP are integers. +. +.Pr create-font-cursor display src-char +.LP +See \f2XCreateGlyphCursor\fP. +Calls \f2create-glyph-cursor\fP with the font named ``cursor'', the +specified \f2src-char\fP, a \f2mask-char\fP of \f5(1+ src-char)\fP, +black foreground, and white background. +. +.Pr recolor-cursor cursor foreground background +.LP +See \f2XRecolorCursor\fP +. +.Pr define-cursor window cursor +.LP +Synonym for \f5(set-window-cursor! window cursor)\fP. +. +.Pr undefine-cursor window +.LP +Synonym for \f5(set-window-cursor! window 'none)\fP. +. +.Ch "Grab Functions" +. +.Pr grab-pointer window owner? events ptr-sync? kbd-sync? confine-to cursor time +.LP +See \f2XGrabPointer\fP. +\f2window\fP and \f2confine-to\fP are windows. +\f2events\fP is a list of symbols (event mask names, such as \f5enter-window\fP, +\f5pointer-motion\fP, etc.). +\f2ptr-sync?\fP and \f2kbd-sync?\fP determine whether synchronous +or asynchronous grab mode is to be used. +\f2time\fP is an integer or the symbol \f5now\fP (for \f2CurrentTime\fP). +\f2grab-pointer\fP returns a symbol (\f5success\fP, \f5not-viewable\fP, +\f5already-grabbed\fP, \f5frozen\fP, or \f5invalid-time\fP). +. +.Pr ungrab-pointer display time +.LP +See \f2XUngrabPointer\fP. +. +.Pr grab-button win button mod owner? events ptr-sync? kbd-sync? "confine-to cursor" +.LP +See \f2XGrabButton\fP. +\f2button\fP is a symbol (\f5button1\fP ... \f5button5\fP, or \f5any-button\fP). +\f5mod\fP (modifiers) is a list of symbols (\f5shift\fP, \f5lock\fP, +\f5control\fP, \f5mod1\fP ... \f5mod5\fP, \f5button1\fP ... \f5button5\fP, +or \f5any-modifier\fP). +For the other arguments see \f2grab-pointer\fP +.Ix grab-pointer +above. +. +.Pr ungrab-button window button modifiers +.LP +See \f2XUngrabButton\fP. +See \f2grab-button\fP +.Ix grab-button +above. +. +.Pr change-active-pointer-grab display events cursor time +.LP +See \f2XChangeActivePointerGrab\fP. +\f2events\fP is a list of symbols (event mask names, such as \f5enter-window\fP, +\f5pointer-motion\fP, etc.). +. +.Pr grab-keyboard window owner? pointer-sync? keyboard-sync? time +.LP +See \f2XGrabKeyboard\fP. +For a description of the arguments and the return value see \f2grab-pointer\fP +.Ix grab-pointer +above. +. +.Pr ungrab-keyboard display time +.LP +See \f2XUngrabKeyboard\fP. +. +.Pr grab-key window key modifiers owner? pointer-sync? keyboard-sync? +.LP +See \f2XGrabKey\fP. +\f2key\fP is a keycode (an integer) or the symbol \f5any\fP. +For the other arguments see \f2grab-pointer\fP +.Ix grab-pointer +above. +. +.Pr ungrab-key window key modifiers +.LP +See \f2XUngrabKey\fP. +See \f2grab-key\fP +.Ix grab-key +above. +. +.Pr allow-events display mode time +.LP +See \f2XAllowEvents\fP. +\f2mode\fP is a symbol (\f5async-pointer\fP, \f5sync-pointer\fP, +\f5replay-pointer\fP, \f5async-keyboard\fP, \f5sync-keyboard\fP, +\f5replay-keyboard\fP, \f5async-both\fP, or \f5sync-both\fP). +. +.Pr grab-server display +.LP +See \f2XGrabServer\fP. +. +.Pr ungrab-server display +.LP +See \f2XUngrabServer\fP. +. +.Sy with-server-grabbed display . body-forms +.LP +This macro performs a \f2grab-server\fP on the specified display, +evaluates the \f2body-forms\fP in order, and then ungrabs the server. +The macro body is guarded by a \f2dynamic-wind\fP to ensure that the +\f2ungrab-server\fP is performed when a body-form calls a continuation +created outside the macro, and that it is grabbed again when +the body is re-entered at a later point in time. +\f2with-server-grabbed\fP returns the value of the last body-form. +. +.Ch "Window Manager Functions" +. +.Pr reparent-window window parent-window x y +.LP +See \f2XReparentWindow\fP. +. +.Pr install-colormap colormap +.LP +See \f2XInstallColormap\fP. +. +.Pr uninstall-colormap colormap +.LP +See \f2XUninstallColormap\fP. +. +.Pr list-installed-colormaps window +.LP +See \f2XListInstalledColormaps\fP. +Returns a vector of colormaps. +. +.Pr set-input-focus display window revert-to time +.LP +See \f2XSetInputFocus\fP. +\f2window\fP can be the symbol \f5pointer-root\fP. +\f2revert-to\fP is a symbol (\f5none\fP, \f5pointer-root\fP, or \f5parent\fP). +\f2time\fP is an integer or the symbol \f5now\fP. +. +.Pr input-focus display +.LP +See \f2XGetInputFocus\fP. +Returns a pair the car of which is a window, and the cdr is a symbol +(\f5none\fP, \f5pointer-root\fP, or \f5parent\fP). +. +.Pr general-warp-pointer display dst-win dst-x dst-y src-win src-x src-y "src-width src-height" +.LP +See \f2XWarpPointer\fP. +. +.Pr warp-pointer dst-window dst-x dst-y +.LP +See \f2XWarpPointer\fP. +Invokes \f2general-warp-pointer\fP with the display associated with the +\f2dst-window\fP, the \f2dst-window\fP, \f2dst-x\fP, \f2dst-y\fP, +a \f2src-window\fP of \f5none\fP, and zero source coordinates and dimensions. +. +.Pr warp-pointer-relative display x-offset y-offset +.LP +See \f2XWarpPointer\fP. +Invokes \f2general-warp-pointer\fP with the specified \f2display\fP, +a \f2dst-window\fP of \f5none\fP, \f2x-offset\fP, \f2y-offset\fP, +a \f2src-window\fP of \f5none\fP, and zero source coordinates and dimensions. +. +.Pr bell display . percent +.LP +See \f2XBell\fP. +\f2percent\fP is an integer between -100 and 100. +If \f2percent\fP is omitted, 0 is used. +. +.Pr set-access-control display enable? +.LP +See \f2XSetAccessControl\fP. +. +.Pr change-save-set window mode +.LP +See \f2XChangeSaveSet\fP. +\f2mode\fP is a symbol (\f5insert\fP or \f5delete\fP). +. +.Pr set-close-down-mode display mode +.LP +See \f2XSetCloseDownMode\fP. +\f2mode\fP is a symbol (\f5destroy-all\fP, \f5retain-permanent\fP, +or \f5retain-temporary\fP). +. +.Pr get-pointer-mapping display +.LP +See \f2XGetPointerMapping\fP. +Returns a vector of 256 integers. +. +.Pr set-pointer-mapping display mapping +.LP +See \f2XSetPointerMapping\fP. +\f2mapping\fP is a vector of integers. +Returns #t if \f2XSetPointerMapping\fP succeeds, #f otherwise. +. +.Ch "Event Handling Functions" +. +.Pr event-listen display wait? +.LP +See \f2XPending\fP, \f2XPeekEvent\fP. +Returns the size of the display's event queue. +If \f2wait?\fP is true and the event queue is empty, \f2event-listen\fP +flushes the output buffer and blocks until an event is received from +the server. +. +.Pr get-motion-events window from-time to-time +.LP +See \f2XGetMotionEvents\fP. +\f2from-time\fP and \f2to-time\fP are integers or the symbol \f5now\fP. +\f2get-motion-events\fP returns a vector of lists of three elements: +a time stamp (an integer or the symbol \f5now\fP), and the x and y +coordinates (integers). +. +.Sy handle-events display discard? peek? . clauses +.LP +See \f2XNextEvent\fP, \f2XPeekEvent\fP, \f2XIfEvent\fP, \f2XPeekIfEvent\fP. +\f2handle-events\fP is a special form. +Each \f2clause\fP is of the form \f2(guard function)\fP; \f2guard\fP +is either an event name (a symbol, e.\|g.\& \f5key-press\fP or \f5exposure\fP), +a list of event names, or the symbol \f5else\fP. +\f2handle-events\fP gets the next event from the specified display. +Then the event type is matched against each event name in each guard +in order. +When a match occurs, the corresponding function is invoked with +the name of the event being dispatched (a symbol) and other, event +specific arguments (see below). +When no clause matches and an \f5else\fP clause is present, the function +from this clause is invoked. +\f2handle-events\fP loops until a function returns a value not +equal to #f in which case handle-events returns this value. +.LP +If \f2discard?\fP is true, unprocessed events (i.\|e.\& events for which +no matching clause has been found) are removed from the event queue, +otherwise they are left in place. +If \f2peek?\fP is true, processed events are not removed from +the event queue. +.LP +The following list gives all event specific arguments for each +event type. +The first argument is always the event type (a symbol). +.LP +In the following list, arguments with names of the form +\f2something-window\fP (or simply \f2window\fP) are always of type +\f2window\fP; +arguments with names of the form \f2something-atom\fP (or simply \f2atom\fP) +are always of type \f2atom\fP. +\f2time\fP is an integer or the symbol \f5now\fP. +\f2x\fP, \f2y\fP, \f2width\fP, \f2height\fP, \f2border-width\fP, +\f2x-root\fP, \f2y-root\fP, \f2count\fP, \f2major-code\fP, \f2minor-code\fP, +and \f2keycode\fP are integers. +\f2state\fP is a list of symbols (\f5shift\fP, \f5lock\fP, \f5control\fP, +\f5mod1\fP ... \f5mod5\fP, \f5button1\fP ... \f5button5\fP). +\f2button\fP is one of the symbols \f5button1\fP ... \f5button5\fP, +\f2button-mask\fP is a list of one or more of these symbols. +\f2cross-mode\fP is a symbol (\f5normal\fP, \f5grab\fP, \f5ungrab\fP). +\f2place\fP is a symbol (\f5top\fP or \f5bottom\fP). +. +.IP "\f3key-press, key-release:\fP" +.Ix "Event types" key-press +.Ix "Event types" key-release +\f2window\fP, \f2root-window\fP, \f2sub-window\fP, \f2time\fP, +\f2x\fP, \f2y\fP, \f2x-root\fP, \f2y-root\fP, \f2state\fP, \f2keycode\fP, +\f2same-screen?\fP. +. +.IP "\f3button-press, button-release:\fP" +.Ix "Event types" button-press +.Ix "Event types" button-release +\f2window\fP, \f2root-window\fP, \f2sub-window\fP, \f2time\fP, +\f2x\fP, \f2y\fP, \f2x-root\fP, \f2y-root\fP, \f2state\fP, \f2button\fP, +\f2same-screen?\fP. +. +.IP "\f3motion-notify:\fP" +.Ix "Event types" motion-notify +\f2window\fP, \f2root-window\fP, \f2sub-window\fP, \f2time\fP, +\f2x\fP, \f2y\fP, \f2x-root\fP, \f2y-root\fP, \f2state\fP, \f2is-hint?\fP, +\f2same-screen?\fP. +. +.IP "\f3enter-notify, leave-notify:\fP" +.Ix "Event types" enter-notify +.Ix "Event types" leave-notify +\f2window\fP, \f2root-window\fP, \f2sub-window\fP, \f2time\fP, +\f2x\fP, \f2y\fP, \f2x-root\fP, \f2y-root\fP, \f2cross-mode\fP, +\f2cross-detail\fP (one of the symbols \f5ancestor\fP, \f5virtual\fP, +\f5inferior\fP, \f5nonlinear\fP, \f5nonlinear-virtual\fP), +\f2same-screen?\fP, \f2focus?\fP, \f2button-mask\fP. +. +.IP "\f3focus-in, focus-out:\fP" +.Ix "Event types" focus-in +.Ix "Event types" focus-out +\f2window\fP, \f2cross-mode\fP, \f2focus-detail\fP (one of the symbols +\f5ancestor\fP, \f5virtual\fP, \f5inferior\fP, \f5nonlinear\fP, +\f5nonlinear-virtual\fP, \f5pointer\fP, \f5pointer-root\fP, \f5none\fP). +. +.IP "\f3keymap-notify:\fP" +.Ix "Event types" keymap-notify +\f2window\fP, \f2keymap\fP (a string of length 32). +. +.IP "\f3expose:\fP" +.Ix "Event types" expose +\f2window\fP, \f2x\fP, \f2y\fP, \f2width\fP, \f2height\fP, \f2count\fP. +. +.IP "\f3graphics-expose:\fP" +.Ix "Event types" graphics-expose +\f2window\fP, \f2x\fP, \f2y\fP, \f2width\fP, \f2height\fP, \f2count\fP, +\f2major-code\fP, \f2minor-code\fP. +. +.IP "\f3no-expose:\fP" +.Ix "Event types" no-expose +\f2window\fP, \f2major-code\fP, \f2minor-code\fP. +. +.IP "\f3visibility-notify:\fP" +.Ix "Event types" visibility-notify +\f2window\fP, \f2visibility-state\fP (one of the symbols \f5unobscured\fP, +\f5partially-obscured\fP, \f5fully-obscured\fP). +. +.IP "\f3create-notify:\fP" +.Ix "Event types" create-notify +\f2parent-window\fP, \f2window\fP, \f2x\fP, \f2y\fP, \f2width\fP, \f2height\fP, +\f2border-width\fP, \f2override-redirect?\fP. +. +.IP "\f3destroy-notify:\fP" +.Ix "Event types" destroy-notify +\f2event-window\fP, \f2window\fP. +. +.IP "\f3unmap-notify:\fP" +.Ix "Event types" unmap-notify +\f2event-window\fP, \f2window\fP, \f2from-configure\fP. +. +.IP "\f3map-notify:\fP" +.Ix "Event types" map-notify +\f2event-window\fP, \f2window\fP, \f2override-redirect\fP. +. +.IP "\f3map-request:\fP" +.Ix "Event types" map-request +\f2parent-window\fP, \f2window\fP. +. +.IP "\f3reparent-notify:\fP" +.Ix "Event types" reparent-notify +\f2event-window\fP, \f2parent-window\fP, \f2window\fP, \f2x\fP, \f2y\fP, +\f2override-redirect\fP. +. +.IP "\f3configure-notify:\fP" +.Ix "Event types" configure-notify +\f2event-window\fP, \f2window\fP, \f2x\fP, \f2y\fP, \f2width\fP, +\f2height\fP, \f2border-width\fP, \f2above-window\fP, +\f2override-redirect?\fP. +. +.IP "\f3configure-request:\fP" +.Ix "Event types" configure-request +\f2parent-window\fP, \f2window\fP, \f2x\fP, \f2y\fP, \f2width\fP, \f2height\fP, +\f2border-width\fP, \f2above-window\fP, \f2stack-mode\fP (see +\f2set-window-stack-mode!\fP above), \f2value-mask\fP (an integer). +. +.IP "\f3gravity-notify:\fP" +.Ix "Event types" gravity-notify +\f2event-window\fP, \f2window\fP, \f2x\fP, \f2y\fP. +. +.IP "\f3resize-request:\fP" +.Ix "Event types" resize-request +\f2window\fP, \f2width\fP, \f2height\fP. +. +.IP "\f3circulate-notify:\fP" +.Ix "Event types" circulate-notify +\f2event-window\fP, \f2window\fP, \f2place\fP. +. +.IP "\f3circulate-request:\fP" +.Ix "Event types" circulate-request +\f2parent-window\fP, \f2window\fP, \f2place\fP. +. +.IP "\f3property-notify:\fP" +.Ix "Event types" property-notify +\f2window\fP, \f2atom\fP, \f2time\fP, \f2property-state\fP (one of the +symbols \f5new-value\fP, \f5deleted\fP). +. +.IP "\f3selection-clear:\fP" +.Ix "Event types" selection-clear +\f2window\fP, \f2selection-atom\fP, \f2time\fP. +. +.IP "\f3selection-request:\fP" +.Ix "Event types" selection-request +\f2owner-window\fP, \f2requestor-window\fP, \f2selection-atom\fP, +\f2target-atom\fP, \f2property-atom\fP, \f2time\fP. +. +.IP "\f3selection-notify:\fP" +.Ix "Event types" selection-notify +\f2requestor-window\fP, \f2selection-atom\fP, \f2target-atom\fP, +\f2property-atom\fP, \f2time\fP. +. +.IP "\f3colormap-notify:\fP" +.Ix "Event types" colormap-notify +\f2window\fP, \f2colormap\fP, \f2new?\fP, \f2colormap-installed?\fP. +. +.IP "\f3client-message:\fP" +.Ix "Event types" client-message +\f2window\fP, \f2message type\fP (an atom), \f2message data\fP +(a string of length 20, or a vector of 10 or 5 integer numbers, +or, if the format field of the event is wrong, the format as a +number). +. +.IP "\f3mapping-notify:\fP" +.Ix "Event types" mapping-notify +\f2window\fP, \f2request\fP (one of the symbols \f5modifier\fP, +\f5keyboard\fP, \f5pointer\fP), \f2keycode\fP, \f2count\fP. +. +.Ch "Inter-Client Communication Functions" +. +.Pr iconify-window window screen-number +.LP +See \f2XIconifyWindow\fP. +. +.Pr withdraw-window window screen-number +.LP +See \f2XWithdrawWindow\fP. +. +.Pr reconfigure-wm-window . args +.LP +See \f2XReconfigureWMWindow\fP. +.LP +For the format of the arguments see \f2create-window\fP +.Ix create-window +above. +Mandatory attributes are \f2window\fP and \f2screen-number\fP +(an integer). +Optional attributes are \f2x\fP, \f2y\fP, \f2width\fP, \f2height\fP +\f2border-width\fP (integers), \f2sibling\fP (a window), and +\f2stack-mode\fP (a symbol; one of \f5above\fP, \f5below\fP, \f5top-if\fP, +\f5bottom-if\fP, \f5opposite\fP). +. +.Pr get-text-property window atom +.LP +See \f2XGetTextProperty\fP. +Returns a text property as a list of strings or #f if the specified property +does not exist. +. +.Pr set-text-property! window value atom +.LP +See \f2XSetTextProperty\fP. +\f2value\fP is a list holding the items of the text property +(strings or symbols). +. +.Pr wm-protocols window +.LP +See \f2XGetWMProtocols\fP. +Returns a vector of atoms. +. +.Pr set-wm-protocols! window protocols +.LP +See \f2XSetWMProtocols\fP. +\f2protocols\fP is a vector of atoms. +. +.Pr wm-name window +.LP +See \f2XGetTextProperty\fP. +Returns the WM_NAME property as a list of strings or #f if it does not exist. +. +.Pr set-wm-name! window name +.LP +See \f2XSetTextProperty\fP. +\f2name\fP is a list of strings or symbols. +. +.Pr wm-icon-name window +.LP +See \f2XGetTextProperty\fP. +Returns the WM_ICON_NAME property as a list of strings +or #f if it does not exist. +. +.Pr set-wm-icon-name! window name +.LP +See \f2XSetTextProperty\fP. +\f2name\fP is a list of strings or symbols. +. +.Pr wm-client-machine window +.LP +See \f2XGetTextProperty\fP, \f2XGetWMClientMachine\fP. +Returns the WM_CLIENT_MACHINE property as a list of strings +or #f if it does not exist. +. +.Pr set-wm-client-machine! window value +.LP +See \f2XSetTextProperty\fP, \f2XSetWMClientMachine\fP. +\f2value\fP is a list of strings or symbols. +. +.Pr wm-class window +.LP +See \f2XGetClassHint\fP. +Returns a pair (name and class) each component of which is either +a string or #f. +. +.Pr set-wm-class! window name class +.LP +See\f2 XSetClassHint\fP. +\f2name\fP and \f2class\fP are strings or symbols. +. +.Pr wm-command window +.LP +See \f2XGetCommand\fP (in X11 Release 4 or newer releases). +Returns the value of the WM_COMMAND property of the given window +as a list of strings. +. +.Pr set-wm-command! window command +.LP +See \f2XSetCommand\fP. +\f2command\fP is a list; each element is either a string or a symbol. +. +.Pr transient-for window +.LP +See \f2XGetTransientForHint\fP. +Returns a window. +. +.Pr set-transient-for! window property-window +.LP +See \f2XSetTransientForHint\fP. +. +.Pr wm-normal-hints window +.LP +See \f2XGetWMSizeHints\fP. +Returns a list of hints. +Each element is set to the empty list if the corresponding hint +has not been set for the specified window. +.LP +The elements of the list correspond to the following hints +(in this order): \f2x\fP, \f2y\fP, \f2width\fP, and \f2height\fP +(program specified); \f2x\fP, \f2y\fP, \f2width\fP and \f2height\fP +(user specified); \f2min-width\fP and \f2min-height\fP; \f2max-width\fP +and \f2max-height\fP; \f2width-inc\fP and \f2height-inc\fP; +\f2min-aspect-x\fP, \f2min-aspect-y\fP, \f2max-aspect-x\fP and +\f2max-aspect-y\fP; \f2base-width\fP and \f2base-height\fP; +and \f2gravity\fP. +All elements are integers except for the value of \f2gravity\fP +which is a symbol (see the \f2window-gravity\fP +.Ix window-gravity +procedure above). +. +.Pr set-wm-normal-hints! . args +.LP +See \f2XSetWMSizeHints\fP. +For the format of the arguments see \f2create-window\fP +.Ix create-window +above. +Attributes are \f2window\fP (mandatory) and the names of the hints +listed under \f2wm-normal-hints\fP +.Ix wm-normal-hints +above. +. +.Pr wm-hints window +.LP +See \f2XGetWMHints\fP. +Returns a list of hints. +Each element is set to the empty list if the corresponding hint +has not been set for the specified window. +.LP +The elements of the list correspond to the following hints +(in this order): \f2input?\fP, \f2initial-state\fP, \f2icon-pixmap\fP, +\f2icon-window\fP, \f2icon-x\fP, \f2icon-y\fP, \f2icon-mask\fP, +and \f2window-group\fP. +The value of \f2input?\fP is a boolean. +\f2initial-state\fP is a symbol (\f5dont-care\fP, \f5normal\fP, \f5zoom\fP, +\f5iconic\fP, \f5inactive\fP). +The values of \f2icon-pixmap\fP and \f2icon-mask\fP are pixmaps. +\f2icon-window\fP and \f2window-group\fP are windows. +\f2icon-x\fP and \f2icon-y\fP are integers. +. +.Pr set-wm-hints! . args +.LP +See \f2XSetWMHints\fP. +For the format of the arguments see \f2create-window\fP +.Ix create-window +above. +Attributes are \f2window\fP (mandatory) and the names of the hints +listed under \f2wm-hints\fP +.Ix wm-hints +above. +. +.Pr icon-sizes window +.LP +See \f2XGetIconSizes\fP. +Returns a vector of lists of six integers (\f2min-width\fP, \f2min-height\fP, +\f2max-width\fP, \f2max-height\fP, \f2width-inc\fP, and \f2height-inc\fP). +. +.Pr set-icon-sizes! window icon-sizes +.LP +See \f2XSetIconSizes\fP. +\f2icon-sizes\fP is a vector of lists of six integers (see \f2icon-sizes\fP +.Ix icon-sizes +above). +. +.Ch "Keyboard Utility Functions" +. +.[[ +.Pr display-min-keycode display +.Pr display-max-keycode display +.]] +.LP +Returns the minimum/maximum keycode (an integer) for the given display. +. +.Pr display-keysyms-per-keycode display +Returns the number of keysyms per keycode for the given display. +. +.Pr string\(mi>keysym string +.LP +See \f2XStringToKeysym\fP. +\f2string\fP is a string or a symbol. +Returns an integer if \f2XStringToKeysym\fP succeeds, #f otherwise. +. +.Pr keysym\(mi>string keysym +.LP +See \f2XKeysymToString\fP. +\f2keysym\fP is an integer. +Returns #f if \f2XKeysymToString\fP fails. +. +.Pr keycode\(mi>keysym display keycode index +.LP +See \f2XKeycodeToKeysym\fP. +\f2keycode\fP and \f2index\fP are integers. +. +.Pr keysym\(mi>keycode display keysym +.LP +See \f2XKeysymToKeycode\fP. +\f2keysym\fP is an integer. +. +.Pr lookup-string display keycode mask +.LP +See \f2XLookupString\fP. +\f2keycode\fP is an integer. +\f2mask\fP is a list of symbols (\f5shift\fP, \f5lock\fP, \f5control\fP, +\f5mod1\fP ... \f5mod5\fP, \f5button1\fP ... \f5button5\fP, +or \f5any-modifier\fP). +. +.Pr rebind-keysym display keysym modifiers string +.LP +See \f2XRebindKeysym\fP. +\f2keysym\fP is an integer. +\f2modifiers\fP is a vector of integers. +. +.Pr refresh-keyboard-mapping window type +.LP +See \f2XRefreshKeyboardMapping\fP. +\f2type\fP is a symbol (\f5modifier\fP, \f5keyboard\fP, or \f5pointer\fP). +Invokes \f2XRefreshKeyboardMapping\fP with a faked event structure holding +the specified window and request type. +. +.Ch "Other Utility Functions" +. +.Pr xlib-release-4-or-later? +.LP +Returns always #t. +. +.Pr xlib-release-5-or-later? +.LP +Returns #t iff the Xlib extension is linked together with the X11 +Release 5 Xlib or later versions of the Xlib. +. +.Pr xlib-release-6-or-later? +.LP +Returns #t iff the Xlib extension is linked together with the X11 +Release 6 Xlib or later versions of the Xlib. +. +.Pr get-default display program option +.LP +See \f2XGetDefault\fP. +\f2program\fP and \f2option\fP are strings or symbols. +Returns a string of #f if the option does not exist for the +specified program. +. +.Pr resource-manager-string display +.LP +See \f2XResourceManagerString\fP. +Returns a string or #f if the RESOURCE_MANAGER property does not +exist on the root window. +. +.Pr parse-geometry string +.LP +See \f2XParseGeometry\fP. +Returns a list of six elements: two booleans indicating whether x or +or y are negative and four integers (x, y, width, and height). +Each of the elements can be #f to indicate that the respective +value was not found in the string. +. +.Pr parse-color colormap string +.LP +See \f2XParseColor\fP. +Returns an object of type \f2color\fP or #f if \f2XParseColor\fP fails. +. +.Pr store-buffer display bytes buffer +.LP +See \f2XStoreBuffer\fP. +\f2bytes\fP is a string; \f2buffer\fP is an integer between 0 and 7. +. +.Pr store-bytes display bytes +.LP +See \f2XStoreBytes\fP. +\f2bytes\fP is a string. +. +.Pr fetch-buffer display buffer +.LP +See \f2XFetchBuffer\fP. +\f2buffer\fP is an integer between 0 and 7. +Returns a string. +. +.Pr fetch-bytes display +.LP +See \f2XFetchBytes\fP. +Returns a string. +. +.Pr rotate-buffers display delta +.LP +See \f2XRotateBuffers\fP. +\f2delta\fP is an integer (the amount to rotate the buffers). +. +.Sy with object . body-forms +.LP +\f2with\fP is a macro. +\f2object\fP must be a drawable, a graphics context, or a font. +The \f2body-forms\fP are evaluated in order; \f2with\fP returns the value +of the last body-form. +.LP +Within the scope of the \f2with\fP, the first call to an accessor +function accessing \f2object\fP (such as \f5window-\fP\f2attribute\fP +or \f5font-\fP\f2attribute\fP) causes the result of the corresponding +Xlib function to be retained in a cache; subsequent calls just return +the value from the cache. +Likewise, calls to Xlib functions for mutator functions modifying +\f2object\fP (such as \f5set-window-\fP\f2attribute\fP\f5!\fP) +are delayed until exit of the \f2with\fP body or until an accessor +function is called and the cached data for this accessor function +has been invalidated by the call to a mutator function. +. +.Ch "Server Extension Functions" +. +.Pr list-extensions display +.LP +See \f2XListExtensions\fP. +Returns a vector of strings. +. +.Pr query-extension display name +.LP +See \f2XQueryExtension\fP. +\f2name\fP is a string or a symbol. +Returns a list of three elements: the major opcode (an integer) or #f +if the extension has no major opcode, the base event type code (an +integer) of #f if the extension has no additional event types, and +the base error code (an integer) of #f if the extension has no +additional error codes. +\f2query-extension\fP returns #f if the specified extension is not present. +. +.Ch "Error Handling" +. +.Va x-error-handler +.LP +See \f2XSetErrorHandler\fP. +If an error event is received and the global variable \f2x-error-handler\fP +is bound to a compound procedure, this procedure is invoked with the +following arguments: a display, the serial number of the failed request +(an integer), the error code (either an integer or one of the symbols +\f5bad-request\fP, \f5bad-value\fP, \f5bad-window\fP, \f5bad-pixmap\fP, +\f5bad-atom\fP, \f5bad-cursor\fP, \f5bad-font\fP, \f5bad-match\fP, +\f5bad-drawable\fP, \f5bad-access\fP, \f5bad-alloc\fP, \f5bad-color\fP, +\f5bad-gcontext\fP, \f5bad-id-choice\fP, \f5bad-name\fP, \f5bad-length\fP, +or \f5bad-implementation\fP), the major and minor op-code of the +failed request (integers), and a resource-ID (an integer). +.LP +If an error event is received and this variable is not bound to a +compound procedure, the Xlib default error handler is invoked. +The initial value of this variable is the empty list. +. +.Va x-fatal-error-handler +.LP +See \f2XSetIOErrorHandler\fP. +If a fatal I/O error occurs and the global variable +\f2x-fatal-error-handler\fP is bound to a compound procedure, this +procedure is invoked with a display as argument. +The procedure must invoke \f2exit\fP. +If a fatal error occurs and this variable is not bound to a +compound procedure, or if the procedure returns, the Xlib default +fatal error handler is invoked and the interpreter terminates with +an exit code of 1. +The initial value of this variable is the empty list. +. +.Ch "Interaction with the Garbage Collector" +. +.PP +.Ix "garbage collector" +The Scheme garbage collector destroys objects of type \f2colormap\fP, +\f2cursor\fP, \f2display\fP, \f2font\fP, \f2gcontext\fP, \f2pixmap\fP, +or \f2window\fP that are not longer accessible from within the Scheme +program. +This is done by invoking the function \f2free-colormap\fP, \f2free-cursor\fP, +\f2close-display\fP, \f2close-font\fP, \f2free-gcontext\fP, +\f2free-pixmap\fP, or \f2destroy-window\fP, respectively, with the +object to be destroyed as an argument. +.PP +The garbage collector only destroys objects that have been created +from with the Scheme program (by functions like \f2create-pixmap\fP +or \f2open-display\fP). +Objects that have been obtained from the Xlib through functions like +\f2display-default-colormap\fP (and are owned by the Xlib internals), +are ignored by the garbage collector. +.PP +Programmers must make sure that an object is accessible during the object's +entire lifetime, otherwise future runs of the garbage collector can +result in undesired termination of the object. +One must be especially careful when results of functions that create +new objects (such as \f2create-window\fP) are ignored or assigned +to local variables as in +.Ss +(define dpy (open-display)) +(define root (display-root-window dpy)) +.sp .5 +(do ((x 0 (+ x 10)) (y 0 (+ y 10))) ((= x 50)) + (let ((win + (create-window 'parent root 'x x 'y y 'width 20 'height 20))) + (manage-window win))) +.Se +.PP +In this example, after termination of the do-loop, the garbage +collector will destroy the newly created windows, as they are not +accessible from within the program. +If this is not desired, the windows could be put into a variable (for +instance, be \f2consed\fP into a list) that is defined outside of the +body of the loop. diff --git a/doc/xlib/xlib.ps b/doc/xlib/xlib.ps new file mode 100644 index 0000000..d096c7f --- /dev/null +++ b/doc/xlib/xlib.ps @@ -0,0 +1,3182 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier +%%+ font Symbol +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 37 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier +%%IncludeResource: font Symbol +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier@0 ENC0/Courier RE/Times-Roman@0 +ENC0/Times-Roman RE/Times-Italic@0 ENC0/Times-Italic RE/Times-Bold@0 ENC0 +/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(Elk/Xlib Refer)217.776 120 Q(ence Manual)-.216 E/F1 10 +/Times-Italic@0 SF(Oliver Laumann)255.085 144 Q/F2 11/Times-Bold@0 SF 2.75 +(1. Intr)72 216 R(oduction)-.198 E/F3 11/Times-Roman@0 SF .906 +(This manual lists the functions, special forms, and v)97 234.6 R .906 +(ariables de\214ned by the Xlib e)-.275 F(xtension)-.165 E .352 +(included in the Elk distrib)72 249.6 R 3.102(ution. Most)-.22 F .353 +(of the functions are directly equi)3.102 F -.275(va)-.275 G .353 +(lent to a function of the).275 F .72(Xlib C library)72 264.6 R 3.47(,s)-.715 G +3.47(ot)144.945 264.6 S .72(hat the description need not be repeated.)156.973 +264.6 R .719(In such cases, only the name of the)6.22 F 1.932 +(corresponding Xlib function is mentioned.)72 279.6 R 1.933 +(Thus, you should ha)7.432 F 2.263 -.165(ve t)-.22 H(he).165 E/F4 11 +/Times-Italic@0 SF 1.933(Xlib \255 C Langua)4.683 F 2.153 -.11(ge X)-.11 H +(Interface)72 294.6 Q F3(manual within reach when using this reference manual.) +2.75 E(The functions listed in this document can be loaded by e)97 313.2 Q +-.275(va)-.275 G(luating the e).275 E(xpression)-.165 E/F5 11/Courier@0 SF +(\(require 'xlib\).)108 334.2 Q F3(in the interpreter')72 355.2 Q 2.75(st)-.605 +G(op le)158.46 355.2 Q -.165(ve)-.275 G 2.75(lo).165 G 2.75(ri)201.404 355.2 S +2.75(naS)210.875 355.2 S(cheme program.)232.875 355.2 Q .04(The types of ar)97 +373.8 R .04(guments of the procedures listed belo)-.198 F 2.79(wa)-.275 G .039 +(re not described when the)343.419 373.8 R 2.789(ya)-.165 G .039(re ob)469.608 +373.8 R(vi-)-.165 E 1.02(ous from the conte)72 388.8 R 1.021 +(xt or from the name.)-.165 F -.165(Fo)6.521 G 3.771(ri).165 G 1.021 +(nstance, an ar)279.746 388.8 R 1.021(gument named)-.198 F F4(window)3.771 E F3 +1.021(is al)3.771 F -.11(wa)-.11 G 1.021(ys of).11 F(type)72 403.8 Q F4(window) +3.615 E F3 3.615(,a)C 3.615(na)140.038 403.8 S -.198(rg)154.037 403.8 S .865 +(ument named).198 F F4(atom)3.615 E F3 .865(is an object of type)3.615 F F4 +(atom)3.615 E F3 3.614(,e)C 3.614(tc. Ar)376.706 403.8 R .864 +(guments the names of)-.198 F(which end in `)72 418.8 Q(`?')-.814 E 2.75('a) +-.814 G(re al)157.118 418.8 Q -.11(wa)-.11 G(ys of type).11 E F4(boolean)2.75 E +F3(.)A 1.424(If a function returns se)97 437.4 R -.165(ve)-.275 G 1.425 +(ral items of the same type \(for instance, a list of windo).165 F 1.425 +(ws\), the)-.275 F .164(return v)72 452.4 R .164(alue is a v)-.275 F .164 +(ector of objects of this type.)-.165 F .163 +(If a function returns a collection of items of dif)5.664 F(fer)-.275 E(-)-.22 +E 1.108(ent types or of dif)72 467.4 R 1.108(ferent semantics, the return v) +-.275 F 1.108(alue is a list of objects \(or a pair\).)-.275 F 1.108 +(In this case,)6.608 F F4(multiple-value-bind)72 482.4 Q F3 +(can be used to bind v)2.75 E(ariables to the return v)-.275 E(alues.)-.275 E +.613(In the follo)97 501 R .612 +(wing, each description of a procedure, special form, or v)-.275 F .612 +(ariable lists the kind of)-.275 F .735(object in boldf)72 516 R 3.485 +(ace. Here,)-.11 F F2(pr)3.485 E(ocedur)-.198 E(e)-.198 E F3 .735 +(denotes either a primiti)3.485 F 1.065 -.165(ve p)-.275 H .735 +(rocedure or a compound proce-).165 F(dure,)72 531 Q F2(syntax)3.617 E F3 .866 +(denotes a special form or a macro, and)3.616 F F2 -.11(va)3.616 G(riable).11 E +F3 .866(denotes a global v)3.616 F .866(ariable that has)-.275 F +(some initial v)72 546 Q(alue and can be re-assigned a ne)-.275 E 2.75(wv)-.275 +G(alue by the user \(by means of)288.986 546 Q F4(set!)2.75 E F3(or)2.75 E F4 +(\215uid-let)2.75 E F3(\).)A F2 2.75(2. Display)72 576 R(Functions)2.75 E +(\(display?)72 606 Q F4(x)4.583 E F2 328.208(\)p)C -.198(ro)462.244 606 S +(cedur).198 E(e)-.198 E F3(Returns #t if)72 624.6 Q(f)-.275 E F4(x)2.75 E F3 +(is an object of type)2.75 E F4(display)2.75 E F3(.)A F2(\(open-display)72 +654.6 Q F4 2.75(.n)4.583 G(ame-of-display)151.152 654.6 Q F2 235.324(\)p)C +-.198(ro)462.244 654.6 S(cedur).198 E(e)-.198 E F3(See)72 673.2 Q F4 +(XOpenDisplay)3.972 E F3(.)A F4(name-of-display)6.722 E F3 1.222 +(is a string or a symbol.)3.972 F 1.223(If no name is speci\214ed, a NULL)6.722 +F(name will be passed to)72 688.2 Q F4(XOpenDisplay)2.75 E F3(.)A EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(close-display)72 87 Q/F2 11/Times-Italic@0 +SF(display)4.583 E F1 280.545(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 +E F0(See)72 105.6 Q F2(XCloseDisplay)2.75 E F0 5.5(.F)C +(inalizes all objects associated with the display)171 105.6 Q 2.75(,t)-.715 G +(hen closes the display)381.1 105.6 Q(.)-.715 E F1(\(display-default-r)72 135.6 +Q(oot-windo)-.198 E(w)-.11 E F2(display)4.583 E F1 206.911(\)p)C -.198(ro) +462.244 135.6 S(cedur).198 E(e)-.198 E(\(display-r)72 150.6 Q(oot-windo)-.198 E +(w)-.11 E F2(display)4.583 E F1 243.574(\)p)C -.198(ro)462.244 150.6 S(cedur) +.198 E(e)-.198 E F0(See)72 169.2 Q F2(XDefaultRootW)2.75 E(indow)-.605 E F0(.)A +F1(\(display-default-colormap)72 199.2 Q F2(display)4.583 E F1 221.882(\)p)C +-.198(ro)462.244 199.2 S(cedur).198 E(e)-.198 E(\(display-colormap)72 214.2 Q +F2(display)4.583 E F1 258.545(\)p)C -.198(ro)462.244 214.2 S(cedur).198 E(e) +-.198 E F0(See)72 232.8 Q F2(XDefaultColormap)2.75 E F0 5.5(.R)C +(eturns the def)190.558 232.8 Q(ault colormap of the display')-.11 E 2.75(sd) +-.605 G(ef)389.339 232.8 Q(ault screen.)-.11 E F1(\(display-default-gcontext)72 +262.8 Q F2(display)4.583 E F1 226.777(\)p)C -.198(ro)462.244 262.8 S(cedur).198 +E(e)-.198 E F0(See)72 281.4 Q F2(XDefaultGC)2.75 E F0 5.5(.R)C(eturns the def) +161.221 281.4 Q(ault graphics conte)-.11 E(xt of the display')-.165 E 2.75(sd) +-.605 G(ef)390.692 281.4 Q(ault screen.)-.11 E F1(\(display-default-depth)72 +311.4 Q F2(display)4.583 E F1 239.592(\)p)C -.198(ro)462.244 311.4 S(cedur).198 +E(e)-.198 E F0(See)72 330 Q F2(XDefaultDepth)2.75 E F0 5.5(.R)C(eturns the def) +172.826 330 Q(ault depth of the display')-.11 E 2.75(sd)-.605 G(ef)354.502 330 +Q(ault screen.)-.11 E F1(\(display-default-scr)72 360 Q(een-number)-.198 E F2 +(display)4.583 E F1 195.812(\)p)C -.198(ro)462.244 360 S(cedur).198 E(e)-.198 E +F0(See)72 378.6 Q F2(XDefaultScr)2.75 E(een)-.407 E F0 5.5(.R)C(eturns an inte) +175.466 378.6 Q(ger)-.165 E(.)-.605 E F1(\(display-cells)72 408.6 Q F2 +(display scr)4.583 E(een-number)-.407 E F1 214.666(\)p)C -.198(ro)462.244 408.6 +S(cedur).198 E(e)-.198 E F0(See)72 427.2 Q F2(XDisplayCells)2.75 E F0 5.5(.R)C +(eturns an inte)169.779 427.2 Q(ger)-.165 E(.)-.605 E F1(\(display-planes)72 +457.2 Q F2(display scr)4.583 E(een-number)-.407 E F1 204.876(\)p)C -.198(ro) +462.244 457.2 S(cedur).198 E(e)-.198 E F0(See)72 475.8 Q F2(XDisplayPlanes)2.75 +E F0 5.5(.R)C(eturns an inte)177.105 475.8 Q(ger)-.165 E(.)-.605 E F1 +(\(display-string)72 505.8 Q F2(display)4.583 E F1 275.65(\)p)C -.198(ro) +462.244 505.8 S(cedur).198 E(e)-.198 E F0(See)72 524.4 Q F2(XDisplayString)2.75 +E F0 5.5(.R)C(eturns a string.)174.058 524.4 Q F1(\(display-v)72 554.4 Q(endor) +-.11 E F2(display)4.583 E F1 270.26(\)p)C -.198(ro)462.244 554.4 S(cedur).198 E +(e)-.198 E F0(See)72 573 Q F2(XServerV)4.129 E(endor)-1.221 E F0(,)A F2(XV) +4.129 E(endorRelease)-1.221 E F0 6.878(.R)C 1.378 +(eturns a pair; the car is a string \(the v)254.545 573 R 1.378 +(endor identi\214ca-)-.165 F(tion\), and the cdr is an inte)72 588 Q +(ger \(the v)-.165 E(endor release number\).)-.165 E F1(\(display-pr)72 618 Q +(otocol-v)-.198 E(ersion)-.11 E F2(display)4.583 E F1 226.469(\)p)C -.198(ro) +462.244 618 S(cedur).198 E(e)-.198 E F0(See)72 636.6 Q F2(XPr)3.098 E(otocolV) +-.495 E(er)-1.221 E(sion)-.11 E F0(,)A F2(XPr)3.098 E(otocolRe)-.495 E(vision) +-.165 E F0 5.848(.R)C .348(eturns a pair of inte)272.826 636.6 R .348 +(gers \(the X protocol')-.165 F 3.098(sm)-.605 G .349(ajor and)467.912 636.6 R +(minor v)72 651.6 Q(ersion numbers\).)-.165 E F1(\(display-scr)72 681.6 Q +(een-count)-.198 E F2(display)4.583 E F1 243.475(\)p)C -.198(ro)462.244 681.6 S +(cedur).198 E(e)-.198 E F0(See)72 700.2 Q F2(XScr)2.75 E(eenCount)-.407 E F0 +5.5(.R)C(eturns an inte)169.361 700.2 Q(ger)-.165 E(.)-.605 E EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(display-image-byte-order)72 87 Q/F2 11 +/Times-Italic@0 SF(display)4.583 E F1 221.288(\)p)C -.198(ro)462.244 87 S +(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2(XIma)2.75 E -.11(ge)-.11 G(ByteOr) +.11 E(der)-.407 E F0 5.5(.R)C(eturns a symbol \()186.235 105.6 Q/F3 11 +/Courier@0 SF(lsb-first)A F0(or)2.75 E F3(msb-first)2.75 E F0(\).)A F1 +(\(display-bitmap-unit)72 135.6 Q F2(display)4.583 E F1 246.918(\)p)C -.198(ro) +462.244 135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q F2(XBitmapUnit)2.75 E +F0 5.5(.R)C(eturns an inte)164.279 154.2 Q(ger)-.165 E(.)-.605 E F1 +(\(display-bitmap-bit-order)72 184.2 Q F2(display)4.583 E F1 223.103(\)p)C +-.198(ro)462.244 184.2 S(cedur).198 E(e)-.198 E F0(See)72 202.8 Q F2 +(XBitmapBitOr)2.75 E(der)-.407 E F0 5.5(.R)C(eturns a symbol \()184.035 202.8 Q +F3(lsb-first)A F0(or)2.75 E F3(msb-first)2.75 E F0(\).)A F1 +(\(display-bitmap-pad)72 232.8 Q F2(display)4.583 E F1 248.139(\)p)C -.198(ro) +462.244 232.8 S(cedur).198 E(e)-.198 E F0(See)72 251.4 Q F2(XBitmapP)2.75 E(ad) +-.88 E F0 5.5(.R)C(eturns an inte)161.562 251.4 Q(ger)-.165 E(.)-.605 E F1 +(\(display-width)72 281.4 Q F2(display)4.583 E F1 276.255(\)p)C -.198(ro) +462.244 281.4 S(cedur).198 E(e)-.198 E(\(display-height)72 296.4 Q F2(display) +4.583 E F1 273.813(\)p)C -.198(ro)462.244 296.4 S(cedur).198 E(e)-.198 E F0 +(See)72 315 Q F2(XDisplayW)2.75 E(idth)-.605 E F0(,)A F2(XDisplayHeight)2.75 E +F0 5.5(.R)C(eturns the width/height of the display')249.221 315 Q 2.75(sd)-.605 +G(ef)428.884 315 Q(ault screen.)-.11 E F1(\(display-width-mm)72 345 Q F2 +(display)4.583 E F1 254.266(\)p)C -.198(ro)462.244 345 S(cedur).198 E(e)-.198 E +(\(display-height-mm)72 360 Q F2(display)4.583 E F1 251.824(\)p)C -.198(ro) +462.244 360 S(cedur).198 E(e)-.198 E F0(See)72 378.6 Q F2(XDisplayW)4.253 E +(idthMM)-.605 E F0(,)A F2(XDisplayHeightMM)4.253 E F0 7.003(.R)C 1.503 +(eturns the width/height of the display')290.382 378.6 R 4.253(sd)-.605 G(ef) +479.063 378.6 Q(ault)-.11 E(screen in millimeters.)72 393.6 Q F1 +(\(display-motion-b)72 423.6 Q(uffer)-.22 E(-size)-.407 E F2(display)4.583 E F1 +217.02(\)p)C -.198(ro)462.244 423.6 S(cedur).198 E(e)-.198 E F0(See)72 442.2 Q +F2(XDisplayMotionBuf)2.75 E(ferSize)-.198 E F0 5.5(.R)C(eturns an inte)223.965 +442.2 Q(ger)-.165 E(.)-.605 E F1(\(display-\215ush-output)72 472.2 Q F2 +(display)4.583 E F1 245.686(\)p)C -.198(ro)462.244 472.2 S(cedur).198 E(e)-.198 +E F0(See)72 490.8 Q F2(XFlush)2.75 E F0(.)A F1(\(display-wait-output)72 520.8 Q +F2(display discar)4.583 E(d-e)-.407 E(vents?)-.165 E F1 176.32(\)p)C -.198(ro) +462.244 520.8 S(cedur).198 E(e)-.198 E F0(See)72 539.4 Q F2(XSync)2.75 E F0(.)A +F1(\(no-op)72 569.4 Q F2(display)4.583 E F1 313.545(\)p)C -.198(ro)462.244 +569.4 S(cedur).198 E(e)-.198 E F0(See)72 588 Q F2(XNoOp)2.75 E F0(.)A F1 +(\(list-depths)72 618 Q F2(display scr)4.583 E(een-number)-.407 E F1 223.224 +(\)p)C -.198(ro)462.244 618 S(cedur).198 E(e)-.198 E F0(See)72 636.6 Q F2 +(XListDepths)2.75 E F0 5.5(.R)C(eturns a v)160.616 636.6 Q(ector of inte)-.165 +E(gers.)-.165 E F1(\(list-pixmap-f)72 666.6 Q(ormats)-.275 E F2(display)4.583 E +F1 247.226(\)p)C -.198(ro)462.244 666.6 S(cedur).198 E(e)-.198 E F0(See)72 +685.2 Q F2(XListPixmapF)4.089 E(ormats)-1.155 E F0 6.839(.R)C 1.339(eturns a v) +201.86 685.2 R 1.339(ector of lists of three inte)-.165 F 1.34 +(gers \(depth, bits per pix)-.165 F 1.34(el, and)-.165 F(scanline pad\).)72 +700.2 Q EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(set-after)72 87 Q(-function!)-.407 E/F2 11 +/Times-Italic@0 SF(display pr)4.583 E(ocedur)-.495 E(e)-.407 E F1 208.264(\)p)C +-.198(ro)462.244 87 S(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2 +(XSetAfterFunction)3.276 E F0 6.026(.R)C .526(eturns the old after function.) +189.157 105.6 R(If)6.025 E F2(pr)3.275 E(ocedur)-.495 E(e)-.407 E F0 .525 +(is #f, the current after func-)3.275 F(tion is disassociated from the display) +72 120.6 Q(.)-.715 E F1(\(after)72 150.6 Q(-function)-.407 E F2(display)4.583 E +F1 275.474(\)p)C -.198(ro)462.244 150.6 S(cedur).198 E(e)-.198 E F0 +(Returns the after function currently associated with the gi)72 169.2 Q -.165 +(ve)-.275 G 2.75(nd).165 G(isplay \(#f if there is none\).)348.65 169.2 Q F1 +(\(synchr)72 199.2 Q(onize)-.198 E F2(display)4.583 E F1 284.417(\)p)C -.198 +(ro)462.244 199.2 S(cedur).198 E(e)-.198 E F0(Sets the display')72 217.8 Q 2.75 +(sa)-.605 G(fter function to)156.029 217.8 Q F2(display-wait-output)2.75 E F0 +(.)A F1 2.75(3. W)72 247.8 R(indo)-.198 E 2.75(wF)-.11 G(unctions)134.645 247.8 +Q(\(windo)72 277.8 Q(w?)-.11 E F2(x)4.583 E F1 325.271(\)p)C -.198(ro)462.244 +277.8 S(cedur).198 E(e)-.198 E F0(Returns #t if)72 296.4 Q(f)-.275 E F2(x)2.75 +E F0(is an object of type)2.75 E F2(window)2.75 E F0(.)A F1(\(drawable?)72 +326.4 Q F2(x)4.583 E F1 317.835(\)p)C -.198(ro)462.244 326.4 S(cedur).198 E(e) +-.198 E F0(Returns #t if)72 345 Q(f)-.275 E F2(x)2.75 E F0(is a `)2.75 E(`dra) +-.814 E -.11(wa)-.165 G(ble').11 E 2.75('\()-.814 G(windo)217.97 345 Q 2.75(wo) +-.275 G 2.75(rp)261.387 345 S(ixmap\).)273.3 345 Q F1(\(windo)72 375 Q +(w-display)-.11 E F2(window)4.583 E F1 264.133(\)p)C -.198(ro)462.244 375 S +(cedur).198 E(e)-.198 E F0(Returns the display associated with the windo)72 +393.6 Q -.715(w.)-.275 G F1(\(cr)72 423.6 Q(eate-windo)-.198 E(w)-.11 E F2 2.75 +(.a)4.583 G -.407(rg)159.974 423.6 S(s).407 E F1 278.84(\)p)C -.198(ro)462.244 +423.6 S(cedur).198 E(e)-.198 E F0(See)72 442.2 Q F2(XCr)2.75 E(eateW)-.407 E +(indow)-.605 E F0 5.5(.T)C(his function is used to create a ne)177.314 442.2 Q +2.75(ww)-.275 G(indo)342.006 442.2 Q -.715(w.)-.275 G .2(The number of ar)72 +460.8 R .2(guments must be e)-.198 F -.165(ve)-.275 G 2.95(n. The).165 F .2 +(1st, 3rd, etc. ar)2.95 F .201(gument is the name \(a symbol\) of an)-.198 F +(attrib)72 475.8 Q .999(ute to be set when the windo)-.22 F 3.749(wi)-.275 G +3.749(sc)241.342 475.8 S .999(reated, the 2nd, 4th, etc. ar)254.254 475.8 R +.998(gument is the corresponding)-.198 F -.275(va)72 490.8 S 2.75(lue. The).275 +F(attrib)2.75 E(utes can be speci\214ed in an)-.22 E 2.75(yo)-.165 G(rder) +275.412 490.8 Q(.)-.605 E(Attrib)72 509.4 Q .648(utes are)-.22 F F2(x)3.398 E +F0(,)A F2(y)3.398 E F0(,)A F2(width)3.398 E F0(,)A F2(height)3.398 E F0(,)A F2 +(bor)3.398 E(der)-.407 E F0 .648(\(each of which has an inte)3.398 F .648 +(ger v)-.165 F(alue\),)-.275 E F2(par)3.398 E(ent)-.407 E F0 .649(\(the parent) +3.399 F(windo)72 524.4 Q 1.013(w\), and all attrib)-.275 F 1.013 +(utes that can be set by means of the)-.22 F/F3 11/Courier@0 SF(set-window-) +3.762 E F2(attrib)A(ute)-.22 E F3(!)A F0(functions)3.762 E(belo)72 539.4 Q 4.47 +(we)-.275 G(xcept)107.798 539.4 Q F2(sibling)4.47 E F0(and)4.47 E F2(stac)4.47 +E(k-mode)-.22 E F0 7.22(.T)C 1.72(he attrib)257.436 539.4 R(utes)-.22 E F2(par) +4.47 E(ent)-.407 E F0(,)A F2(width)4.47 E F0 4.471(,a)C(nd)389.574 539.4 Q F2 +(height)4.471 E F0 1.721(are mandatory)4.471 F(.)-.715 E(The def)72 554.4 Q +(ault for)-.11 E F2(x)2.75 E F0(and)2.75 E F2(y)2.75 E F0(is 0, the def)2.75 E +(ault for)-.11 E F2(bor)2.75 E(der)-.407 E F0(is 2.)2.75 E F1(\(set-windo)72 +584.4 Q(w-x!)-.11 E F2(window value)4.583 E F1 245.532(\)p)C -.198(ro)462.244 +584.4 S(cedur).198 E(e)-.198 E(\(set-windo)72 599.4 Q(w-y!)-.11 E F2 +(window value)4.583 E F1 245.532(\)p)C -.198(ro)462.244 599.4 S(cedur).198 E(e) +-.198 E(\(set-windo)72 614.4 Q(w-width!)-.11 E F2(window value)4.583 E F1 +224.137(\)p)C -.198(ro)462.244 614.4 S(cedur).198 E(e)-.198 E(\(set-windo)72 +629.4 Q(w-height!)-.11 E F2(window value)4.583 E F1 221.695(\)p)C -.198(ro) +462.244 629.4 S(cedur).198 E(e)-.198 E(\(set-windo)72 644.4 Q(w-border)-.11 E +(-width!)-.407 E F2(window value)4.583 E F1 188.497(\)p)C -.198(ro)462.244 +644.4 S(cedur).198 E(e)-.198 E(\(set-windo)72 659.4 Q(w-sibling!)-.11 E F2 +(window value)4.583 E F1 219.847(\)p)C -.198(ro)462.244 659.4 S(cedur).198 E(e) +-.198 E(\(set-windo)72 674.4 Q(w-stack-mode!)-.11 E F2(window value)4.583 E F1 +197.264(\)p)C -.198(ro)462.244 674.4 S(cedur).198 E(e)-.198 E(\(set-windo)72 +689.4 Q(w-backgr)-.11 E(ound-pixmap!)-.198 E F2(window value)4.583 E F1 155.266 +(\)p)C -.198(ro)462.244 689.4 S(cedur).198 E(e)-.198 E(\(set-windo)72 704.4 Q +(w-backgr)-.11 E(ound-pixel!)-.198 E F2(window value)4.583 E F1 168.103(\)p)C +-.198(ro)462.244 704.4 S(cedur).198 E(e)-.198 E(\(set-windo)72 719.4 Q +(w-border)-.11 E(-pixmap!)-.407 E F2(window value)4.583 E F1 179.939(\)p)C +-.198(ro)462.244 719.4 S(cedur).198 E(e)-.198 E(\(set-windo)72 734.4 Q +(w-border)-.11 E(-pixel!)-.407 E F2(window value)4.583 E F1 192.776(\)p)C -.198 +(ro)462.244 734.4 S(cedur).198 E(e)-.198 E EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(set-windo)72 87 Q(w-bit-gra)-.11 E(vity!) +-.275 E/F2 11/Times-Italic@0 SF(window value)4.583 E F1 201.202(\)p)C -.198(ro) +462.244 87 S(cedur).198 E(e)-.198 E(\(set-windo)72 102 Q(w-gra)-.11 E(vity!) +-.275 E F2(window value)4.583 E F1 217.702(\)p)C -.198(ro)462.244 102 S(cedur) +.198 E(e)-.198 E(\(set-windo)72 117 Q(w-backing-stor)-.11 E(e!)-.198 E F2 +(window value)4.583 E F1 187.067(\)p)C -.198(ro)462.244 117 S(cedur).198 E(e) +-.198 E(\(set-windo)72 132 Q(w-backing-planes!)-.11 E F2(window value)4.583 E +F1 180.126(\)p)C -.198(ro)462.244 132 S(cedur).198 E(e)-.198 E(\(set-windo)72 +147 Q(w-backing-pixel!)-.11 E F2(window value)4.583 E F1 187.463(\)p)C -.198 +(ro)462.244 147 S(cedur).198 E(e)-.198 E(\(set-windo)72 162 Q(w-sa)-.11 E -.11 +(ve)-.275 G(-under!).11 E F2(window value)4.583 E F1 199.475(\)p)C -.198(ro) +462.244 162 S(cedur).198 E(e)-.198 E(\(set-windo)72 177 Q(w-e)-.11 E -.11(ve) +-.165 G(nt-mask!).11 E F2(window value)4.583 E F1 197.539(\)p)C -.198(ro) +462.244 177 S(cedur).198 E(e)-.198 E(\(set-windo)72 192 Q(w-do-not-pr)-.11 E +(opagate-mask!)-.198 E F2(window value)4.583 E F1 140.625(\)p)C -.198(ro) +462.244 192 S(cedur).198 E(e)-.198 E(\(set-windo)72 207 Q(w-o)-.11 E -.11(ve) +-.11 G(rride-r).11 E(edir)-.198 E(ect!)-.198 E F2(window value)4.583 E F1 +171.018(\)p)C -.198(ro)462.244 207 S(cedur).198 E(e)-.198 E(\(set-windo)72 222 +Q(w-colormap!)-.11 E F2(window value)4.583 E F1 206.427(\)p)C -.198(ro)462.244 +222 S(cedur).198 E(e)-.198 E(\(set-windo)72 237 Q(w-cursor!)-.11 E F2 +(window value)4.583 E F1 220.485(\)p)C -.198(ro)462.244 237 S(cedur).198 E(e) +-.198 E F0(See)72 255.6 Q F2(XCon\214gur)5.517 E(eW)-.407 E(indow)-.605 E F0(,) +A F2(XChang)5.516 E(eW)-.11 E(indowAttrib)-.605 E(utes)-.22 E F0 8.266(.S)C +2.766(et the sibling windo)324.026 255.6 R 4.196 -.715(w, s)-.275 H 2.766 +(tacking mode,).715 F 1.245(background pixmap, background pix)72 270.6 R 1.245 +(el, border pix)-.165 F 1.245(el, cursor)-.165 F 3.996(,a)-.44 G 1.246 +(nd other attrib)352.141 270.6 R 1.246(utes \(see the)-.22 F/F3 11/Courier@0 SF +(win-)3.996 E(dow-)72 285.6 Q F0(functions belo)2.75 E +(w\) of the speci\214ed windo)-.275 E -.715(w.)-.275 G 1.836 +(The stacking mode is a symbol \()72 304.2 R F3(above)A F0(,)A F3(below)4.586 E +F0(,)A F3(top-if)4.586 E F0(,)A F3(bottom-if)4.585 E F0(,)A F3(opposite)4.585 E +F0 4.585(\). The)B F2(value)72 319.2 Q F0(ar)6.46 E 3.71(gument to)-.198 F F2 +(set-window-sibling!)6.461 E F0 3.711(must be a windo)6.461 F -.715(w,)-.275 G +F2(set-window-bac)7.176 E(kgr)-.22 E(ound-pixmap!)-.495 E F0 -.165(ex)72 334.2 +S 1.722(pects a pixmap,).165 F F2(set-window-bac)4.471 E(kgr)-.22 E +(ound-pixel!)-.495 E F0(and)4.471 E F2(set-window-bor)4.471 E(der)-.407 E +(-pixel!)-.22 E F0 -.165(ex)7.221 G 1.721(pect a pix).165 F(el,)-.165 E(and)72 +349.2 Q F2(set-window-cur)3.989 E(sor!)-.11 E F0 -.165(ex)3.989 G 1.239 +(pects a cursor ar).165 F 3.99(gument. F)-.198 F 1.24(or the types of the)-.165 +F F2(value)3.99 E F0(ar)3.99 E 1.24(gument of the)-.198 F +(other functions see the return v)72 364.2 Q(alues of the)-.275 E F2(window-) +2.75 E F0(functions belo)2.75 E -.715(w.)-.275 G F1(\(windo)72 394.2 Q(w-x)-.11 +E F2(window)4.583 E F1 292.26(\)p)C -.198(ro)462.244 394.2 S(cedur).198 E(e) +-.198 E(\(windo)72 409.2 Q(w-y)-.11 E F2(window)4.583 E F1 292.26(\)p)C -.198 +(ro)462.244 409.2 S(cedur).198 E(e)-.198 E(\(windo)72 424.2 Q(w-width)-.11 E F2 +(window)4.583 E F1 270.865(\)p)C -.198(ro)462.244 424.2 S(cedur).198 E(e)-.198 +E(\(windo)72 439.2 Q(w-height)-.11 E F2(window)4.583 E F1 268.423(\)p)C -.198 +(ro)462.244 439.2 S(cedur).198 E(e)-.198 E(\(windo)72 454.2 Q(w-border)-.11 E +(-width)-.407 E F2(window)4.583 E F1 235.225(\)p)C -.198(ro)462.244 454.2 S +(cedur).198 E(e)-.198 E(\(windo)72 469.2 Q(w-depth)-.11 E F2(window)4.583 E F1 +270.865(\)p)C -.198(ro)462.244 469.2 S(cedur).198 E(e)-.198 E(\(windo)72 484.2 +Q(w-visual)-.11 E F2(window)4.583 E F1 270.249(\)p)C -.198(ro)462.244 484.2 S +(cedur).198 E(e)-.198 E(\(windo)72 499.2 Q(w-r)-.11 E(oot)-.198 E F2(window) +4.583 E F1 278.411(\)p)C -.198(ro)462.244 499.2 S(cedur).198 E(e)-.198 E +(\(windo)72 514.2 Q(w-class)-.11 E F2(window)4.583 E F1 275.76(\)p)C -.198(ro) +462.244 514.2 S(cedur).198 E(e)-.198 E(\(windo)72 529.2 Q(w-bit-gra)-.11 E +(vity)-.275 E F2(window)4.583 E F1 247.93(\)p)C -.198(ro)462.244 529.2 S(cedur) +.198 E(e)-.198 E(\(windo)72 544.2 Q(w-gra)-.11 E(vity)-.275 E F2(window)4.583 E +F1 264.43(\)p)C -.198(ro)462.244 544.2 S(cedur).198 E(e)-.198 E(\(windo)72 +559.2 Q(w-backing-stor)-.11 E(e)-.198 E F2(window)4.583 E F1 233.795(\)p)C +-.198(ro)462.244 559.2 S(cedur).198 E(e)-.198 E(\(windo)72 574.2 Q +(w-backing-planes)-.11 E F2(window)4.583 E F1 226.854(\)p)C -.198(ro)462.244 +574.2 S(cedur).198 E(e)-.198 E(\(windo)72 589.2 Q(w-backing-pixel)-.11 E F2 +(window)4.583 E F1 234.191(\)p)C -.198(ro)462.244 589.2 S(cedur).198 E(e)-.198 +E(\(windo)72 604.2 Q(w-sa)-.11 E -.11(ve)-.275 G(-under).11 E F2(window)4.583 E +F1 246.203(\)p)C -.198(ro)462.244 604.2 S(cedur).198 E(e)-.198 E(\(windo)72 +619.2 Q(w-colormap)-.11 E F2(window)4.583 E F1 253.155(\)p)C -.198(ro)462.244 +619.2 S(cedur).198 E(e)-.198 E(\(windo)72 634.2 Q(w-map-installed)-.11 E F2 +(window)4.583 E F1 233.586(\)p)C -.198(ro)462.244 634.2 S(cedur).198 E(e)-.198 +E(\(windo)72 649.2 Q(w-map-state)-.11 E F2(window)4.583 E F1 251.329(\)p)C +-.198(ro)462.244 649.2 S(cedur).198 E(e)-.198 E(\(windo)72 664.2 Q(w-all-e)-.11 +E -.11(ve)-.165 G(nt-masks).11 E F2(window)4.583 E F1 224.709(\)p)C -.198(ro) +462.244 664.2 S(cedur).198 E(e)-.198 E(\(windo)72 679.2 Q(w-y)-.11 E(our)-.275 +E(-e)-.407 E -.11(ve)-.165 G(nt-mask).11 E F2(window)4.583 E F1 219.286(\)p)C +-.198(ro)462.244 679.2 S(cedur).198 E(e)-.198 E(\(windo)72 694.2 Q(w-do-not-pr) +-.11 E(opagate-mask)-.198 E F2(window)4.583 E F1 187.353(\)p)C -.198(ro)462.244 +694.2 S(cedur).198 E(e)-.198 E(\(windo)72 709.2 Q(w-o)-.11 E -.11(ve)-.11 G +(rride-r).11 E(edir)-.198 E(ect)-.198 E F2(window)4.583 E F1 217.746(\)p)C +-.198(ro)462.244 709.2 S(cedur).198 E(e)-.198 E(\(windo)72 724.2 Q(w-scr)-.11 E +(een)-.198 E F2(window)4.583 E F1 268.027(\)p)C -.198(ro)462.244 724.2 S(cedur) +.198 E(e)-.198 E EP +%%Page: 6 6 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(See)72 87 Q/F1 11/Times-Italic@0 SF(XGetW)3.301 E(indowAttrib)-.605 +E(utes)-.22 E F0 6.051(.R)C .551 +(eturns the x and y coordinates, width, height, border width, depth,)208.556 87 +R .437(visual, root windo)72 102 R 1.867 -.715(w, c)-.275 H .437(lass, bit gra) +.715 F(vity)-.22 E 3.187(,w)-.715 G(indo)251.744 102 Q 3.187(wg)-.275 G(ra) +287.656 102 Q(vity)-.22 E 3.187(,b)-.715 G .437(acking store a)323.821 102 R +-.275(va)-.22 G(ilability).275 E 3.187(,b)-.715 G .437(acking planes,)440.632 +102 R 1.856(backing pix)72 117 R 1.856(el, sa)-.165 F 2.186 -.165(ve u)-.22 H +1.856(nder a).165 F -.275(va)-.22 G(ilability).275 E 4.605(,c)-.715 G 1.855 +(olormap, colormap installation information, map state,)254.573 117 R 1.314 +(global e)72 132 R -.165(ve)-.275 G 1.314(nt mask, local e).165 F -.165(ve) +-.275 G 1.315(nt mask, `).165 F(`do-not-propag)-.814 E(ate')-.055 E 4.065('m) +-.814 G 1.315(ask, o)345.334 132 R -.165(ve)-.165 G 1.315 +(rride redirect attrib).165 F 1.315(ute, and)-.22 F +(screen of the speci\214ed windo)72 147 Q -.715(w.)-.275 G F1(window-visual)72 +165.6 Q F0(and)3.45 E F1(window-scr)3.45 E(een)-.407 E F0(al)3.45 E -.11(wa) +-.11 G .7(ys return the empty list in the current release of the soft-).11 F +-.11(wa)72 180.6 S(re.).11 E F1(window-r)9.503 E(oot)-.495 E F0 4.003 +(returns a windo)6.753 F -.715(w.)-.275 G F1(window-class)263.65 180.6 Q F0 +4.004(returns a symbol \()6.754 F/F2 11/Courier@0 SF(input-output)A F0(,)A F2 +(input-only)72 195.6 Q F0(\).)A F1(window-bit-gr)154.924 195.6 Q(avity)-.165 E +F0 5.011(returns a symbol \()7.761 F F2(forget)A F0(,)A F2(north-west)7.761 E +F0(,)A F2(north)7.76 E F0(,)A F2(north-east)72 210.6 Q F0(,)A F2(west)6.191 E +F0(,)A F2(center)6.191 E F0(,)A F2(east)6.191 E F0(,)A F2(south-west)6.191 E F0 +(,)A F2(south)6.191 E F0(,)A F2(south-east)6.191 E F0(,)A F2(static)6.191 E F0 +(\).)A F1(window-gr)72 225.6 Q(avity)-.165 E F0 .594 +(returns a symbol \(same as)3.344 F F1(window-bit-gr)3.344 E(avity)-.165 E F0 +(with)3.344 E F2(unmap)3.344 E F0 .593(instead of)3.343 F F2(forget)3.343 E F0 +(\).)A F1(window-bac)72 240.6 Q(king-stor)-.22 E(e)-.407 E F0 1.821 +(returns a symbol \()4.57 F F2(not-useful)A F0(,)A F2(when-mapped)4.571 E F0(,) +A F2(always)4.571 E F0(\).)A F1(window-)7.321 E(bac)72 255.6 Q(king-planes)-.22 +E F0(and)6.154 E F1(window-bac)6.154 E(king-pixel)-.22 E F0 3.403(return a pix) +6.153 F(el.)-.165 E F1(window-save-under)8.903 E F0(,)A F1(window-map-)6.153 E +(installed)72 270.6 Q F0(and)4.705 E F1(window-o)4.705 E(verride-r)-.11 E(edir) +-.407 E(ect)-.407 E F0 1.955(return #t or #f.)4.705 F F1(window-colormap)7.456 +E F0 1.956(returns a colormap.)4.706 F F1(window-map-state)72 285.6 Q F0 2.935 +(returns a symbol \()5.685 F F2(unmapped)A F0(,)A F2(unviewable)5.685 E F0(,)A +F2(viewable)5.685 E F0(\).)A F1(window-all-)8.435 E -.165(ev)72 300.6 S +(ent-masks).165 E F0(,)A F1(window-your)3.659 E(-e)-.22 E(vent-mask)-.165 E F0 +3.66(,a)C(nd)254.109 300.6 Q F1(window-do-not-pr)3.66 E(opa)-.495 E(gate-mask) +-.11 E F0 .91(return a list of sym-)3.66 F 1.273(bols \(e)72 315.6 R -.165(ve) +-.275 G 1.273(nt mask names such as).165 F F2(enter-window)4.023 E F0(,)A F2 +(pointer-motion)4.023 E F0 4.023(,e)C 4.022(tc.\). All)412.206 315.6 R 1.272 +(other func-)4.022 F(tions return an inte)72 330.6 Q(ger)-.165 E(.)-.605 E/F3 +11/Times-Bold@0 SF(\(drawable-r)72 360.6 Q(oot)-.198 E F1(dr)4.583 E(awable) +-.165 E F3 263.814(\)p)C -.198(ro)462.244 360.6 S(cedur).198 E(e)-.198 E +(\(drawable-x)72 375.6 Q F1(dr)4.583 E(awable)-.165 E F3 277.663(\)p)C -.198 +(ro)462.244 375.6 S(cedur).198 E(e)-.198 E(\(drawable-y)72 390.6 Q F1(dr)4.583 +E(awable)-.165 E F3 277.663(\)p)C -.198(ro)462.244 390.6 S(cedur).198 E(e)-.198 +E(\(drawable-width)72 405.6 Q F1(dr)4.583 E(awable)-.165 E F3 256.268(\)p)C +-.198(ro)462.244 405.6 S(cedur).198 E(e)-.198 E(\(drawable-height)72 420.6 Q F1 +(dr)4.583 E(awable)-.165 E F3 253.826(\)p)C -.198(ro)462.244 420.6 S(cedur).198 +E(e)-.198 E(\(drawable-border)72 435.6 Q(-width)-.407 E F1(dr)4.583 E(awable) +-.165 E F3 220.628(\)p)C -.198(ro)462.244 435.6 S(cedur).198 E(e)-.198 E +(\(drawable-depth)72 450.6 Q F1(dr)4.583 E(awable)-.165 E F3 256.268(\)p)C +-.198(ro)462.244 450.6 S(cedur).198 E(e)-.198 E F0(See)72 469.2 Q F1 +(XGetGeometry)3.625 E F0 6.375(.R)C .875(eturns the root windo)173.949 469.2 R +2.305 -.715(w, x a)-.275 H .876(nd y coordinates, width, height, border width,) +.715 F .949(and depth of the speci\214ed dra)72 484.2 R -.11(wa)-.165 G(ble.) +.11 E F1(dr)6.448 E(awable-r)-.165 E(oot)-.495 E F0 .948(returns a windo)3.698 +F 2.378 -.715(w, a)-.275 H .948(ll other functions return).715 F(an inte)72 +499.2 Q(ger)-.165 E(.)-.605 E F3(\(map-windo)72 529.2 Q(w)-.11 E F1(window) +4.583 E F3 276.981(\)p)C -.198(ro)462.244 529.2 S(cedur).198 E(e)-.198 E F0 +(See)72 547.8 Q F1(XMapW)2.75 E(indow)-.605 E F0(.)A F3(\(unmap-windo)72 577.8 +Q(w)-.11 E F1(window)4.583 E F3 264.749(\)p)C -.198(ro)462.244 577.8 S(cedur) +.198 E(e)-.198 E F0(See)72 596.4 Q F1(XUnmapW)2.75 E(indow)-.605 E F0(.)A F3 +(\(destr)72 626.4 Q(oy-windo)-.198 E(w)-.11 E F1(window)4.583 E F3 263.132(\)p) +C -.198(ro)462.244 626.4 S(cedur).198 E(e)-.198 E F0(See)72 645 Q F1(XDestr) +2.75 E(oyW)-.495 E(indow)-.605 E F0(.)A F3(\(destr)72 675 Q(oy-subwindo)-.198 E +(ws)-.11 E F1(window)4.583 E F3 242.342(\)p)C -.198(ro)462.244 675 S(cedur).198 +E(e)-.198 E F0(See)72 693.6 Q F1(XDestr)2.75 E(oySubwindows)-.495 E F0(.)A EP +%%Page: 7 7 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-7-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(map-subwindo)72 87 Q(ws)-.11 E/F2 11 +/Times-Italic@0 SF(window)4.583 E F1 256.191(\)p)C -.198(ro)462.244 87 S(cedur) +.198 E(e)-.198 E F0(See)72 105.6 Q F2(XMapSubwindows)2.75 E F0(.)A F1 +(\(unmap-subwindo)72 135.6 Q(ws)-.11 E F2(window)4.583 E F1 243.959(\)p)C -.198 +(ro)462.244 135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q F2 +(XUnmapSubwindows)2.75 E F0(.)A F1(\(cir)72 184.2 Q(culate-subwindo)-.198 E(ws) +-.11 E F2(window dir)4.583 E(ection)-.407 E F1 194.173(\)p)C -.198(ro)462.244 +184.2 S(cedur).198 E(e)-.198 E F0(See)72 202.8 Q F2(XCir)2.75 E +(culateSubwindows)-.407 E F0(.)A F2(dir)5.5 E(ection)-.407 E F0(is a symbol \() +2.75 E/F3 11/Courier@0 SF(raise-lowest)A F0(or)2.75 E F3(lower-highest)2.75 E +F0(\).)A F1(\(clear)72 232.8 Q(-windo)-.407 E(w)-.11 E F2(window)4.583 E F1 +274.957(\)p)C -.198(ro)462.244 232.8 S(cedur).198 E(e)-.198 E F0(Performs a)72 +251.4 Q F2(clear)2.75 E(-ar)-.22 E(ea)-.407 E F0(on the entire windo)2.75 E +-.715(w.)-.275 G F1(\(raise-windo)72 281.4 Q(w)-.11 E F2(window)4.583 E F1 +275.155(\)p)C -.198(ro)462.244 281.4 S(cedur).198 E(e)-.198 E F0(See)72 300 Q +F2(XRaiseW)2.75 E(indow)-.605 E F0(.)A F1(\(lo)72 330 Q(wer)-.11 E(-windo)-.407 +E(w)-.11 E F2(window)4.583 E F1 272.009(\)p)C -.198(ro)462.244 330 S(cedur).198 +E(e)-.198 E F0(See)72 348.6 Q F2(XLowerW)2.75 E(indow)-.605 E F0(.)A F1(\(r)72 +378.6 Q(estack-windo)-.198 E(ws)-.11 E F2(list-of-windows)4.583 E F1 225.853 +(\)p)C -.198(ro)462.244 378.6 S(cedur).198 E(e)-.198 E F0(See)72 397.2 Q F2 +(XRestac)2.75 E(kW)-.22 E(indows)-.605 E F0(.)A F1(\(query-tr)72 427.2 Q(ee) +-.198 E F2(window)4.583 E F1 288.707(\)p)C -.198(ro)462.244 427.2 S(cedur).198 +E(e)-.198 E F0(See)72 445.8 Q F2(XQueryT)3.663 E -.407(re)-.605 G(e).407 E F0 +6.413(.R)C .913(eturns a list of three elements: root windo)161.408 445.8 R +2.344 -.715(w, p)-.275 H .914(arent windo).715 F 2.344 -.715(w, a)-.275 H .914 +(nd children \(a).715 F -.165(ve)72 460.8 S(ctor of windo).165 E(ws\).)-.275 E +F1(\(translate-coordinates)72 490.8 Q F2(sr)4.583 E(c-window x y dst-window) +-.407 E F1 152.945(\)p)C -.198(ro)462.244 490.8 S(cedur).198 E(e)-.198 E F0 +(See)72 509.4 Q F2(XT)3.385 E -.165(ra)-.605 G(nslateCoor).165 E(dinates)-.407 +E F0 6.135(.R)C .635(eturns a list of three elements: destination x and y) +209.604 509.4 R 3.384(,a)-.715 G .634(nd child win-)444.069 509.4 R(do)72 524.4 +Q -.715(w.)-.275 G F1(\(query-pointer)72 554.4 Q F2(window)4.583 E F1 272.603 +(\)p)C -.198(ro)462.244 554.4 S(cedur).198 E(e)-.198 E F0(See)72 573 Q F2 +(XQueryP)3.793 E(ointer)-.88 E F0 6.543(.R)C 1.043 +(eturns a list of eight elements: x and y)174.637 573 R 3.794(,ab)-.715 G 1.044 +(oolean indicating whether the)370.419 573 R .058 +(pointer is on the same screen as the speci\214ed windo)72 588 R 1.487 -.715 +(w, t)-.275 H .057(he root windo).715 F 1.487 -.715(w, t)-.275 H .057 +(he root windo).715 F(w')-.275 E 2.807(sxa)-.605 G .057(nd y)484.693 588 R +(coordinates, the child windo)72 603 Q 1.43 -.715(w, a)-.275 H +(nd a list of modi\214er names \(see).715 E F2(gr)2.75 E(ab-b)-.165 E(utton) +-.22 E F0(belo)2.75 E(w\).)-.275 E F1 2.75(4. W)72 633 R(indo)-.198 E 2.75(wP) +-.11 G -.198(ro)134.645 633 S(perty and Selection Functions).198 E(\(atom?)72 +663 Q F2(x)4.583 E F1 338.009(\)p)C -.198(ro)462.244 663 S(cedur).198 E(e)-.198 +E F0(Returns #t if)72 681.6 Q(f)-.275 E F2(x)2.75 E F0(is an object of type) +2.75 E F2(atom)2.75 E F0(.)A EP +%%Page: 8 8 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-8-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(mak)72 87 Q(e-atom)-.11 E/F2 11 +/Times-Italic@0 SF(value)4.583 E F1 295.351(\)p)C -.198(ro)462.244 87 S(cedur) +.198 E(e)-.198 E F0(Returns an atom with the gi)72 105.6 Q -.165(ve)-.275 G(n) +.165 E F2(value)2.75 E F0(.)A F2(value)5.5 E F0(is an inte)2.75 E(ger)-.165 E +(.)-.605 E F1(\(inter)72 135.6 Q(n-atom)-.165 E F2(display name)4.583 E F1 +257.819(\)p)C -.198(ro)462.244 135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q +F2(XInternAtom)2.75 E F0(.)A F2(name)5.5 E F0(is a string or a symbol.)2.75 E +(The atom is created if it does not yet e)5.5 E(xist.)-.165 E F1(\(\214nd-atom) +72 184.2 Q F2(display name)4.583 E F1 268.027(\)p)C -.198(ro)462.244 184.2 S +(cedur).198 E(e)-.198 E F0(See)72 202.8 Q F2(XInternAtom)3.378 E F0(.)A F2 +(name)6.128 E F0 .628(is a string or a symbol.)3.378 F .629 +(If the atom does not e)6.129 F .629(xist, the symbol)-.165 F/F3 11/Courier@0 +SF(none)3.379 E F0(is)3.379 E(returned.)72 217.8 Q F1(\(atom-name)72 247.8 Q F2 +(display atom)4.583 E F1 262.538(\)p)C -.198(ro)462.244 247.8 S(cedur).198 E(e) +-.198 E F0(See)72 266.4 Q F2(XGetAtomName)2.75 E F0 5.5(.R)C(eturns a string.) +177.71 266.4 Q F1(\(list-pr)72 296.4 Q(operties)-.198 E F2(window)4.583 E F1 +272.196(\)p)C -.198(ro)462.244 296.4 S(cedur).198 E(e)-.198 E F0(See)72 315 Q +F2(XListPr)2.75 E(operties)-.495 E F0 5.5(.R)C(eturns a v)175.4 315 Q +(ector of atoms.)-.165 E F1(\(get-pr)72 345 Q(operty)-.198 E F2(window pr)4.583 +E(operty r)-.495 E(equest-type of)-.407 E(fset length delete?)-.198 E F1 90.916 +(\)p)C -.198(ro)462.244 345 S(cedur).198 E(e)-.198 E F0(See)72 363.6 Q F2 +(XGetW)3.719 E(indowPr)-.605 E(operty)-.495 E F0(.)A F2(pr)6.469 E(operty)-.495 +E F0 .969(is an object of type)3.719 F F2(atom)3.719 E F0(.)A F2 -.407(re)6.468 +G(quest-type).407 E F0 .968(is an atom or #f in)3.718 F .622(which case)72 +378.6 R F2(AnyPr)3.372 E(opertyT)-.495 E(ype)-.814 E F0 .622(will be used.) +3.372 F F2(of)6.122 E(fset)-.198 E F0(and)3.372 E F2(length)3.372 E F0 .623 +(are inte)3.372 F 3.373(gers. An)-.165 F .623(error is signaled if)3.373 F F2 +(XGetW)72 393.6 Q(indowPr)-.605 E(operty)-.495 E F0 -.11(fa)2.75 G(ils.).11 E +F2 -.11(ge)72 412.2 S(t-pr).11 E(operty)-.495 E F0 .573 +(returns a list of four items: the `)3.323 F .572(`actual type')-.814 F 3.322 +('\()-.814 G .572(an atom\), the format \(an inte)338.219 412.2 R .572 +(ger\), the)-.165 F(data \(if an)72 427.2 Q 1.43 -.715(y, t)-.165 H +(he empty list otherwise\), and the number of bytes left \(an inte).715 E +(ger\).)-.165 E(The data returned is either a string \(if the format indicates\ + 8-bit data\) or a v)72 445.8 Q(ector of inte)-.165 E(gers.)-.165 E F1 +(\(change-pr)72 475.8 Q(operty)-.198 E F2(window pr)4.583 E +(operty type format mode data)-.495 E F1 117.789(\)p)C -.198(ro)462.244 475.8 S +(cedur).198 E(e)-.198 E F0(See)72 494.4 Q F2(XChang)2.829 E(ePr)-.11 E(operty) +-.495 E F0(.)A F2(pr)5.579 E(operty)-.495 E F0(and)2.829 E F2(type)2.829 E F0 +.079(are atoms.)2.829 F F2(format)5.579 E F0 .08(is an inte)2.83 F .08 +(ger \(8, 16, or 32\).)-.165 F(If)5.58 E F2(format)2.83 E F0 .534(is 8)72 509.4 +R F2(data)3.283 E F0 .533(must be a string, otherwise a v)3.283 F .533 +(ector of inte)-.165 F .533(gers of the appropriate size.)-.165 F .533 +(An error is sig-)6.033 F .182(naled if the v)72 524.4 R .182(alue of)-.275 F +F2(format)2.932 E F0 .182(is in)2.932 F -.275(va)-.44 G .182(lid or if).275 F +F2(data)2.932 E F0 .182(holds an inte)2.932 F .182(ger that e)-.165 F .183 +(xceeds the size indicated by)-.165 F F2(format)72 539.4 Q F0(.)A F2(mode)5.5 E +F0(is a symbol \()2.75 E F3(replace)A F0(,)A F3(prepend)2.75 E F0 2.75(,o)C(r) +301.592 539.4 Q F3(append)2.75 E F0(\).)A F1(\(delete-pr)72 569.4 Q(operty) +-.198 E F2(window pr)4.583 E(operty)-.495 E F1 225.347(\)p)C -.198(ro)462.244 +569.4 S(cedur).198 E(e)-.198 E F0(See)72 588 Q F2(XDeletePr)2.75 E(operty)-.495 +E F0(.)A F1(\(r)72 618 Q(otate-pr)-.198 E(operties)-.198 E F2(window vector) +4.583 E(-of-atoms delta)-.22 E F1 161.426(\)p)C -.198(ro)462.244 618 S(cedur) +.198 E(e)-.198 E F0(See)72 636.6 Q F2(XRotateW)2.75 E(indowPr)-.605 E(operties) +-.495 E F0(.)A F2(delta)5.5 E F0(is the amount to rotate \(an inte)2.75 E +(ger\).)-.165 E F1(\(set-selection-o)72 666.6 Q(wner!)-.11 E F2 +(display selection owner time)4.583 E F1 153.286(\)p)C -.198(ro)462.244 666.6 S +(cedur).198 E(e)-.198 E F0(See)72 685.2 Q F2(XSetSelectionOwner)3.045 E F0(.)A +F2(selection)5.794 E F0 .294(is an atom;)3.044 F F2(owner)3.044 E F0 .294 +(is a windo)3.044 F(w;)-.275 E F2(time)3.044 E F0 .294(is an inte)3.044 F .294 +(ger or the sym-)-.165 F(bol)72 700.2 Q F3(now)2.75 E F0(\(for)2.75 E F2(Curr) +2.75 E(entT)-.407 E(ime)-.605 E F0(\).)A EP +%%Page: 9 9 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-9-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(selection-o)72 87 Q(wner)-.11 E/F2 11 +/Times-Italic@0 SF(display selection)4.583 E F1 225.38(\)p)C -.198(ro)462.244 +87 S(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2(XGetSelectionOwner)2.75 E F0 +(.)A F1(\(con)72 135.6 Q -.11(ve)-.44 G(rt-selection).11 E F2(selection tar) +4.583 E -.11(ge)-.407 G 2.75(tp).11 G -.495(ro)234.983 135.6 S(perty r).495 E +(equestor)-.407 E(-window time)-.22 E F1 81.72(\)p)C -.198(ro)462.244 135.6 S +(cedur).198 E(e)-.198 E F0(See)72 154.2 Q F2(XCon)3.127 E(vertSelection)-.44 E +F0(.)A F2(selection)5.877 E F0(and)3.127 E F2(tar)3.127 E -.11(ge)-.407 G(t).11 +E F0 .378(are atoms;)3.128 F F2(pr)3.128 E(operty)-.495 E F0 .378 +(is an atom or the symbol)3.128 F/F3 11/Courier@0 SF(none)3.128 E F0(.)A F1 +2.75(5. Colormap)72 184.2 R(Functions)2.75 E(\(color?)72 214.2 Q F2(x)4.583 E +F1 338.009(\)p)C -.198(ro)462.244 214.2 S(cedur).198 E(e)-.198 E F0 +(Returns #t if)72 232.8 Q(f)-.275 E F2(x)2.75 E F0(is an object of type)2.75 E +F2(color)2.75 E F0(.)A F1(\(mak)72 262.8 Q(e-color)-.11 E F2 2.75(rgb)4.583 G +F1 298.398(\)p)154.067 262.8 S -.198(ro)462.244 262.8 S(cedur).198 E(e)-.198 E +F0 .747(Returns an object of type)72 281.4 R F2(color)3.497 E F0 .747 +(with the speci\214ed RGB components.)3.497 F F2(r)6.247 E F0(,)A F2(g)3.496 E +F0 3.496(,a)C(nd)413.821 281.4 Q F2(b)3.496 E F0 .746(are reals in the)3.496 F +(range 0.0 to 1.0.)72 296.4 Q F1(\(color)72 326.4 Q(-r)-.407 E(gb-v)-.11 E +(alues)-.11 E F2(color)4.583 E F1 272.636(\)p)C -.198(ro)462.244 326.4 S(cedur) +.198 E(e)-.198 E F0 +(Returns a list of three elements, the RGB components of the gi)72 345 Q -.165 +(ve)-.275 G 2.75(nc).165 G(olor \(see)371.277 345 Q F2(mak)2.75 E(e-color)-.11 +E F0(abo)2.75 E -.165(ve)-.165 G(\).).165 E F1(\(query-color)72 375 Q F2 +(colormap pixel)4.583 E F1 250.933(\)p)C -.198(ro)462.244 375 S(cedur).198 E(e) +-.198 E F0(See)72 393.6 Q F2(XQueryColor)2.75 E F0(.)A F1(\(query-colors)72 +423.6 Q F2(colormap pixels)4.583 E F1 242.375(\)p)C -.198(ro)462.244 423.6 S +(cedur).198 E(e)-.198 E F0(See)72 442.2 Q F2(XQueryColor)2.751 E(s)-.11 E F0(.) +A F2(pixels)5.501 E F0 .001(is a v)2.751 F .001(ector of pix)-.165 F 2.751 +(els. Returns)-.165 F 2.751(av)2.751 G .001 +(ector of colors of the same size as)335.372 442.2 R F2(pix-)2.752 E(els)72 +457.2 Q F0(.)A F1(\(lookup-color)72 487.2 Q F2(colormap color)4.583 E(-name) +-.22 E F1 216.921(\)p)C -.198(ro)462.244 487.2 S(cedur).198 E(e)-.198 E F0(See) +72 505.8 Q F2(XLookupColor)2.75 E F0(.)A F2(color)5.5 E(-name)-.22 E F0 +(is a string or a symbol.)2.75 E(Returns a pair of colors.)5.5 E F1 +(\(alloc-color)72 535.8 Q F2(colormap color)4.583 E F1 254.596(\)p)C -.198(ro) +462.244 535.8 S(cedur).198 E(e)-.198 E F0(See)72 554.4 Q F2(XAllocColor)2.75 E +F0 5.5(.R)C(eturns a pix)161.837 554.4 Q(el \(or #f in case of an error\).) +-.165 E F1(\(alloc-named-color)72 584.4 Q F2(colormap color)4.583 E(-name)-.22 +E F1 191.885(\)p)C -.198(ro)462.244 584.4 S(cedur).198 E(e)-.198 E F0(See)72 +603 Q F2(AllocNamedColor)4.006 E F0(.)A F2(color)6.756 E(-name)-.22 E F0 1.256 +(is a string or a symbol.)4.006 F 1.256(Returns a list of three elements: a) +6.756 F(pix)72 618 Q(el, and tw)-.165 E 2.75(oc)-.11 G +(olors \(the closest color and the e)141.993 618 Q +(xact color\); or #f in case of an error)-.165 E(.)-.605 E F1(\(colormap?)72 +648 Q F2(x)4.583 E F1 317.23(\)p)C -.198(ro)462.244 648 S(cedur).198 E(e)-.198 +E F0(Returns #t if)72 666.6 Q(f)-.275 E F2(x)2.75 E F0(is an object of type) +2.75 E F2(colormap)2.75 E F0(.)A EP +%%Page: 10 10 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(0-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(colormap-display)72 87 Q/F2 11 +/Times-Italic@0 SF(colormap)4.583 E F1 248.161(\)p)C -.198(ro)462.244 87 S +(cedur).198 E(e)-.198 E F0(Returns the display associated with the gi)72 105.6 +Q -.165(ve)-.275 G 2.75(nc).165 G(olormap.)277.788 105.6 Q F1(\(fr)72 135.6 Q +(ee-colormap)-.198 E F2(colormap)4.583 E F1 263.671(\)p)C -.198(ro)462.244 +135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q F2(XF)2.75 E -.407(re)-.605 G +(eColormap).407 E F0(.)A F1 2.75(6. Pixel)72 184.2 R(Functions)2.75 E(\(pixel?) +72 214.2 Q F2(x)4.583 E F1 339.219(\)p)C -.198(ro)462.244 214.2 S(cedur).198 E +(e)-.198 E F0(Returns #t if)72 232.8 Q(f)-.275 E F2(x)2.75 E F0 +(is an object of type)2.75 E F2(pixel)2.75 E F0(.)A F1(\(pixel-v)72 262.8 Q +(alue)-.11 E F2(pixel)4.583 E F1 299.608(\)p)C -.198(ro)462.244 262.8 S(cedur) +.198 E(e)-.198 E F0(Returns the v)72 281.4 Q(alue of the pix)-.275 E +(el as an unsigned inte)-.165 E(ger)-.165 E(.)-.605 E F1(\(black-pixel)72 311.4 +Q F2(display)4.583 E F1 288.487(\)p)C -.198(ro)462.244 311.4 S(cedur).198 E(e) +-.198 E(\(white-pixel)72 326.4 Q F2(display)4.583 E F1 288.498(\)p)C -.198(ro) +462.244 326.4 S(cedur).198 E(e)-.198 E F0(See)72 345 Q F2(XBlac)2.75 E(kPixel) +-.22 E F0(,)A F2(XWhitePixel)2.75 E F0 5.5(.R)C(eturns the black/white pix) +220.863 345 Q(el of the display')-.165 E 2.75(sd)-.605 G(ef)420.821 345 Q +(ault screen.)-.11 E F1 2.75(7. Pixmap)72 375 R(Functions)2.75 E(\(pixmap?)72 +405 Q F2(x)4.583 E F1 326.382(\)p)C -.198(ro)462.244 405 S(cedur).198 E(e)-.198 +E F0(Returns #t if)72 423.6 Q(f)-.275 E F2(x)2.75 E F0(is an object of type) +2.75 E F2(pixmap)2.75 E F0(.)A F1(\(pixmap-display)72 453.6 Q F2(pixmap)4.583 E +F1 267.092(\)p)C -.198(ro)462.244 453.6 S(cedur).198 E(e)-.198 E F0 +(Returns the display associated with the pixmap.)72 472.2 Q F1(\(fr)72 502.2 Q +(ee-pixmap)-.198 E F2(pixmap)4.583 E F1 282.602(\)p)C -.198(ro)462.244 502.2 S +(cedur).198 E(e)-.198 E F0(See)72 520.8 Q F2(XF)2.75 E -.407(re)-.605 G +(ePixmap).407 E F0(.)A F1(\(cr)72 550.8 Q(eate-pixmap)-.198 E F2(dr)4.583 E +(awable width height depth)-.165 E F1 178.564(\)p)C -.198(ro)462.244 550.8 S +(cedur).198 E(e)-.198 E F0(See)72 569.4 Q F2(XCr)2.75 E(eatePixmap)-.407 E F0 +(.)A F1(\(cr)72 599.4 Q(eate-bitmap-fr)-.198 E(om-data)-.198 E F2 +(window data width height)4.583 E F1 141.329(\)p)C -.198(ro)462.244 599.4 S +(cedur).198 E(e)-.198 E F0(See)72 618 Q F2(XCr)4.628 E(eateBitmapF)-.407 E +-.495(ro)-.605 G(mData).495 E F0(.)A F2(data)7.378 E F0 1.878(is a string.) +4.628 F/F3 11/Courier@0 SF 1.878(\(* width height\))7.378 F F0 1.878 +(must not e)4.628 F 1.878(xceed the)-.165 F(number of bits in)72 633 Q F2 +(string)2.75 E F0(.)A F1(\(cr)72 663 Q(eate-pixmap-fr)-.198 E(om-bitmap-data) +-.198 E F2(win data width height for)4.583 E -.44(eg)-.407 G(rnd bac).44 E +(kgrnd depth)-.22 E F1 8.878(\)p)C -.198(ro)462.244 663 S(cedur).198 E(e)-.198 +E F0(See)72 681.6 Q F2(XCr)3.216 E(eatePixmapF)-.407 E -.495(ro)-.605 G +(mBitmapData).495 E F0(.)A F2(data)5.966 E F0 .466(is a string.)3.216 F F3 .466 +(\(* width height\))5.966 F F0 .465(must not e)3.215 F(xceed)-.165 E +(the number of bits in)72 696.6 Q F2(string)2.75 E F0(.)A EP +%%Page: 11 11 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(1-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(r)72 87 Q(ead-bitmap-\214le)-.198 E/F2 11 +/Times-Italic@0 SF(dr)4.583 E(awable \214lename)-.165 E F1 214.622(\)p)C -.198 +(ro)462.244 87 S(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2(XReadBitmapF)4.27 +E(ile)-.495 E F0(.)A F2(\214lename)7.02 E F0 1.52(is a string or a symbol.)4.27 +F(If)7.02 E F2(XReadBitmapF)4.271 E(ile)-.495 E F0 1.521(signals an error)4.271 +F(,)-.44 E F2 -.407(re)72 120.6 S(ad-bitmap-\214le).407 E F0 1.801 +(returns a symbol \()4.552 F/F3 11/Courier@0 SF(open-failed)A F0(,)A F3 +(file-invalid)4.551 E F0 4.551(,o)C(r)404.679 120.6 Q F3(no-memory)4.551 E F0 +4.551(\). If)B(it)4.551 E(succeeds,)72 135.6 Q F2 -.407(re)3.621 G +(ad-bitmap-\214le).407 E F0 .871(returns a list of \214v)3.621 F 3.621(ee)-.165 +G .871(lements: the bitmap \(an object of type)289.539 135.6 R F2(pixmap)3.622 +E F0(\),)A(the width and height of the bitmap, and the x and y coordinates of \ +the hotspot.)72 150.6 Q F1(\(write-bitmap-\214le)72 180.6 Q F2 +(\214lename pixmap width height x-hot y-hot)4.583 E F1 112.223(\)p)C -.198(ro) +462.244 180.6 S(cedur).198 E(e)-.198 E F0(See)72 199.2 Q F2(XWriteBitmapF)3.168 +E(ile)-.495 E F0(.)A F2(\214lename)5.918 E F0 .417(is a string or a symbol.) +3.167 F F2(x-hot)5.917 E F0(and)3.167 E F2(y-hot)3.167 E F0 .417 +(are optional \()3.167 F/F4 11/Symbol SF(-)A F0 3.167(1i)C 3.167(su)476.391 +199.2 S(sed)489.337 199.2 Q 1.139(if the)72 214.2 R 3.889(ya)-.165 G 1.139 +(re omitted\), b)110.16 214.2 R 1.14(ut either both or none of them must be gi) +-.22 F -.165(ve)-.275 G(n.).165 E F2(write-bitmap-\214le)6.64 E F0 1.14 +(returns a)3.89 F(symbol \()72 229.2 Q F3(success)A F0(,)A F3(open-failed)2.75 +E F0(,)A F3(file-invalid)2.75 E F0 2.75(,o)C(r)330.808 229.2 Q F3(no-memory) +2.75 E F0(\).)A F1 2.75(8. Graphics)72 259.2 R(Context Functions)2.75 E +(\(gcontext?)72 289.2 Q F2(x)4.583 E F1 322.125(\)p)C -.198(ro)462.244 289.2 S +(cedur).198 E(e)-.198 E F0(Returns #t if)72 307.8 Q(f)-.275 E F2(x)2.75 E F0 +(is an object of type)2.75 E F2(gconte)2.75 E(xt)-.22 E F0(.)A F1 +(\(gcontext-display)72 337.8 Q F2(gconte)4.583 E(xt)-.22 E F1 258.171(\)p)C +-.198(ro)462.244 337.8 S(cedur).198 E(e)-.198 E F0 +(Returns the display associated with the gi)72 356.4 Q -.165(ve)-.275 G 2.75 +(nG).165 G(C.)280.846 356.4 Q F1(\(cr)72 386.4 Q(eate-gcontext)-.198 E F2 2.75 +(.a)4.583 G -.407(rg)163.12 386.4 S(s).407 E F1 275.694(\)p)C -.198(ro)462.244 +386.4 S(cedur).198 E(e)-.198 E F0(See)72 405 Q F2(XCr)2.75 E(eateGC)-.407 E F0 +5.5(.T)C(his function is used to create a ne)157.14 405 Q 2.75(wG)-.275 G(C.) +321.832 405 Q .201(The number of ar)72 423.6 R .201(guments must be e)-.198 F +-.165(ve)-.275 G 2.95(n. The).165 F .2(1st, 3rd, etc. ar)2.95 F .2 +(gument is the name \(a symbol\) of an)-.198 F(attrib)72 438.6 Q .916 +(ute to be set when the graphics conte)-.22 F .917 +(xt is created, the 2nd, 4th, etc. ar)-.165 F .917(gument is the corre-)-.198 F +(sponding v)72 453.6 Q 2.75(alue. The)-.275 F(attrib)2.75 E +(utes can be speci\214ed in an)-.22 E 2.75(yo)-.165 G(rder)318.499 453.6 Q(.) +-.605 E(Attrib)72 472.2 Q .497(utes are)-.22 F F2(window)3.247 E F0 .496 +(\(a dra)3.247 F -.11(wa)-.165 G .496(ble; mandatory\) and all the attrib).11 F +.496(utes that can be set by the)-.22 F F3(set-)3.246 E(gcontext-)72 487.2 Q F2 +(attrib)A(ute)-.22 E F3(!)A F0(functions belo)2.75 E -.715(w.)-.275 G F1 +(\(copy-gcontext)72 517.2 Q F2(gconte)4.583 E(xt dr)-.22 E(awable)-.165 E F1 +225.655(\)p)C -.198(ro)462.244 517.2 S(cedur).198 E(e)-.198 E F0(See)72 535.8 Q +F2(XCopyGC)2.75 E F0 5.5(.R)C(eturns a cop)151.442 535.8 Q 2.75(yo)-.11 G(f) +218.234 535.8 Q F2(gconte)2.75 E(xt)-.22 E F0 +(\(associated with the speci\214ed dra)2.75 E -.11(wa)-.165 G(ble\).).11 E F1 +(\(fr)72 565.8 Q(ee-gcontext)-.198 E F2(gconte)4.583 E(xt)-.22 E F1 273.681 +(\)p)C -.198(ro)462.244 565.8 S(cedur).198 E(e)-.198 E F0(See)72 584.4 Q F2(XF) +2.75 E -.407(re)-.605 G(eGC).407 E F0(.)A F1(\(query-best-size)72 614.4 Q F2 +(display width height shape)4.583 E F1 183.701(\)p)C -.198(ro)462.244 614.4 S +(cedur).198 E(e)-.198 E F0(See)72 633 Q F2(XQueryBestSize)3.159 E F0(.)A F2 +(shape)5.91 E F0 .41(is a symbol \()3.16 F F3(cursor)A F0(,)A F3(tile)3.16 E F0 +3.16(,o)C(r)340.478 633 Q F3(stipple)3.16 E F0 3.16(\). Returns)B 3.16(ap)3.16 +G .41(air of inte-)456.749 633 R(gers \(result width and result height\).)72 +648 Q F1(\(query-best-cursor)72 678 Q F2(display width height)4.583 E F1 +198.672(\)p)C -.198(ro)462.244 678 S(cedur).198 E(e)-.198 E(\(query-best-tile) +72 693 Q F2(display width height)4.583 E F1 214.556(\)p)C -.198(ro)462.244 693 +S(cedur).198 E(e)-.198 E(\(query-best-stipple)72 708 Q F2(display width height) +4.583 E F1 198.045(\)p)C -.198(ro)462.244 708 S(cedur).198 E(e)-.198 E EP +%%Page: 12 12 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(2-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(See)72 87 Q/F1 11/Times-Italic@0 SF(XQueryBestSize)3.262 E F0 6.012 +(.I)C -2.09 -.44(nv o)174.444 87 T -.11(ke).44 G(s).11 E F1(query-best-size) +3.262 E F0 .511(with the gi)3.261 F -.165(ve)-.275 G 3.261(na).165 G -.198(rg) +349.623 87 S .511(uments and a shape of).198 F/F2 11/Courier@0 SF(cursor)3.261 +E F0(,)A F2(tile)72 102 Q F0 2.75(,o)C(r)109.4 102 Q F2(stipple)2.75 E F0 2.75 +(,r)C(especti)171.176 102 Q -.165(ve)-.275 G(ly).165 E(.)-.715 E/F3 11 +/Times-Bold@0 SF(\(gcontext-function)72 132 Q F1(gconte)4.583 E(xt)-.22 E F3 +252.682(\)p)C -.198(ro)462.244 132 S(cedur).198 E(e)-.198 E +(\(gcontext-plane-mask)72 147 Q F1(gconte)4.583 E(xt)-.22 E F3 237.403(\)p)C +-.198(ro)462.244 147 S(cedur).198 E(e)-.198 E(\(gcontext-f)72 162 Q(or)-.275 E +(egr)-.198 E(ound)-.198 E F1(gconte)4.583 E(xt)-.22 E F3 239.306(\)p)C -.198 +(ro)462.244 162 S(cedur).198 E(e)-.198 E(\(gcontext-backgr)72 177 Q(ound)-.198 +E F1(gconte)4.583 E(xt)-.22 E F3 235.148(\)p)C -.198(ro)462.244 177 S(cedur) +.198 E(e)-.198 E(\(gcontext-line-width)72 192 Q F1(gconte)4.583 E(xt)-.22 E F3 +244.124(\)p)C -.198(ro)462.244 192 S(cedur).198 E(e)-.198 E +(\(gcontext-line-style)72 207 Q F1(gconte)4.583 E(xt)-.22 E F3 249.635(\)p)C +-.198(ro)462.244 207 S(cedur).198 E(e)-.198 E(\(gcontext-cap-style)72 222 Q F1 +(gconte)4.583 E(xt)-.22 E F3 250.251(\)p)C -.198(ro)462.244 222 S(cedur).198 E +(e)-.198 E(\(gcontext-join-style)72 237 Q F1(gconte)4.583 E(xt)-.22 E F3 +248.414(\)p)C -.198(ro)462.244 237 S(cedur).198 E(e)-.198 E +(\(gcontext-\214ll-style)72 252 Q F1(gconte)4.583 E(xt)-.22 E F3 254.519(\)p)C +-.198(ro)462.244 252 S(cedur).198 E(e)-.198 E(\(gcontext-\214ll-rule)72 267 Q +F1(gconte)4.583 E(xt)-.22 E F3 256.961(\)p)C -.198(ro)462.244 267 S(cedur).198 +E(e)-.198 E(\(gcontext-ar)72 282 Q(c-mode)-.198 E F1(gconte)4.583 E(xt)-.22 E +F3 247.402(\)p)C -.198(ro)462.244 282 S(cedur).198 E(e)-.198 E(\(gcontext-tile) +72 297 Q F1(gconte)4.583 E(xt)-.22 E F3 277.135(\)p)C -.198(ro)462.244 297 S +(cedur).198 E(e)-.198 E(\(gcontext-stipple)72 312 Q F1(gconte)4.583 E(xt)-.22 E +F3 260.624(\)p)C -.198(ro)462.244 312 S(cedur).198 E(e)-.198 E(\(gcontext-ts-x) +72 327 Q F1(gconte)4.583 E(xt)-.22 E F3 274.693(\)p)C -.198(ro)462.244 327 S +(cedur).198 E(e)-.198 E(\(gcontext-ts-y)72 342 Q F1(gconte)4.583 E(xt)-.22 E F3 +274.693(\)p)C -.198(ro)462.244 342 S(cedur).198 E(e)-.198 E +(\(gcontext-subwindo)72 357 Q(w-mode)-.11 E F1(gconte)4.583 E(xt)-.22 E F3 +209.397(\)p)C -.198(ro)462.244 357 S(cedur).198 E(e)-.198 E(\(gcontext-exposur) +72 372 Q(es)-.198 E F1(gconte)4.583 E(xt)-.22 E F3 245.554(\)p)C -.198(ro) +462.244 372 S(cedur).198 E(e)-.198 E(\(gcontext-clip-x)72 387 Q F1(gconte)4.583 +E(xt)-.22 E F3 265.519(\)p)C -.198(ro)462.244 387 S(cedur).198 E(e)-.198 E +(\(gcontext-clip-y)72 402 Q F1(gconte)4.583 E(xt)-.22 E F3 265.519(\)p)C -.198 +(ro)462.244 402 S(cedur).198 E(e)-.198 E(\(gcontext-dash-offset)72 417 Q F1 +(gconte)4.583 E(xt)-.22 E F3 240.472(\)p)C -.198(ro)462.244 417 S(cedur).198 E +(e)-.198 E F0(See)72 435.6 Q F1(XGetGCV)3.086 E(alues)-1.221 E F0 5.836(.R)C +.337(eturns the logical operation, plane mask, fore)173.498 435.6 R .337 +(ground and background pix)-.165 F(el)-.165 E -.275(va)72 450.6 S 1.128(lue, l\ +ine width and style, cap and join style, \214ll style and rule, arc mode, tili\ +ng and stippling).275 F .47(pixmap, tiling x- and y-origin, subwindo)72 465.6 R +3.22(wm)-.275 G .471(ode, clipping x- and y-origin, and dashed line infor) +272.545 465.6 R(-)-.22 E(mation of the speci\214ed graphics conte)72 480.6 Q +(xt.)-.165 E F1(gconte)72 499.2 Q(xt-function)-.22 E F0 2.124 +(returns a symbol \()4.874 F F2(clear)A F0(,)A F2(and)4.874 E F0(,)A F2 +(and-reverse)4.874 E F0(,)A F2(copy)4.874 E F0(,)A F2(and-inverted)4.874 E F0 +(,)A F2(no-op)72 514.2 Q F0(,)A F2(xor)3.527 E F0(,)A F2(or)3.527 E F0(,)A F2 +(nor)3.527 E F0(,)A F2(equiv)3.527 E F0(,)A F2(invert)3.527 E F0(,)A F2 +(or-reverse)3.527 E F0(,)A F2(copy-inverted)3.528 E F0(,)A F2(nand)3.528 E F0 +3.528(,o)C(r)470.596 514.2 Q F2(set)3.528 E F0(\).)A F1(gconte)72 529.2 Q +(xt-plane-mask)-.22 E F0(,)A F1(gconte)3.504 E(xt-for)-.22 E -.44(eg)-.407 G +-.495(ro).44 G(und).495 E F0 3.504(,a)C(nd)269.682 529.2 Q F1(gconte)3.504 E +(xt-bac)-.22 E(kgr)-.22 E(ound)-.495 E F0 .754(return a pix)3.504 F(el.)-.165 E +F1(gconte)6.253 E(xt-tile)-.22 E F0(and)72 544.2 Q F1(gconte)4.819 E +(xt-stipple)-.22 E F0 2.069(return a pixmap.)4.819 F 2.07 +(The line style is a symbol \()7.569 F F2(solid)A F0(,)A F2(dash)4.82 E F0(,)A +F2(double-)4.82 E(dash)72 559.2 Q F0 .209(\); the cap style is a symbol \()B F2 +(not-last)A F0(,)A F2(butt)2.959 E F0(,)A F2(round)2.959 E F0(,)A F2 +(projecting)2.959 E F0 .208(\); the join style is a)B 2.494(symbol \()72 574.2 +R F2(miter)A F0(,)A F2(round)5.245 E F0(,)A F2(bevel)5.245 E F0 2.495 +(\); the \214ll style is a symbol \()B F2(solid)A F0(,)A F2(tiled)5.245 E F0(,) +A F2(stippled)5.245 E F0(,)A F2(opaque-stippled)72 589.2 Q F0 .194 +(\); the \214ll rule is a symbol \()B F2(even-odd)A F0(,)A F2(winding)2.944 E +F0 .194(\); the arc mode is a sym-)B 5.223(bol \()72 604.2 R F2(chord)A F0(,)A +F2(pie-slice)7.973 E F0 5.223(\); the subwindo)B 5.223(w-mode is a symbol \() +-.275 F F2(clip-by-children)A F0(,)A F2(include-inferiors)72 619.2 Q F0(\).)A +F1(gconte)6.812 E(xt-e)-.22 E(xposur)-.22 E(es)-.407 E F0 1.311 +(returns a boolean.)4.061 F 1.311(All other functions return an)6.811 F(inte)72 +634.2 Q(ger)-.165 E(.)-.605 E F3(\(set-gcontext-function!)72 664.2 Q F1(gconte) +4.583 E(xt value)-.22 E F3 205.954(\)p)C -.198(ro)462.244 664.2 S(cedur).198 E +(e)-.198 E(\(set-gcontext-plane-mask!)72 679.2 Q F1(gconte)4.583 E(xt value) +-.22 E F3 190.675(\)p)C -.198(ro)462.244 679.2 S(cedur).198 E(e)-.198 E +(\(set-gcontext-f)72 694.2 Q(or)-.275 E(egr)-.198 E(ound!)-.198 E F1(gconte) +4.583 E(xt value)-.22 E F3 192.578(\)p)C -.198(ro)462.244 694.2 S(cedur).198 E +(e)-.198 E(\(set-gcontext-backgr)72 709.2 Q(ound!)-.198 E F1(gconte)4.583 E +(xt value)-.22 E F3 188.42(\)p)C -.198(ro)462.244 709.2 S(cedur).198 E(e)-.198 +E(\(set-gcontext-line-width!)72 724.2 Q F1(gconte)4.583 E(xt value)-.22 E F3 +197.396(\)p)C -.198(ro)462.244 724.2 S(cedur).198 E(e)-.198 E EP +%%Page: 13 13 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(3-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(set-gcontext-line-style!)72 87 Q/F2 11 +/Times-Italic@0 SF(gconte)4.583 E(xt value)-.22 E F1 202.907(\)p)C -.198(ro) +462.244 87 S(cedur).198 E(e)-.198 E(\(set-gcontext-cap-style!)72 102 Q F2 +(gconte)4.583 E(xt value)-.22 E F1 203.523(\)p)C -.198(ro)462.244 102 S(cedur) +.198 E(e)-.198 E(\(set-gcontext-join-style!)72 117 Q F2(gconte)4.583 E +(xt value)-.22 E F1 201.686(\)p)C -.198(ro)462.244 117 S(cedur).198 E(e)-.198 E +(\(set-gcontext-\214ll-style!)72 132 Q F2(gconte)4.583 E(xt value)-.22 E F1 +207.791(\)p)C -.198(ro)462.244 132 S(cedur).198 E(e)-.198 E +(\(set-gcontext-\214ll-rule!)72 147 Q F2(gconte)4.583 E(xt value)-.22 E F1 +210.233(\)p)C -.198(ro)462.244 147 S(cedur).198 E(e)-.198 E(\(set-gcontext-ar) +72 162 Q(c-mode!)-.198 E F2(gconte)4.583 E(xt value)-.22 E F1 200.674(\)p)C +-.198(ro)462.244 162 S(cedur).198 E(e)-.198 E(\(set-gcontext-tile!)72 177 Q F2 +(gconte)4.583 E(xt value)-.22 E F1 230.407(\)p)C -.198(ro)462.244 177 S(cedur) +.198 E(e)-.198 E(\(set-gcontext-stipple!)72 192 Q F2(gconte)4.583 E(xt value) +-.22 E F1 213.896(\)p)C -.198(ro)462.244 192 S(cedur).198 E(e)-.198 E +(\(set-gcontext-ts-x!)72 207 Q F2(gconte)4.583 E(xt value)-.22 E F1 227.965 +(\)p)C -.198(ro)462.244 207 S(cedur).198 E(e)-.198 E(\(set-gcontext-ts-y!)72 +222 Q F2(gconte)4.583 E(xt value)-.22 E F1 227.965(\)p)C -.198(ro)462.244 222 S +(cedur).198 E(e)-.198 E(\(set-gcontext-f)72 237 Q(ont!)-.275 E F2(gconte)4.583 +E(xt value)-.22 E F1 226.403(\)p)C -.198(ro)462.244 237 S(cedur).198 E(e)-.198 +E(\(set-gcontext-subwindo)72 252 Q(w-mode!)-.11 E F2(gconte)4.583 E(xt value) +-.22 E F1 162.669(\)p)C -.198(ro)462.244 252 S(cedur).198 E(e)-.198 E +(\(set-gcontext-exposur)72 267 Q(es!)-.198 E F2(gconte)4.583 E(xt value)-.22 E +F1 198.826(\)p)C -.198(ro)462.244 267 S(cedur).198 E(e)-.198 E +(\(set-gcontext-clip-x!)72 282 Q F2(gconte)4.583 E(xt value)-.22 E F1 218.791 +(\)p)C -.198(ro)462.244 282 S(cedur).198 E(e)-.198 E(\(set-gcontext-clip-y!)72 +297 Q F2(gconte)4.583 E(xt value)-.22 E F1 218.791(\)p)C -.198(ro)462.244 297 S +(cedur).198 E(e)-.198 E(\(set-gcontext-clip-mask!)72 312 Q F2(gconte)4.583 E +(xt value)-.22 E F1 199.233(\)p)C -.198(ro)462.244 312 S(cedur).198 E(e)-.198 E +(\(set-gcontext-dash-offset!)72 327 Q F2(gconte)4.583 E(xt value)-.22 E F1 +193.744(\)p)C -.198(ro)462.244 327 S(cedur).198 E(e)-.198 E F0(See)72 345.6 Q +F2(XChang)2.835 E(eGC)-.11 E F0 5.586(.S)C .086 +(ets the logical operation, plane mask, fore)161.282 345.6 R .086 +(ground and background pix)-.165 F .086(el v)-.165 F(alue,)-.275 E .572(line w\ +idth and style, cap and join style, \214ll style and rule, arc mode, tiling an\ +d stippling pixmap,)72 360.6 R 2.086(tiling x- and y-origin, font, subwindo)72 +375.6 R 4.836(wm)-.275 G 2.087 +(ode, clipping x- and y-origin, clipping bitmap, and)266.962 375.6 R +(dashed line information for the speci\214ed graphics conte)72 390.6 Q(xt.) +-.165 E(The)72 409.2 Q F2(value)3.945 E F0(ar)3.945 E 1.195(gument to)-.198 F +F2(set-gconte)3.945 E(xt-font!)-.22 E F0 1.195(is a font, and the)3.945 F F2 +(value)3.944 E F0(ar)3.944 E 1.194(gument to)-.198 F F2(set-gconte)3.944 E +(xt-clip-)-.22 E(mask!)72 424.2 Q F0 .359(is a pixmap.)5.859 F -.165(Fo)5.859 G +3.109(rt).165 G .359(he types of the)185.456 424.2 R F2(value)3.109 E F0(ar) +3.109 E .359(gument of the other functions see the return v)-.198 F(al-)-.275 E +(ues of the)72 439.2 Q F2(gconte)2.75 E(xt-)-.22 E F0(functions abo)2.75 E +-.165(ve)-.165 G(.).165 E F1(\(set-gcontext-clip-r)72 469.2 Q(ectangles!)-.198 +E F2(gconte)4.583 E(xt x y r)-.22 E(ectangles or)-.407 E(dering)-.407 E F1 +99.133(\)p)C -.198(ro)462.244 469.2 S(cedur).198 E(e)-.198 E F0(See)72 487.8 Q +F2(XSetClipRectangles)3.761 E F0(.)A F2(x)6.51 E F0(and)3.76 E F2(y)3.76 E F0 +1.01(are inte)3.76 F 1.01(gers \(the coordinates of the clip-mask origin\).) +-.165 F F2 -.407(re)6.51 G(ctan-).407 E(gles)72 502.8 Q F0 .72(is a v)3.47 F +.72(ector of lists of four inte)-.165 F .721(gers \(x, y)-.165 F 3.471(,w)-.715 +G .721(idth, and height of each rectangle\).)283.875 502.8 R F2(or)6.221 E +(dering)-.407 E F0 .721(is a)3.471 F(symbol \()72 517.8 Q/F3 11/Courier@0 SF +(unsorted)A F0(,)A F3(y-sorted)2.75 E F0(,)A F3(yx-sorted)2.75 E F0 2.75(,o)C +(r)297.808 517.8 Q F3(yx-banded)2.75 E F0(\).)A F1(\(set-gcontext-dashlist!)72 +547.8 Q F2(gconte)4.583 E(xt dash-of)-.22 E(fset dash-list)-.198 E F1 144.101 +(\)p)C -.198(ro)462.244 547.8 S(cedur).198 E(e)-.198 E F0(See)72 566.4 Q F2 +(XSetDashes)2.75 E F0(.)A F2(dash-of)5.5 E(fset)-.198 E F0(is an inte)2.75 E +(ger)-.165 E(.)-.605 E F2(dash-list)5.5 E F0(is a v)2.75 E(ector of inte)-.165 +E(gers between 0 and 255.)-.165 E F1 2.75(9. Graphics)72 596.4 R(Functions)2.75 +E(\(clear)72 626.4 Q(-ar)-.407 E(ea)-.198 E F2(window x y width height e)4.583 +E(xposur)-.22 E(es?)-.407 E F1 166.618(\)p)C -.198(ro)462.244 626.4 S(cedur) +.198 E(e)-.198 E F0(See)72 645 Q F2(XClearAr)2.75 E(ea)-.407 E F0(.)A F1 +(\(copy-ar)72 675 Q(ea)-.198 E F2(sr)4.583 E(c-dr)-.407 E(awable gconte)-.165 E +(xt sr)-.22 E(c-x sr)-.407 E(c-y width height dst-dr)-.407 E +(awable dst-x dst-y)-.165 E F1 13.069(\)p)C -.198(ro)462.244 675 S(cedur).198 E +(e)-.198 E F0(See)72 693.6 Q F2(XCopyAr)2.75 E(ea)-.407 E F0(.)A EP +%%Page: 14 14 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(4-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(copy-plane)72 87 Q/F2 11/Times-Italic@0 SF +(sr)4.583 E(c-dr)-.407 E(awable gconte)-.165 E(xt plane sr)-.22 E(c-x sr)-.407 +E(c-y width height dst-dr)-.407 E(awable dst-x dst-y)-.165 E F1 -19.227(\)p)C +-.198(ro)462.244 87 S(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2(XCopyPlane) +2.75 E F0(.)A F2(plane)5.5 E F0(is an inte)2.75 E(ger)-.165 E 5.5(.A)-.605 G +2.75(ne)250.871 105.6 S(rror is signaled unless e)264.005 105.6 Q +(xactly one bit is set in)-.165 E F2(plane)2.75 E F0(.)A F1(\(draw-point)72 +135.6 Q F2(dr)4.583 E(awable gconte)-.165 E(xt x y)-.22 E F1 223.202(\)p)C +-.198(ro)462.244 135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q F2(XDr)2.75 E +(awP)-.165 E(oint)-.88 E F0(.)A F1(\(draw-points)72 184.2 Q F2(dr)4.583 E +(awable gconte)-.165 E(xt vector)-.22 E(-of-points r)-.22 E(elative?)-.407 E F1 +119.945(\)p)C -.198(ro)462.244 184.2 S(cedur).198 E(e)-.198 E F0(See)72 202.8 Q +F2(XDr)4.188 E(awP)-.165 E(oints)-.88 E F0(.)A F2(vector)6.938 E(-of-points) +-.22 E F0 1.437(is a v)4.187 F 1.437(ector of pairs consisting of tw)-.165 F +4.187(oi)-.11 G(nte)411.66 202.8 Q 1.437(gers \(the x and y)-.165 F 3.2 +(coordinates\). If)72 217.8 R F2 -.407(re)3.2 G(lative?).407 E F0 .451(is #t,) +3.2 F F2(Coor)3.201 E(dModePr)-.407 E -.165(ev)-.407 G(ious).165 E F0 .451 +(is passed to)3.201 F F2(XDr)3.201 E(awP)-.165 E(oints)-.88 E F0 3.201(,o)C +(therwise)432.159 217.8 Q F2(Coor)3.201 E(d-)-.407 E(ModeOrigin)72 232.8 Q F0 +(is used.)2.75 E F1(\(draw-line)72 262.8 Q F2(dr)4.583 E(awable gconte)-.165 E +(xt x1 y1 x2 y2)-.22 E F1 193.271(\)p)C -.198(ro)462.244 262.8 S(cedur).198 E +(e)-.198 E F0(See)72 281.4 Q F2(XDr)2.75 E(awLine)-.165 E F0(.)A F1 +(\(draw-lines)72 311.4 Q F2(dr)4.583 E(awable gconte)-.165 E(xt vector)-.22 E +(-of-points r)-.22 E(elative?)-.407 E F1 127.282(\)p)C -.198(ro)462.244 311.4 S +(cedur).198 E(e)-.198 E F0(See)72 330 Q F2(XDr)2.75 E(awLines)-.165 E F0 5.5 +(.S)C(ee)160.451 330 Q F2(dr)2.75 E(aw-points)-.165 E F0(abo)2.75 E -.165(ve) +-.165 G(.).165 E F1(\(draw-segments)72 360 Q F2(dr)4.583 E(awable gconte)-.165 +E(xt vector)-.22 E(-of-points)-.22 E F1 147.357(\)p)C -.198(ro)462.244 360 S +(cedur).198 E(e)-.198 E F0(See)72 378.6 Q F2(XDr)2.75 E(awSe)-.165 E(gments) +-.44 E F0(.)A F2(vector)5.5 E(-of-points)-.22 E F0(is a v)2.75 E +(ector of lists of four inte)-.165 E(gers \(x1, y1, x2, and y2\).)-.165 E F1 +(\(draw-r)72 408.6 Q(ectangle)-.198 E F2(dr)4.583 E(awable gconte)-.165 E +(xt x y width height)-.22 E F1 147.027(\)p)C -.198(ro)462.244 408.6 S(cedur) +.198 E(e)-.198 E F0(See)72 427.2 Q F2(XDr)2.75 E(awRectangle)-.165 E F0(.)A F1 +(\(\214ll-r)72 457.2 Q(ectangle)-.198 E F2(dr)4.583 E(awable gconte)-.165 E +(xt x y width height)-.22 E F1 159.237(\)p)C -.198(ro)462.244 457.2 S(cedur) +.198 E(e)-.198 E F0(See)72 475.8 Q F2(XF)2.75 E(illRectangle)-.495 E F0(.)A F1 +(\(draw-r)72 505.8 Q(ectangles)-.198 E F2(dr)4.583 E(awable gconte)-.165 E +(xt vector)-.22 E(-of-r)-.22 E(ectangles)-.407 E F1 124.147(\)p)C -.198(ro) +462.244 505.8 S(cedur).198 E(e)-.198 E F0(See)72 524.4 Q F2(XDr)3.603 E +(awRectangles)-.165 E F0(.)A F2(vector)6.353 E(-of-r)-.22 E(ectangles)-.407 E +F0 .853(is a v)3.603 F .852(ector of lists of four inte)-.165 F .852 +(gers \(x, y)-.165 F 3.602(,w)-.715 G .852(idth, and)464.648 524.4 R +(height of each rectangle\).)72 539.4 Q F1(\(\214ll-r)72 569.4 Q(ectangles) +-.198 E F2(dr)4.583 E(awable gconte)-.165 E(xt vector)-.22 E(-of-r)-.22 E +(ectangles)-.407 E F1 136.357(\)p)C -.198(ro)462.244 569.4 S(cedur).198 E(e) +-.198 E F0(See)72 588 Q F2(XF)2.75 E(illRectangles)-.495 E F0 5.5(.S)C(ee) +175.389 588 Q F2(dr)2.75 E(aw-r)-.165 E(ectangles)-.407 E F0(abo)2.75 E -.165 +(ve)-.165 G(.).165 E F1(\(draw-ar)72 618 Q(c)-.198 E F2(dr)4.583 E +(awable gconte)-.165 E(xt x y width height angle1 angle2)-.22 E F1 109.748(\)p) +C -.198(ro)462.244 618 S(cedur).198 E(e)-.198 E F0(See)72 636.6 Q F2(XDr)2.75 E +(awAr)-.165 E(c)-.407 E F0(.)A F1(\(\214ll-ar)72 666.6 Q(c)-.198 E F2(dr)4.583 +E(awable gconte)-.165 E(xt x y width height angle1 angle2)-.22 E F1 121.958 +(\)p)C -.198(ro)462.244 666.6 S(cedur).198 E(e)-.198 E F0(See)72 685.2 Q F2(XF) +2.75 E(illAr)-.495 E(c)-.407 E F0(.)A EP +%%Page: 15 15 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(5-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(draw-ar)72 87 Q(cs)-.198 E/F2 11 +/Times-Italic@0 SF(dr)4.583 E(awable gconte)-.165 E(xt vector)-.22 E(-of-data) +-.22 E F1 178.113(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 E F0(See)72 +105.6 Q F2(XDr)2.998 E(awAr)-.165 E(cs)-.407 E F0(.)A F2(vector)5.748 E +(-of-data)-.22 E F0 .248(is a v)2.998 F .248(ector of lists of six inte)-.165 F +.248(gers \(x, y)-.165 F 2.998(,w)-.715 G .248(idth, height, angle1, and)396.93 +105.6 R(angle2\).)72 120.6 Q F1(\(\214ll-ar)72 150.6 Q(cs)-.198 E F2(dr)4.583 E +(awable gconte)-.165 E(xt vector)-.22 E(-of-data)-.22 E F1 190.323(\)p)C -.198 +(ro)462.244 150.6 S(cedur).198 E(e)-.198 E F0(See)72 169.2 Q F2(XF)2.75 E +(illAr)-.495 E(cs)-.407 E F0 5.5(.S)C(ee)146.877 169.2 Q F2(dr)2.75 E(aw-ar) +-.165 E(cs)-.407 E F0(abo)2.75 E -.165(ve)-.165 G(.).165 E F1(\(\214ll-polygon) +72 199.2 Q F2(dr)4.583 E(awable gconte)-.165 E(xt vector)-.22 E(-of-points r) +-.22 E(elative? shape)-.407 E F1 95.184(\)p)C -.198(ro)462.244 199.2 S(cedur) +.198 E(e)-.198 E F0(See)72 217.8 Q F2(XF)4.689 E(illP)-.495 E(olygon)-.88 E F0 +7.439(.S)C(ee)166.782 217.8 Q F2(dr)4.689 E(aw-points)-.165 E F0(abo)4.689 E +-.165(ve)-.165 G(.).165 E F2(shape)7.439 E F0 1.939(is a symbol \()4.689 F/F3 +11/Courier@0 SF(complex)A F0(,)A F3(non-convex)4.688 E F0 4.688(,o)C(r)500.337 +217.8 Q F3(convex)72 232.8 Q F0(\).)A F1 2.75(10. F)72 262.8 R(ont Functions) +-.275 E(\(f)72 292.8 Q(ont?)-.275 E F2(x)4.583 E F1 343.168(\)p)C -.198(ro) +462.244 292.8 S(cedur).198 E(e)-.198 E F0(Returns #t if)72 311.4 Q(f)-.275 E F2 +(x)2.75 E F0(is an object of type)2.75 E F2(font)2.75 E F0(.)A F1(\(f)72 341.4 +Q -.917(ont-display \))-.275 F(pr)456.128 341.4 Q(ocedur)-.198 E(e)-.198 E F0 +(Returns the display associated with the gi)72 360 Q -.165(ve)-.275 G 2.75(nf) +.165 G(ont.)276.567 360 Q F1(\(open-f)72 390 Q(ont)-.275 E F2 +(display font-name)4.583 E F1 248.139(\)p)C -.198(ro)462.244 390 S(cedur).198 E +(e)-.198 E F0(See)72 408.6 Q F2(XLoadQueryF)2.75 E(ont)-1.155 E F0(.)A F2 +(font-name)5.5 E F0(is a string or a symbol.)2.75 E F1(\(close-f)72 438.6 Q +(ont)-.275 E F2(font)4.583 E F1 310.168(\)p)C -.198(ro)462.244 438.6 S(cedur) +.198 E(e)-.198 E F0(See)72 457.2 Q F2(XUnloadF)2.75 E(ont)-1.155 E F0(.)A F1 +(\(f)72 487.2 Q(ont-name)-.275 E F2(font)4.583 E F1 307.11(\)p)C -.198(ro) +462.244 487.2 S(cedur).198 E(e)-.198 E F0 .68(Returns the name of the speci\ +\214ed font \(a string\) or #f if the name could not be determined \(e.)72 +505.8 R(g.)1.833 E(when the font has been obtained by a call to)72 520.8 Q F2 +(gconte)2.75 E(xt-font)-.22 E F0(\).)A F1(\(gcontext-f)72 550.8 Q(ont)-.275 E +F2(gconte)4.583 E(xt)-.22 E F1 273.131(\)p)C -.198(ro)462.244 550.8 S(cedur) +.198 E(e)-.198 E F0(Calls)72 569.4 Q F2(XQueryF)3.198 E(ont)-1.155 E F0 .448 +(with the GC obtained by)3.198 F F2(XGConte)3.197 E(xtF)-.22 E -.495(ro)-.605 G +(mGC).495 E F0 5.947(.O)C .447(nly a limited number of func-)371.921 569.4 R +(tions can be applied to a font returned by)72 584.4 Q F2(gconte)2.75 E +(xt-font)-.22 E F0 2.75(,s)C(ince it has neither a name nor a font-ID.)322.602 +584.4 Q F1(\(list-f)72 614.4 Q(ont-names)-.275 E F2(display pattern)4.583 E F1 +235.918(\)p)C -.198(ro)462.244 614.4 S(cedur).198 E(e)-.198 E F0(See)72 633 Q +F2(XListF)2.75 E(onts)-1.155 E F0(.)A F2(pattern)5.5 E F0 +(is a string or a symbol.)2.75 E(Returns a v)5.5 E +(ector of font names \(strings\).)-.165 E F1(\(list-f)72 663 Q(onts)-.275 E F2 +(display pattern)4.583 E F1 265.244(\)p)C -.198(ro)462.244 663 S(cedur).198 E +(e)-.198 E F0(See)72 681.6 Q F2(XListF)3.548 E(ontsW)-1.155 E(ithInfo)-.605 E +F0(.)A F2(pattern)6.298 E F0 .798(is a string or a symbol.)3.548 F .799 +(Returns a v)6.298 F .799(ector of fonts.)-.165 F .799(These fonts)6.299 F +1.746(are `)72 696.6 R 1.746(`pseudo fonts')-.814 F 4.495('w)-.814 G 1.745 +(hich do not ha)173.047 696.6 R 2.075 -.165(ve a f)-.22 H 4.495(ont-ID. A).165 +F 1.745(pseudo font is loaded automatically and)4.495 F(turned into a `)72 +711.6 Q(`real')-.814 E 2.75('f)-.814 G +(ont the \214rst time it is passed to a function that mak)166.281 711.6 Q +(es use of the font-ID.)-.11 E EP +%%Page: 16 16 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(6-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(f)72 87 Q(ont-dir)-.275 E(ection)-.198 E/F2 +11/Times-Italic@0 SF(font)4.583 E F1 290.808(\)p)C -.198(ro)462.244 87 S(cedur) +.198 E(e)-.198 E(\(f)72 102 Q(ont-min-byte2)-.275 E F2(font)4.583 E F1 285.11 +(\)p)C -.198(ro)462.244 102 S(cedur).198 E(e)-.198 E(\(f)72 117 Q +(ont-max-byte2)-.275 E F2(font)4.583 E F1 283.284(\)p)C -.198(ro)462.244 117 S +(cedur).198 E(e)-.198 E(\(f)72 132 Q(ont-min-byte1)-.275 E F2(font)4.583 E F1 +285.11(\)p)C -.198(ro)462.244 132 S(cedur).198 E(e)-.198 E(\(f)72 147 Q +(ont-max-byte1)-.275 E F2(font)4.583 E F1 283.284(\)p)C -.198(ro)462.244 147 S +(cedur).198 E(e)-.198 E(\(f)72 162 Q(ont-all-chars-exist?)-.275 E F2(font)4.583 +E F1 261.284(\)p)C -.198(ro)462.244 162 S(cedur).198 E(e)-.198 E(\(f)72 177 Q +(ont-default-char)-.275 E F2(font)4.583 E F1 274.726(\)p)C -.198(ro)462.244 177 +S(cedur).198 E(e)-.198 E(\(f)72 192 Q(ont-ascent)-.275 E F2(font)4.583 E F1 +303.447(\)p)C -.198(ro)462.244 192 S(cedur).198 E(e)-.198 E(\(f)72 207 Q +(ont-descent)-.275 E F2(font)4.583 E F1 297.947(\)p)C -.198(ro)462.244 207 S +(cedur).198 E(e)-.198 E F0 .066 +(These functions return the font direction as a symbol \()72 225.6 R/F3 11 +/Courier@0 SF(left-to-right)A F0(or)2.816 E F3(right-to-left)2.816 E F0(\),)A +.2(the \214rst and last character \(as an inte)72 240.6 R .2 +(ger\), the \214rst and last ro)-.165 F 2.95(w\()-.275 G(inte)354.594 240.6 Q +.199(ger\), an indication whether all)-.165 F 2.966(characters ha)72 255.6 R +3.296 -.165(ve n)-.22 H 2.966(on-zero size \(boolean\), the def).165 F 2.966 +(ault character \(inte)-.11 F 2.966(ger\), and the ascent and)-.165 F +(descent \(inte)72 270.6 Q(ger\) of the speci\214ed font.)-.165 E F1(\(char)72 +300.6 Q(-rbearing)-.407 E F2(font inde)4.583 E(x)-.22 E F1 263.165(\)p)C -.198 +(ro)462.244 300.6 S(cedur).198 E(e)-.198 E(\(char)72 315.6 Q(-lbearing)-.407 E +F2(font inde)4.583 E(x)-.22 E F1 264.991(\)p)C -.198(ro)462.244 315.6 S(cedur) +.198 E(e)-.198 E(\(char)72 330.6 Q(-width)-.407 E F2(font inde)4.583 E(x)-.22 E +F1 277.212(\)p)C -.198(ro)462.244 330.6 S(cedur).198 E(e)-.198 E(\(char)72 +345.6 Q(-ascent)-.407 E F2(font inde)4.583 E(x)-.22 E F1 274.781(\)p)C -.198 +(ro)462.244 345.6 S(cedur).198 E(e)-.198 E(\(char)72 360.6 Q(-descent)-.407 E +F2(font inde)4.583 E(x)-.22 E F1 269.281(\)p)C -.198(ro)462.244 360.6 S(cedur) +.198 E(e)-.198 E F0 .074 +(These functions return the metrics of the character speci\214ed by the inte)72 +379.2 R(ger)-.165 E F2(inde)2.823 E(x)-.22 E F0 .073(of the gi)2.823 F -.165 +(ve)-.275 G 2.823(nf).165 G(ont.)487.192 379.2 Q(Each function returns an inte) +72 394.2 Q(ger)-.165 E(.)-.605 E F2(font)5.5 E F0 +(can be a 1-byte as well as a 2-byte font.)2.75 E F1(\(max-char)72 424.2 Q +(-lbearing)-.407 E F2(font)4.583 E F1 267.521(\)p)C -.198(ro)462.244 424.2 S +(cedur).198 E(e)-.198 E(\(max-char)72 439.2 Q(-rbearing)-.407 E F2(font)4.583 E +F1 265.695(\)p)C -.198(ro)462.244 439.2 S(cedur).198 E(e)-.198 E(\(max-char)72 +454.2 Q(-width)-.407 E F2(font)4.583 E F1 279.742(\)p)C -.198(ro)462.244 454.2 +S(cedur).198 E(e)-.198 E(\(max-char)72 469.2 Q(-ascent)-.407 E F2(font)4.583 E +F1 277.311(\)p)C -.198(ro)462.244 469.2 S(cedur).198 E(e)-.198 E(\(max-char)72 +484.2 Q(-descent)-.407 E F2(font)4.583 E F1 271.811(\)p)C -.198(ro)462.244 +484.2 S(cedur).198 E(e)-.198 E F0 .375 +(These functions return the maximum metrics o)72 502.8 R -.165(ve)-.165 G 3.125 +(ra).165 G .376(ll characters in the speci\214ed font.)301.896 502.8 R .376 +(Each func-)5.876 F(tion returns an inte)72 517.8 Q(ger)-.165 E(.)-.605 E F1 +(\(min-char)72 547.8 Q(-lbearing)-.407 E F2(font)4.583 E F1 269.347(\)p)C -.198 +(ro)462.244 547.8 S(cedur).198 E(e)-.198 E(\(min-char)72 562.8 Q(-rbearing) +-.407 E F2(font)4.583 E F1 267.521(\)p)C -.198(ro)462.244 562.8 S(cedur).198 E +(e)-.198 E(\(min-char)72 577.8 Q(-width)-.407 E F2(font)4.583 E F1 281.568(\)p) +C -.198(ro)462.244 577.8 S(cedur).198 E(e)-.198 E(\(min-char)72 592.8 Q +(-ascent)-.407 E F2(font)4.583 E F1 279.137(\)p)C -.198(ro)462.244 592.8 S +(cedur).198 E(e)-.198 E(\(min-char)72 607.8 Q(-descent)-.407 E F2(font)4.583 E +F1 273.637(\)p)C -.198(ro)462.244 607.8 S(cedur).198 E(e)-.198 E F0 .506 +(These functions return the minimum metrics o)72 626.4 R -.165(ve)-.165 G 3.256 +(ra).165 G .506(ll characters in the speci\214ed font.)300.987 626.4 R .505 +(Each func-)6.005 F(tion returns an inte)72 641.4 Q(ger)-.165 E(.)-.605 E F1 +(\(f)72 671.4 Q(ont-pr)-.275 E(operties)-.198 E F2(font)4.583 E F1 284.703(\)p) +C -.198(ro)462.244 671.4 S(cedur).198 E(e)-.198 E F0 .362(Returns a v)72 690 R +.363(ector of font properties; each element of the v)-.165 F .363 +(ector is a pair consisting of the property)-.165 F +(name \(an atom\) and an unsigned inte)72 705 Q(ger \(the v)-.165 E +(alue of the property\).)-.275 E EP +%%Page: 17 17 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(7-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(f)72 87 Q(ont-pr)-.275 E(operty)-.198 E/F2 +11/Times-Italic@0 SF(font pr)4.583 E(operty-name)-.495 E F1 223.796(\)p)C -.198 +(ro)462.244 87 S(cedur).198 E(e)-.198 E F0 .406(Returns the v)72 105.6 R .405 +(alue of the speci\214ed property associated with the speci\214ed font.)-.275 F +F2(pr)5.905 E(operty-name)-.495 E F0 .405(is a)3.155 F(string or a symbol.)72 +120.6 Q F1(\(f)72 150.6 Q(ont-path)-.275 E F2(display)4.583 E F1 296.715(\)p)C +-.198(ro)462.244 150.6 S(cedur).198 E(e)-.198 E F0(See)72 169.2 Q F2(XGetF)2.75 +E(ontP)-1.155 E(ath)-.88 E F0 5.5(.R)C(eturns the current font path as a v) +168.349 169.2 Q(ector of strings.)-.165 E F1(\(set-f)72 199.2 Q(ont-path!)-.275 +E F2(display path)4.583 E F1 254.255(\)p)C -.198(ro)462.244 199.2 S(cedur).198 +E(e)-.198 E F0(See)72 217.8 Q F2(XSetF)2.75 E(ontP)-1.155 E(ath)-.88 E F0(.)A +F2(path)5.5 E F0(is a list; each element is a string or a symbol.)2.75 E F1 +2.75(11. T)72 247.8 R(ext Metrics and T)-1.012 E(ext Drawing Functions)-1.012 E +(\(text-width)72 277.8 Q F2(font te)4.583 E(xt format)-.22 E F1 256.334(\)p)C +-.198(ro)462.244 277.8 S(cedur).198 E(e)-.198 E F0(See)72 296.4 Q F2(XT)3.654 E +-.22(ex)-1.012 G(tW).22 E(idth)-.605 E F0(,)A F2(XT)3.655 E -.22(ex)-1.012 G +(tW).22 E(idth16)-.605 E F0(.)A F2(format)6.405 E F0 .905 +(indicates whether 8-bit or 16-bit te)3.655 F .905(xt is used; it is either) +-.165 F 1.051(the symbol)72 311.4 R/F3 11/Courier@0 SF(1-byte)3.801 E F0 1.051 +(or the symbol)3.801 F F3(2-byte)3.801 E F0(.)A F2(te)6.551 E(xt)-.22 E F0 +1.051(is a v)3.801 F 1.051(ector of inte)-.165 F 1.051(gers; the inte)-.165 F +1.051(gers must not)-.165 F -.165(ex)72 326.4 S +(ceed the size indicated by the format.).165 E F1(\(extents-lbearing)72 356.4 Q +F2(font te)4.583 E(xt format)-.22 E F1 228.834(\)p)C -.198(ro)462.244 356.4 S +(cedur).198 E(e)-.198 E(\(extents-rbearing)72 371.4 Q F2(font te)4.583 E +(xt format)-.22 E F1 227.008(\)p)C -.198(ro)462.244 371.4 S(cedur).198 E(e) +-.198 E(\(extents-width)72 386.4 Q F2(font te)4.583 E(xt format)-.22 E F1 +241.055(\)p)C -.198(ro)462.244 386.4 S(cedur).198 E(e)-.198 E(\(extents-ascent) +72 401.4 Q F2(font te)4.583 E(xt format)-.22 E F1 238.624(\)p)C -.198(ro) +462.244 401.4 S(cedur).198 E(e)-.198 E(\(extents-descent)72 416.4 Q F2(font te) +4.583 E(xt format)-.22 E F1 233.124(\)p)C -.198(ro)462.244 416.4 S(cedur).198 E +(e)-.198 E F0(See)72 435 Q F2(XT)3.107 E -.22(ex)-1.012 G(tExtents).22 E F0(,)A +F2(XT)3.107 E -.22(ex)-1.012 G(tExtents16).22 E F0 5.857(.T)C .358 +(hese functions are used to compute the o)236.806 435 R -.165(ve)-.165 G .358 +(rall metrics of an).165 F .699(8-bit or 16-bit character string.)72 450 R .699 +(Each function returns an inte)6.199 F(ger)-.165 E 6.199(.F)-.605 G .699 +(or the format of)374.384 450 R F2(te)3.449 E(xt)-.22 E F0(and)3.449 E F2(for) +3.449 E(-)-.22 E(mat)72 465 Q F0(see)2.75 E F2(te)2.75 E(xt-width)-.22 E F0 +(abo)2.75 E -.165(ve)-.165 G(.).165 E F1(\(draw-image-text)72 495 Q F2(dr)4.583 +E(awable gconte)-.165 E(xt x y te)-.22 E(xt format)-.22 E F1 147.676(\)p)C +-.198(ro)462.244 495 S(cedur).198 E(e)-.198 E F0(See)72 513.6 Q F2(XDr)2.75 E +(awIma)-.165 E -.11(ge)-.11 G(String).11 E F0(,)A F2(XDr)2.75 E(awIma)-.165 E +-.11(ge)-.11 G(String16).11 E F0 5.5(.S)C(ee)293.056 513.6 Q F2(te)2.75 E +(xt-width)-.22 E F0(abo)2.75 E -.165(ve)-.165 G(.).165 E F1(\(draw-poly-text)72 +543.6 Q F2(dr)4.583 E(awable gconte)-.165 E(xt x y te)-.22 E(xt format)-.22 E +F1 155.607(\)p)C -.198(ro)462.244 543.6 S(cedur).198 E(e)-.198 E F0(See)72 +562.2 Q F2(XDr)3.155 E(awT)-.165 E -.22(ex)-1.012 G(t).22 E F0(,)A F2(XDr)3.156 +E(awT)-.165 E -.22(ex)-1.012 G(t16).22 E F0 5.906(.S)C(ee)221.365 562.2 Q F2 +(te)3.156 E(xt-width)-.22 E F0(abo)3.156 E -.165(ve)-.165 G(.).165 E F2(te) +5.906 E(xt)-.22 E F0 .406(is a v)3.156 F .406(ector of inte)-.165 F .406 +(gers with intermix)-.165 F(ed)-.165 E(objects of type)72 577.2 Q F2(font)2.75 +E F0(.)A F1(\(translate-text)72 607.2 Q F2(string)4.583 E F1 283.625(\)p)C +-.198(ro)462.244 607.2 S(cedur).198 E(e)-.198 E F0(Con)72 625.8 Q -.165(ve)-.44 +G .008(rts the string into a representation suitable as an ar).165 F .007 +(gument to)-.198 F F2(te)2.757 E(xt-width)-.22 E F0(,)A F2(dr)2.757 E(aw-ima) +-.165 E -.11(ge)-.11 G(-te).11 E(xt)-.22 E F0 2.757(,o)C(r)500.337 625.8 Q F2 +(dr)72 640.8 Q(aw-poly-te)-.165 E(xt)-.22 E F0 .886(\(a v)3.636 F .886 +(ector of inte)-.165 F .886(gers obtained by applying)-.165 F F2 -.165(ch)3.637 +G(ar).165 E/F4 11/Symbol SF(-)A F2(>inte)A -.11(ge)-.44 G(r).11 E F0 .887 +(to the characters of the)3.637 F(string ar)72 655.8 Q(gument\).)-.198 E EP +%%Page: 18 18 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(8-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(12. Cursor)72 87 R(Functions)2.75 E +(\(cursor?)72 117 Q/F2 11/Times-Italic@0 SF(x)4.583 E F1 331.288(\)p)C -.198 +(ro)462.244 117 S(cedur).198 E(e)-.198 E F0(Returns #t if)72 135.6 Q(f)-.275 E +F2(x)2.75 E F0(is an object of type)2.75 E F2(cur)2.75 E(sor)-.11 E F0(.)A F1 +(\(cursor)72 165.6 Q(-display)-.407 E F2(cur)4.583 E(sor)-.11 E F1 276.178(\)p) +C -.198(ro)462.244 165.6 S(cedur).198 E(e)-.198 E F0 +(Returns the display associated with the gi)72 184.2 Q -.165(ve)-.275 G 2.75 +(nc).165 G(ursor)277.788 184.2 Q(.)-.605 E F1(\(fr)72 214.2 Q -.917 +(ee-cursor \))-.198 F(pr)456.128 214.2 Q(ocedur)-.198 E(e)-.198 E F0(See)72 +232.8 Q F2(XF)2.75 E -.407(re)-.605 G(eCur).407 E(sor)-.11 E F0(.)A F1(\(cr)72 +262.8 Q(eate-cursor)-.198 E F2(sr)4.583 E 2.75(cm)-.407 G(ask x y for)166.684 +262.8 Q -.44(eg)-.407 G -.495(ro).44 G(und bac).495 E(kgr)-.22 E(ound)-.495 E +F1 150.36(\)p)C -.198(ro)462.244 262.8 S(cedur).198 E(e)-.198 E F0(See)72 281.4 +Q F2(XCr)2.75 E(eatePixmapCur)-.407 E(sor)-.11 E F0(.)A F2(sr)5.5 E(c)-.407 E +F0(and)2.75 E F2(mask)2.75 E F0(are pixmaps.)2.75 E F2(mask)5.5 E F0 +(can be the symbol)2.75 E/F3 11/Courier@0 SF(none)2.75 E F0(.)A F1(\(cr)72 +311.4 Q(eate-glyph-cursor)-.198 E F2(sr)4.583 E 2.75(cs)-.407 G -.407(rc) +192.974 311.4 S(-c).407 E(har mask mask-c)-.165 E(har for)-.165 E -.44(eg)-.407 +G -.495(ro).44 G(und bac).495 E(kgr)-.22 E(ound)-.495 E F1 47.213(\)p)C -.198 +(ro)462.244 311.4 S(cedur).198 E(e)-.198 E F0(See)72 330 Q F2(XCr)2.783 E +(eateGlyphCur)-.407 E(sor)-.11 E F0(.)A F2(sr)5.533 E(c)-.407 E F0(and)2.783 E +F2(mask)2.783 E F0 .033(are fonts.)2.783 F F2(mask)5.533 E F0 .033 +(can be the symbol)2.783 F F3(none)2.783 E F0 5.532(.T)C .032(he display is) +448.936 330 R(obtained from)72 345 Q F2(sr)2.75 E(c)-.407 E F0(.)A F2(sr)5.5 E +(c-c)-.407 E(har)-.165 E F0(and)2.75 E F2(mask-c)2.75 E(har)-.165 E F0 +(are inte)2.75 E(gers.)-.165 E F1(\(cr)72 375 Q(eate-f)-.198 E(ont-cursor)-.275 +E F2(display sr)4.583 E(c-c)-.407 E(har)-.165 E F1 215.953(\)p)C -.198(ro) +462.244 375 S(cedur).198 E(e)-.198 E F0(See)72 393.6 Q F2(XCr)3.047 E +(eateGlyphCur)-.407 E(sor)-.11 E F0 5.797(.C)C(alls)201.019 393.6 Q F2(cr)3.048 +E(eate-glyph-cur)-.407 E(sor)-.11 E F0 .298(with the font named `)3.048 F +(`cursor')-.814 E .298(', the speci\214ed)-.814 F F2(sr)72 408.6 Q(c-c)-.407 E +(har)-.165 E F0 2.75(,a)C F2(mask-c)A(har)-.165 E F0(of)2.75 E F3 +(\(1+ src-char\))2.75 E F0 2.75(,b)C(lack fore)279.559 408.6 Q +(ground, and white background.)-.165 E F1(\(r)72 438.6 Q(ecolor)-.198 E +(-cursor)-.407 E F2(cur)4.583 E(sor for)-.11 E -.44(eg)-.407 G -.495(ro).44 G +(und bac).495 E(kgr)-.22 E(ound)-.495 E F1 170.919(\)p)C -.198(ro)462.244 438.6 +S(cedur).198 E(e)-.198 E F0(See)72 457.2 Q F2(XRecolorCur)2.75 E(sor)-.11 E F1 +(\(de\214ne-cursor)72 487.2 Q F2(window cur)4.583 E(sor)-.11 E F1 244.3(\)p)C +-.198(ro)462.244 487.2 S(cedur).198 E(e)-.198 E F0(Synon)72 505.8 Q(ym for) +-.165 E F3(\(set-window-cursor! window cursor\))2.75 E F0(.)A F1 +(\(unde\214ne-cursor)72 535.8 Q F2(window)4.583 E F1 263.429(\)p)C -.198(ro) +462.244 535.8 S(cedur).198 E(e)-.198 E F0(Synon)72 554.4 Q(ym for)-.165 E F3 +(\(set-window-cursor! window 'none\))2.75 E F0(.)A F1 2.75(13. Grab)72 584.4 R +(Functions)2.75 E(\(grab-pointer)72 614.4 Q F2(window owner? e)4.583 E +(vents ptr)-.165 E(-sync? kbd-sync? con\214ne-to cur)-.22 E(sor time)-.11 E F1 +21.066(\)p)C -.198(ro)462.244 614.4 S(cedur).198 E(e)-.198 E F0(See)72 633 Q F2 +(XGr)3.367 E(abP)-.165 E(ointer)-.88 E F0(.)A F2(window)6.117 E F0(and)3.367 E +F2(con\214ne-to)3.367 E F0 .617(are windo)3.367 F(ws.)-.275 E F2 -.165(ev)6.117 +G(ents).165 E F0 .616(is a list of symbols \(e)3.367 F -.165(ve)-.275 G .616 +(nt mask).165 F 1.999(names, such as)72 648 R F3(enter-window)4.749 E F0(,)A F3 +(pointer-motion)4.749 E F0 4.749(,e)C(tc.\).)337.91 648 Q F2(ptr)7.499 E +(-sync?)-.22 E F0(and)4.749 E F2(kbd-sync?)4.75 E F0(deter)4.75 E(-)-.22 E +1.233(mine whether synchronous or asynchronous grab mode is to be used.)72 663 +R F2(time)6.733 E F0 1.233(is an inte)3.983 F 1.233(ger or the)-.165 F(symbol) +72 678 Q F3(now)4.431 E F0(\(for)4.431 E F2(Curr)4.431 E(entT)-.407 E(ime)-.605 +E F0(\).)A F2(gr)7.181 E(ab-pointer)-.165 E F0 1.682(returns a symbol \()4.431 +F F3(success)A F0(,)A F3(not-viewable)4.432 E F0(,)A F3(already-grabbed)72 693 +Q F0(,)A F3(frozen)2.75 E F0 2.75(,o)C(r)227.1 693 Q F3(invalid-time)2.75 E F0 +(\).)A EP +%%Page: 19 19 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(9-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(ungrab-pointer)72 87 Q/F2 11/Times-Italic@0 +SF(display time)4.583 E F1 246.632(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e) +-.198 E F0(See)72 105.6 Q F2(XUngr)2.75 E(abP)-.165 E(ointer)-.88 E F0(.)A F1 +(\(grab-b)72 135.6 Q(utton)-.22 E F2(win b)4.583 E(utton mod owner? e)-.22 E +(vents ptr)-.165 E(-sync? kbd-sync? con\214ne-to cur)-.22 E(sor)-.11 E F1 +12.024(\)p)C -.198(ro)462.244 135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q +F2(XGr)3.155 E(abButton)-.165 E F0(.)A F2 -.22(bu)5.905 G(tton).22 E F0 .405 +(is a symbol \()3.155 F/F3 11/Courier@0 SF(button1)A F0(...)3.155 E F3(button5) +3.155 E F0 3.155(,o)C(r)365.968 154.2 Q F3(any-button)3.155 E F0(\).)A F3(mod) +5.905 E F0(\(modi-)3.154 E .184(\214ers\) is a list of symbols \()72 169.2 R F3 +(shift)A F0(,)A F3(lock)2.934 E F0(,)A F3(control)2.934 E F0(,)A F3(mod1)2.934 +E F0(...)2.934 E F3(mod5)2.934 E F0(,)A F3(button1)2.934 E F0(...)2.934 E F3 +(button5)2.934 E F0 2.934(,o)C(r)500.337 169.2 Q F3(any-modifier)72 184.2 Q F0 +2.75(\). F)B(or the other ar)-.165 E(guments see)-.198 E F2(gr)2.75 E +(ab-pointer)-.165 E F0(abo)2.75 E -.165(ve)-.165 G(.).165 E F1(\(ungrab-b)72 +214.2 Q(utton)-.22 E F2(window b)4.583 E(utton modi\214er)-.22 E(s)-.11 E F1 +194.91(\)p)C -.198(ro)462.244 214.2 S(cedur).198 E(e)-.198 E F0(See)72 232.8 Q +F2(XUngr)2.75 E(abButton)-.165 E F0 5.5(.S)C(ee)175.114 232.8 Q F2(gr)2.75 E +(ab-b)-.165 E(utton)-.22 E F0(abo)2.75 E -.165(ve)-.165 G(.).165 E F1 +(\(change-acti)72 262.8 Q -.11(ve)-.11 G(-pointer).11 E(-grab)-.407 E F2 +(display e)4.583 E(vents cur)-.165 E(sor time)-.11 E F1 130.241(\)p)C -.198(ro) +462.244 262.8 S(cedur).198 E(e)-.198 E F0(See)72 281.4 Q F2(XChang)2.941 E +(eActiveP)-.11 E(ointerGr)-.88 E(ab)-.165 E F0(.)A F2 -.165(ev)5.691 G(ents) +.165 E F0 .191(is a list of symbols \(e)2.941 F -.165(ve)-.275 G .191 +(nt mask names, such as).165 F F3(enter-)2.941 E(window)72 296.4 Q F0(,)A F3 +(pointer-motion)2.75 E F0 2.75(,e)C(tc.\).)219.884 296.4 Q F1(\(grab-k)72 326.4 +Q(eyboard)-.11 E F2(window owner? pointer)4.583 E(-sync? k)-.22 E -.33(ey)-.11 +G(boar).33 E(d-sync? time)-.407 E F1 75.813(\)p)C -.198(ro)462.244 326.4 S +(cedur).198 E(e)-.198 E F0(See)72 345 Q F2(XGr)4.016 E(abK)-.165 E -.33(ey) +-.385 G(boar).33 E(d)-.407 E F0 6.766(.F)C 1.266(or a description of the ar) +179.406 345 R 1.267(guments and the return v)-.198 F 1.267(alue see)-.275 F F2 +(gr)4.017 E(ab-pointer)-.165 E F0(abo)72 360 Q -.165(ve)-.165 G(.).165 E F1 +(\(ungrab-k)72 390 Q(eyboard)-.11 E F2(display time)4.583 E F1 236.347(\)p)C +-.198(ro)462.244 390 S(cedur).198 E(e)-.198 E F0(See)72 408.6 Q F2(XUngr)2.75 E +(abK)-.165 E -.33(ey)-.385 G(boar).33 E(d)-.407 E F0(.)A F1(\(grab-k)72 438.6 Q +(ey)-.11 E F2(window k)4.583 E .66 -.33(ey m)-.11 H(odi\214er).33 E 2.75(so) +-.11 G(wner? pointer)225.325 438.6 Q(-sync? k)-.22 E -.33(ey)-.11 G(boar).33 E +(d-sync?)-.407 E F1 65.077(\)p)C -.198(ro)462.244 438.6 S(cedur).198 E(e)-.198 +E F0(See)72 457.2 Q F2(XGr)3.901 E(abK)-.165 E -.33(ey)-.385 G F0(.).33 E F2 +-.11(ke)6.651 G(y)-.22 E F0 1.151(is a k)3.901 F -.165(ey)-.11 G 1.151 +(code \(an inte).165 F 1.151(ger\) or the symbol)-.165 F F3(any)3.901 E F0 6.65 +(.F)C 1.15(or the other ar)383.515 457.2 R 1.15(guments see)-.198 F F2(gr)72 +472.2 Q(ab-pointer)-.165 E F0(abo)2.75 E -.165(ve)-.165 G(.).165 E F1 +(\(ungrab-k)72 502.2 Q(ey)-.11 E F2(window k)4.583 E .66 -.33(ey m)-.11 H +(odi\214er).33 E(s)-.11 E F1 223.158(\)p)C -.198(ro)462.244 502.2 S(cedur).198 +E(e)-.198 E F0(See)72 520.8 Q F2(XUngr)2.75 E(abK)-.165 E -.33(ey)-.385 G F0 +5.5(.S).33 G(ee)162.167 520.8 Q F2(gr)2.75 E(ab-k)-.165 E -.33(ey)-.11 G F0 +(abo)3.08 E -.165(ve)-.165 G(.).165 E F1(\(allo)72 550.8 Q(w-e)-.11 E -.11(ve) +-.165 G(nts).11 E F2(display mode time)4.583 E F1 234.51(\)p)C -.198(ro)462.244 +550.8 S(cedur).198 E(e)-.198 E F0(See)72 569.4 Q F2(XAllowEvents)7.511 E F0(.)A +F2(mode)170.127 569.4 Q F0 4.761(is a symbol \()7.511 F F3(async-pointer)A F0 +(,)A F3(sync-pointer)7.512 E F0(,)A F3(replay-)7.512 E(pointer)72 584.4 Q F0(,) +A F3(async-keyboard)3.938 E F0(,)A F3(sync-keyboard)3.938 E F0(,)A F3 +(replay-keyboard)3.937 E F0(,)A F3(async-both)3.937 E F0 3.937(,o)C(r)500.337 +584.4 Q F3(sync-both)72 599.4 Q F0(\).)A F1(\(grab-ser)72 629.4 Q -.11(ve)-.11 +G(r).11 E F2(display)4.583 E F1 285.682(\)p)C -.198(ro)462.244 629.4 S(cedur) +.198 E(e)-.198 E F0(See)72 648 Q F2(XGr)2.75 E(abServer)-.165 E F0(.)A F1 +(\(ungrab-ser)72 678 Q -.11(ve)-.11 G(r).11 E F2(display)4.583 E F1 273.45(\)p) +C -.198(ro)462.244 678 S(cedur).198 E(e)-.198 E F0(See)72 696.6 Q F2(XUngr)2.75 +E(abServer)-.165 E F0(.)A EP +%%Page: 20 20 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(0-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(with-ser)72 87 Q -.11(ve)-.11 G -.407(r-) +.11 G(grab).407 E(bed)-.11 E/F2 11/Times-Italic@0 SF(display . body-forms)4.583 +E F1 203.6(\)s)C(yntax)477.721 87 Q F0 1.344(This macro performs a)72 105.6 R +F2(gr)4.094 E(ab-server)-.165 E F0 1.344(on the speci\214ed display)4.094 F +4.094(,e)-.715 G -.275(va)354.223 105.6 S 1.345(luates the).275 F F2 +(body-forms)4.095 E F0 1.345(in order)4.095 F(,)-.44 E 1.158 +(and then ungrabs the serv)72 120.6 R(er)-.165 E 6.658(.T)-.605 G 1.158 +(he macro body is guarded by a)212.958 120.6 R F2(dynamic-wind)3.907 E F0 1.157 +(to ensure that the)3.907 F F2(ungr)72 135.6 Q(ab-server)-.165 E F0 .11(is per\ +formed when a body-form calls a continuation created outside the macro, and) +2.859 F .563(that it is grabbed ag)72 150.6 R .563 +(ain when the body is re-entered at a later point in time.)-.055 F F2 +(with-server)6.062 E(-gr)-.22 E(abbed)-.165 E F0(returns the v)72 165.6 Q +(alue of the last body-form.)-.275 E F1 2.75(14. W)72 195.6 R(indo)-.198 E 2.75 +(wM)-.11 G(anager Functions)143.808 195.6 Q(\(r)72 225.6 Q(epar)-.198 E +(ent-windo)-.198 E(w)-.11 E F2(window par)4.583 E(ent-window x y)-.407 E F1 +172.998(\)p)C -.198(ro)462.244 225.6 S(cedur).198 E(e)-.198 E F0(See)72 244.2 Q +F2(XRepar)2.75 E(entW)-.407 E(indow)-.605 E F0(.)A F1(\(install-colormap)72 +274.2 Q F2(colormap)4.583 E F1 253.056(\)p)C -.198(ro)462.244 274.2 S(cedur) +.198 E(e)-.198 E F0(See)72 292.8 Q F2(XInstallColormap)2.75 E F0(.)A F1 +(\(uninstall-colormap)72 322.8 Q F2(colormap)4.583 E F1 240.824(\)p)C -.198(ro) +462.244 322.8 S(cedur).198 E(e)-.198 E F0(See)72 341.4 Q F2(XUninstallColormap) +2.75 E F0(.)A F1(\(list-installed-colormaps)72 371.4 Q F2(window)4.583 E F1 +227.987(\)p)C -.198(ro)462.244 371.4 S(cedur).198 E(e)-.198 E F0(See)72 390 Q +F2(XListInstalledColormaps)2.75 E F0 5.5(.R)C(eturns a v)216.848 390 Q +(ector of colormaps.)-.165 E F1(\(set-input-f)72 420 Q(ocus)-.275 E F2 +(display window r)4.583 E -.165(ev)-.407 G(ert-to time).165 E F1 171.711(\)p)C +-.198(ro)462.244 420 S(cedur).198 E(e)-.198 E F0(See)72 438.6 Q F2(XSetInputF) +2.978 E(ocus)-1.155 E F0(.)A F2(window)5.728 E F0 .228(can be the symbol)2.978 +F/F3 11/Courier@0 SF(pointer-root)2.978 E F0(.)A F2 -2.101 -.407(re v)5.728 H +(ert-to).407 E F0 .228(is a symbol \()2.978 F F3(none)A F0(,)A F3(pointer-root) +72 453.6 Q F0 2.75(,o)C(r)162.2 453.6 Q F3(parent)2.75 E F0(\).)A F2(time)5.5 E +F0(is an inte)2.75 E(ger or the symbol)-.165 E F3(now)2.75 E F0(.)A F1 +(\(input-f)72 483.6 Q(ocus)-.275 E F2(display)4.583 E F1 287.541(\)p)C -.198 +(ro)462.244 483.6 S(cedur).198 E(e)-.198 E F0(See)72 502.2 Q F2(XGetInputF) +2.762 E(ocus)-1.155 E F0 5.512(.R)C .012 +(eturns a pair the car of which is a windo)177.8 502.2 R 1.441 -.715(w, a)-.275 +H .011(nd the cdr is a symbol \().715 F F3(none)A F0(,)A F3(pointer-root)72 +517.2 Q F0 2.75(,o)C(r)162.2 517.2 Q F3(parent)2.75 E F0(\).)A F1 +(\(general-war)72 547.2 Q(p-pointer)-.11 E F2(display dst-win dst-x dst-y sr) +4.583 E(c-win sr)-.407 E(c-x sr)-.407 E(c-y sr)-.407 E(c-width sr)-.407 E +(c-height)-.407 E F1 -18.534(\)p)C -.198(ro)462.244 547.2 S(cedur).198 E(e) +-.198 E F0(See)72 565.8 Q F2(XW)2.75 E(arpP)-1.012 E(ointer)-.88 E F0(.)A F1 +(\(war)72 595.8 Q(p-pointer)-.11 E F2(dst-window dst-x dst-y)4.583 E F1 211.003 +(\)p)C -.198(ro)462.244 595.8 S(cedur).198 E(e)-.198 E F0(See)72 614.4 Q F2(XW) +5.974 E(arpP)-1.012 E(ointer)-.88 E F0 8.725(.I)C -2.09 -.44(nv o)171.267 614.4 +T -.11(ke).44 G(s).11 E F2 -.11(ge)5.975 G(ner).11 E(al-warp-pointer)-.165 E F0 +3.225(with the display associated with the)5.975 F F2(dst-)5.975 E(window)72 +629.4 Q F0 4.276(,t)C(he)116.316 629.4 Q F2(dst-window)4.276 E F0(,)A F2(dst-x) +4.276 E F0(,)A F2(dst-y)4.276 E F0 4.276(,a)C F2(sr)-.001 E(c-window)-.407 E F0 +(of)4.275 E F3(none)4.275 E F0 4.275(,a)C 1.525(nd zero source coordinates and) +361.665 629.4 R(dimensions.)72 644.4 Q F1(\(war)72 674.4 Q(p-pointer)-.11 E(-r) +-.407 E(elati)-.198 E -.11(ve)-.11 G F2(display x-of)4.693 E(fset y-of)-.198 E +(fset)-.198 E F1 170.083(\)p)C -.198(ro)462.244 674.4 S(cedur).198 E(e)-.198 E +F0(See)72 693 Q F2(XW)4.782 E(arpP)-1.012 E(ointer)-.88 E F0 7.532(.I)C -2.09 +-.44(nv o)168.882 693 T -.11(ke).44 G(s).11 E F2 -.11(ge)4.782 G(ner).11 E +(al-warp-pointer)-.165 E F0 2.032(with the speci\214ed)4.782 F F2(display)4.783 +E F0 4.783(,a)C F2(dst-window)A F0(of)4.783 E F3(none)72 708 Q F0(,)A F2(x-of) +2.75 E(fset)-.198 E F0(,)A F2(y-of)2.75 E(fset)-.198 E F0 2.75(,a)C F2(sr)A +(c-window)-.407 E F0(of)2.75 E F3(none)2.75 E F0 2.75(,a)C +(nd zero source coordinates and dimensions.)289.283 708 Q EP +%%Page: 21 21 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(1-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(bell)72 87 Q/F2 11/Times-Italic@0 SF +(display . per)4.583 E(cent)-.407 E F1 282.492(\)p)C -.198(ro)462.244 87 S +(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2(XBell)2.75 E F0(.)A F2(per)5.5 E +(cent)-.407 E F0(is an inte)2.75 E(ger between -100 and 100.)-.165 E(If)5.5 E +F2(per)2.75 E(cent)-.407 E F0(is omitted, 0 is used.)2.75 E F1 +(\(set-access-contr)72 135.6 Q(ol)-.198 E F2(display enable?)4.583 E F1 220.595 +(\)p)C -.198(ro)462.244 135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q F2 +(XSetAccessContr)2.75 E(ol)-.495 E F0(.)A F1(\(change-sa)72 184.2 Q -.11(ve) +-.275 G(-set).11 E F2(window mode)4.583 E F1 238.481(\)p)C -.198(ro)462.244 +184.2 S(cedur).198 E(e)-.198 E F0(See)72 202.8 Q F2(XChang)2.75 E(eSaveSet)-.11 +E F0(.)A F2(mode)5.5 E F0(is a symbol \()2.75 E/F3 11/Courier@0 SF(insert)A F0 +(or)2.75 E F3(delete)2.75 E F0(\).)A F1(\(set-close-do)72 232.8 Q(wn-mode)-.11 +E F2(display mode)4.583 E F1 216.217(\)p)C -.198(ro)462.244 232.8 S(cedur).198 +E(e)-.198 E F0(See)72 251.4 Q F2(XSetCloseDownMode)6.138 E F0(.)A F2(mode)8.888 +E F0 3.388(is a symbol \()6.138 F F3(destroy-all)A F0(,)A F3(retain-permanent) +6.137 E F0 6.137(,o)C(r)500.337 251.4 Q F3(retain-temporary)72 266.4 Q F0(\).)A +F1(\(get-pointer)72 296.4 Q(-mapping)-.407 E F2(display)4.583 E F1 243.684(\)p) +C -.198(ro)462.244 296.4 S(cedur).198 E(e)-.198 E F0(See)72 315 Q F2(XGetP)2.75 +E(ointerMapping)-.88 E F0 5.5(.R)C(eturns a v)200.667 315 Q(ector of 256 inte) +-.165 E(gers.)-.165 E F1(\(set-pointer)72 345 Q(-mapping)-.407 E F2 +(display mapping)4.583 E F1 203.655(\)p)C -.198(ro)462.244 345 S(cedur).198 E +(e)-.198 E F0(See)72 363.6 Q F2(XSetP)4.521 E(ointerMapping)-.88 E F0(.)A F2 +(mapping)7.271 E F0 1.772(is a v)4.521 F 1.772(ector of inte)-.165 F 4.522 +(gers. Returns)-.165 F 1.772(#t if)4.522 F F2(XSetP)4.522 E(ointerMapping)-.88 +E F0(succeeds, #f otherwise.)72 378.6 Q F1 2.75(15. Ev)72 408.6 R +(ent Handling Functions)-.11 E(\(e)72 438.6 Q -.11(ve)-.165 G(nt-listen).11 E +F2(display wait?)4.583 E F1 259.744(\)p)C -.198(ro)462.244 438.6 S(cedur).198 E +(e)-.198 E F0(See)72 457.2 Q F2(XP)2.87 E(ending)-.88 E F0(,)A F2(XP)2.87 E +(eekEvent)-.88 E F0 5.62(.R)C .12(eturns the size of the display')206.846 457.2 +R 2.869(se)-.605 G -.165(ve)347.825 457.2 S .119(nt queue.).165 F(If)5.619 E F2 +(wait?)2.869 E F0 .119(is true and the)2.869 F -2.365 -.275(ev e)72 472.2 T +.832(nt queue is empty).275 F(,)-.715 E F2 -.165(ev)3.582 G(ent-listen).165 E +F0 .832(\215ushes the output b)3.582 F(uf)-.22 E .832 +(fer and blocks until an e)-.275 F -.165(ve)-.275 G .833(nt is recei).165 F +-.165(ve)-.275 G(d).165 E(from the serv)72 487.2 Q(er)-.165 E(.)-.605 E F1 +(\(get-motion-e)72 517.2 Q -.11(ve)-.165 G(nts).11 E F2(window fr)4.583 E +(om-time to-time)-.495 E F1 175.011(\)p)C -.198(ro)462.244 517.2 S(cedur).198 E +(e)-.198 E F0(See)72 535.8 Q F2(XGetMotionEvents)5.215 E F0(.)A F2(fr)7.965 E +(om-time)-.495 E F0(and)5.215 E F2(to-time)5.215 E F0 2.465(are inte)5.215 F +2.465(gers or the symbol)-.165 F F3(now)5.214 E F0(.)A F2 -.11(ge)7.964 G +(t-motion-).11 E -.165(ev)72 550.8 S(ents).165 E F0 1.094(returns a v)3.844 F +1.094(ector of lists of three elements: a time stamp \(an inte)-.165 F 1.094 +(ger or the symbol)-.165 F F3(now)3.844 E F0(\),)A +(and the x and y coordinates \(inte)72 565.8 Q(gers\).)-.165 E F1(\(handle-e)72 +595.8 Q -.11(ve)-.165 G(nts).11 E F2(display discar)4.583 E(d? peek? . clauses) +-.407 E F1 183.371(\)s)C(yntax)477.721 595.8 Q F0(See)72 614.4 Q F2(XNe)4.836 E +(xtEvent)-.22 E F0(,)A F2(XP)4.836 E(eekEvent)-.88 E F0(,)A F2(XIfEvent)4.836 E +F0(,)A F2(XP)4.835 E(eekIfEvent)-.88 E F0(.)A F2(handle-e)7.585 E(vents)-.165 E +F0 2.085(is a special form.)4.835 F(Each)7.585 E F2(clause)72 629.4 Q F0 2.037 +(is of the form)4.787 F F2(\(guar)4.787 E 4.787(df)-.407 G(unction\))212.746 +629.4 Q F0(;)A F2(guar)4.787 E(d)-.407 E F0 2.037(is either an e)4.787 F -.165 +(ve)-.275 G 2.037(nt name \(a symbol, e.).165 F(g.)1.833 E F3(key-)4.788 E +(press)72 644.4 Q F0(or)3.408 E F3(exposure)3.408 E F0 .658(\), a list of e)B +-.165(ve)-.275 G .658(nt names, or the symbol).165 F F3(else)3.407 E F0(.)A F2 +(handle-e)6.157 E(vents)-.165 E F0 .657(gets the ne)3.407 F(xt)-.165 E -2.365 +-.275(ev e)72 659.4 T .247(nt from the speci\214ed display).275 F 5.747(.T) +-.715 G .247(hen the e)227.587 659.4 R -.165(ve)-.275 G .247 +(nt type is matched ag).165 F .248(ainst each e)-.055 F -.165(ve)-.275 G .248 +(nt name in each).165 F .145(guard in order)72 674.4 R 5.645(.W)-.605 G .145 +(hen a match occurs, the corresponding function is in)152.779 674.4 R -.22(vo) +-.44 G -.11(ke).22 G 2.895(dw).11 G .145(ith the name of the)420.933 674.4 R +-2.365 -.275(ev e)72 689.4 T 1.738(nt being dispatched \(a symbol\) and other) +.275 F 4.489(,e)-.44 G -.165(ve)288.306 689.4 S 1.739(nt speci\214c ar).165 F +1.739(guments \(see belo)-.198 F 4.489(w\). When)-.275 F(no)4.489 E .615 +(clause matches and an)72 704.4 R F3(else)3.365 E F0 .614 +(clause is present, the function from this clause is in)3.365 F -.22(vo)-.44 G +-.11(ke).22 G(d.).11 E F2(handle-)6.114 E -.165(ev)72 719.4 S(ents).165 E F0 +.935(loops until a function returns a v)3.684 F .935 +(alue not equal to #f in which case handle-e)-.275 F -.165(ve)-.275 G .935 +(nts returns).165 F(this v)72 734.4 Q(alue.)-.275 E EP +%%Page: 22 22 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(2-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(If)72 87 Q/F1 11/Times-Italic@0 SF(discar)3.124 E(d?)-.407 E F0 +.374(is true, unprocessed e)3.124 F -.165(ve)-.275 G .373(nts \(i.).165 F .373 +(e. e)1.833 F -.165(ve)-.275 G .373 +(nts for which no matching clause has been found\)).165 F 1.17(are remo)72 102 +R -.165(ve)-.165 G 3.92(df).165 G 1.17(rom the e)135.093 102 R -.165(ve)-.275 G +1.17(nt queue, otherwise the).165 F 3.921(ya)-.165 G 1.171(re left in place.) +308.611 102 R(If)6.671 E F1(peek?)3.921 E F0 1.171(is true, processed)3.921 F +-2.365 -.275(ev e)72 117 T(nts are not remo).275 E -.165(ve)-.165 G 2.75(df) +.165 G(rom the e)179.976 117 Q -.165(ve)-.275 G(nt queue.).165 E 1.172 +(The follo)72 135.6 R 1.172(wing list gi)-.275 F -.165(ve)-.275 G 3.922(sa).165 +G 1.172(ll e)188.415 135.6 R -.165(ve)-.275 G 1.172(nt speci\214c ar).165 F +1.172(guments for each e)-.198 F -.165(ve)-.275 G 1.171(nt type.).165 F 1.171 +(The \214rst ar)6.671 F 1.171(gument is)-.198 F(al)72 150.6 Q -.11(wa)-.11 G +(ys the e).11 E -.165(ve)-.275 G(nt type \(a symbol\).).165 E 1.066 +(In the follo)72 169.2 R 1.066(wing list, ar)-.275 F 1.067 +(guments with names of the form)-.198 F F1(something-window)3.817 E F0 1.067 +(\(or simply)3.817 F F1(window)3.817 E F0(\))A .553(are al)72 184.2 R -.11(wa) +-.11 G .553(ys of type).11 F F1(window)3.303 E F0 3.303(;a)C -.198(rg)202.552 +184.2 S .553(uments with names of the form).198 F F1(something-atom)3.303 E F0 +.553(\(or simply)3.303 F F1(atom)3.302 E F0(\))A .331(are al)72 199.2 R -.11 +(wa)-.11 G .331(ys of type).11 F F1(atom)3.081 E F0(.)A F1(time)5.832 E F0 .332 +(is an inte)3.082 F .332(ger or the symbol)-.165 F/F2 11/Courier@0 SF(now)3.082 +E F0(.)A F1(x)5.832 E F0(,)A F1(y)3.082 E F0(,)A F1(width)3.082 E F0(,)A F1 +(height)3.082 E F0(,)A F1(bor)3.082 E(der)-.407 E(-width)-.22 E F0(,)A F1(x-r) +72 214.2 Q(oot)-.495 E F0(,)A F1(y-r)3.094 E(oot)-.495 E F0(,)A F1(count)3.094 +E F0(,)A F1(major)3.093 E(-code)-.22 E F0(,)A F1(minor)3.093 E(-code)-.22 E F0 +3.093(,a)C(nd)284.301 214.2 Q F1 -.11(ke)3.093 G(ycode)-.22 E F0 .343(are inte) +3.093 F(gers.)-.165 E F1(state)5.843 E F0 .343(is a list of symbols)3.093 F(\() +72 229.2 Q F2(shift)A F0(,)A F2(lock)3.225 E F0(,)A F2(control)3.225 E F0(,)A +F2(mod1)3.225 E F0(...)3.225 E F2(mod5)3.225 E F0(,)A F2(button1)3.225 E F0 +(...)3.225 E F2(button5)3.225 E F0(\).)A F1 -.22(bu)5.975 G(tton).22 E F0 .475 +(is one of the sym-)3.225 F(bols)72 244.2 Q F2(button1)3.297 E F0(...)3.297 E +F2(button5)3.297 E F0(,)A F1 -.22(bu)3.297 G(tton-mask).22 E F0 .547 +(is a list of one or more of these symbols.)3.297 F F1(cr)6.046 E(oss-mode) +-.495 E F0(is a symbol \()72 259.2 Q F2(normal)A F0(,)A F2(grab)2.75 E F0(,)A +F2(ungrab)2.75 E F0(\).)A F1(place)5.5 E F0(is a symbol \()2.75 E F2(top)A F0 +(or)2.75 E F2(bottom)2.75 E F0(\).)A/F3 11/Times-Bold@0 SF -.11(ke)72 277.8 S +(y-pr).11 E(ess, k)-.198 E(ey-r)-.11 E(elease:)-.198 E F1(window)97 292.8 Q F0 +(,)A F1 -.495(ro)2.75 G(ot-window).495 E F0(,)A F1(sub-window)2.75 E F0(,)A F1 +(time)2.75 E F0(,)A F1(x)2.75 E F0(,)A F1(y)2.75 E F0(,)A F1(x-r)2.75 E(oot) +-.495 E F0(,)A F1(y-r)2.75 E(oot)-.495 E F0(,)A F1(state)2.75 E F0(,)A F1 -.11 +(ke)2.75 G(ycode)-.22 E F0(,)A F1(same-scr)2.75 E(een?)-.407 E F0(.)A F3 -.22 +(bu)72 311.4 S(tton-pr).22 E(ess, b)-.198 E(utton-r)-.22 E(elease:)-.198 E F1 +(window)97 326.4 Q F0(,)A F1 -.495(ro)2.75 G(ot-window).495 E F0(,)A F1 +(sub-window)2.75 E F0(,)A F1(time)2.75 E F0(,)A F1(x)2.75 E F0(,)A F1(y)2.75 E +F0(,)A F1(x-r)2.75 E(oot)-.495 E F0(,)A F1(y-r)2.75 E(oot)-.495 E F0(,)A F1 +(state)2.75 E F0(,)A F1 -.22(bu)2.75 G(tton).22 E F0(,)A F1(same-scr)2.75 E +(een?)-.407 E F0(.)A F3(motion-notify:)72 345 Q F1(window)97 360 Q F0(,)A F1 +-.495(ro)2.75 G(ot-window).495 E F0(,)A F1(sub-window)2.75 E F0(,)A F1(time) +2.75 E F0(,)A F1(x)2.75 E F0(,)A F1(y)2.75 E F0(,)A F1(x-r)2.75 E(oot)-.495 E +F0(,)A F1(y-r)2.75 E(oot)-.495 E F0(,)A F1(state)2.75 E F0(,)A F1(is-hint?)2.75 +E F0(,)A F1(same-scr)2.75 E(een?)-.407 E F0(.)A F3(enter)72 378.6 Q(-notify) +-.407 E 2.75(,l)-.605 G(ea)135.14 378.6 Q -.11(ve)-.275 G(-notify:).11 E F1 +(window)97 393.6 Q F0(,)A F1 -.495(ro)3.641 G(ot-window).495 E F0(,)A F1 +(sub-window)3.641 E F0(,)A F1(time)3.641 E F0(,)A F1(x)3.641 E F0(,)A F1(y) +3.641 E F0(,)A F1(x-r)3.641 E(oot)-.495 E F0(,)A F1(y-r)3.641 E(oot)-.495 E F0 +(,)A F1(cr)3.641 E(oss-mode)-.495 E F0(,)A F1(cr)3.641 E(oss-detail)-.495 E F0 +(\(one)3.641 E 5.753(of the symbols)97 408.6 R F2(ancestor)8.503 E F0(,)A F2 +(virtual)8.503 E F0(,)A F2(inferior)8.503 E F0(,)A F2(nonlinear)8.503 E F0(,)A +F2(nonlinear-)8.503 E(virtual)97 423.6 Q F0(\),)A F1(same-scr)2.75 E(een?)-.407 +E F0(,)A F1(focus?)2.75 E F0(,)A F1 -.22(bu)2.75 G(tton-mask).22 E F0(.)A F3 +-.275(fo)72 442.2 S(cus-in, f).275 E(ocus-out:)-.275 E F1(window)97 457.2 Q F0 +(,)A F1(cr)2.915 E(oss-mode)-.495 E F0(,)A F1(focus-detail)2.915 E F0 .165 +(\(one of the symbols)2.915 F F2(ancestor)2.915 E F0(,)A F2(virtual)2.915 E F0 +(,)A F2(inferior)2.915 E F0(,)A F2(nonlinear)97 472.2 Q F0(,)A F2 +(nonlinear-virtual)2.75 E F0(,)A F2(pointer)2.75 E F0(,)A F2(pointer-root)2.75 +E F0(,)A F2(none)2.75 E F0(\).)A F3 -.11(ke)72 490.8 S(ymap-notify:).11 E F1 +(window)97 505.8 Q F0(,)A F1 -.11(ke)2.75 G(ymap)-.22 E F0 +(\(a string of length 32\).)2.75 E F3(expose:)72 524.4 Q F1(window)97 539.4 Q +F0(,)A F1(x)2.75 E F0(,)A F1(y)2.75 E F0(,)A F1(width)2.75 E F0(,)A F1(height) +2.75 E F0(,)A F1(count)2.75 E F0(.)A F3(graphics-expose:)72 558 Q F1(window)97 +573 Q F0(,)A F1(x)2.75 E F0(,)A F1(y)2.75 E F0(,)A F1(width)2.75 E F0(,)A F1 +(height)2.75 E F0(,)A F1(count)2.75 E F0(,)A F1(major)2.75 E(-code)-.22 E F0(,) +A F1(minor)2.75 E(-code)-.22 E F0(.)A F3(no-expose:)72 591.6 Q F1(window)97 +606.6 Q F0(,)A F1(major)2.75 E(-code)-.22 E F0(,)A F1(minor)2.75 E(-code)-.22 E +F0(.)A F3(visibility-notify:)72 625.2 Q F1(window)97 640.2 Q F0(,)A F1 +(visibility-state)5.508 E F0 2.758(\(one of the symbols)5.508 F F2(unobscured) +5.508 E F0(,)A F2(partially-obscured)5.507 E F0(,)A F2(fully-obscured)97 655.2 +Q F0(\).)A F3(cr)72 673.8 Q(eate-notify:)-.198 E F1(par)97 688.8 Q(ent-window) +-.407 E F0(,)A F1(window)2.75 E F0(,)A F1(x)2.75 E F0(,)A F1(y)2.75 E F0(,)A F1 +(width)2.75 E F0(,)A F1(height)2.75 E F0(,)A F1(bor)2.75 E(der)-.407 E(-width) +-.22 E F0(,)A F1 -.11(ov)2.75 G(erride-r).11 E(edir)-.407 E(ect?)-.407 E F0(.)A +F3(destr)72 707.4 Q(oy-notify:)-.198 E F1 -.165(ev)97 722.4 S(ent-window).165 E +F0(,)A F1(window)2.75 E F0(.)A EP +%%Page: 23 23 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(3-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(unmap-notify:)72 87 Q/F2 11/Times-Italic@0 SF +-.165(ev)97 102 S(ent-window).165 E F0(,)A F2(window)2.75 E F0(,)A F2(fr)2.75 E +(om-con\214gur)-.495 E(e)-.407 E F0(.)A F1(map-notify:)72 120.6 Q F2 -.165(ev) +97 135.6 S(ent-window).165 E F0(,)A F2(window)2.75 E F0(,)A F2 -.11(ov)2.75 G +(erride-r).11 E(edir)-.407 E(ect)-.407 E F0(.)A F1(map-r)72 154.2 Q(equest:) +-.198 E F2(par)97 169.2 Q(ent-window)-.407 E F0(,)A F2(window)2.75 E F0(.)A F1 +-.198(re)72 187.8 S(par).198 E(ent-notify:)-.198 E F2 -.165(ev)97 202.8 S +(ent-window).165 E F0(,)A F2(par)2.75 E(ent-window)-.407 E F0(,)A F2(window) +2.75 E F0(,)A F2(x)2.75 E F0(,)A F2(y)2.75 E F0(,)A F2 -.11(ov)2.75 G(erride-r) +.11 E(edir)-.407 E(ect)-.407 E F0(.)A F1(con\214gur)72 221.4 Q(e-notify:)-.198 +E F2 -.165(ev)97 236.4 S(ent-window).165 E F0(,)A F2(window)2.942 E F0(,)A F2 +(x)2.942 E F0(,)A F2(y)2.942 E F0(,)A F2(width)2.942 E F0(,)A F2(height)2.943 E +F0(,)A F2(bor)2.943 E(der)-.407 E(-width)-.22 E F0(,)A F2(abo)2.943 E +(ve-window)-.11 E F0(,)A F2 -.11(ov)2.943 G(erride-r).11 E(edir)-.407 E(ect?) +-.407 E F0(.)A F1(con\214gur)72 255 Q(e-r)-.198 E(equest:)-.198 E F2(par)97 270 +Q(ent-window)-.407 E F0(,)A F2(window)3.753 E F0(,)A F2(x)3.753 E F0(,)A F2(y) +3.752 E F0(,)A F2(width)3.752 E F0(,)A F2(height)3.752 E F0(,)A F2(bor)3.752 E +(der)-.407 E(-width)-.22 E F0(,)A F2(abo)3.752 E(ve-window)-.11 E F0(,)A F2 +(stac)3.752 E(k-mode)-.22 E F0(\(see)3.752 E F2(set-window-stac)97 285 Q +(k-mode!)-.22 E F0(abo)2.75 E -.165(ve)-.165 G(\),).165 E F2(value-mask)2.75 E +F0(\(an inte)2.75 E(ger\).)-.165 E F1(gra)72 303.6 Q(vity-notify:)-.275 E F2 +-.165(ev)97 318.6 S(ent-window).165 E F0(,)A F2(window)2.75 E F0(,)A F2(x)2.75 +E F0(,)A F2(y)2.75 E F0(.)A F1 -.198(re)72 337.2 S(size-r).198 E(equest:)-.198 +E F2(window)97 352.2 Q F0(,)A F2(width)2.75 E F0(,)A F2(height)2.75 E F0(.)A F1 +(cir)72 370.8 Q(culate-notify:)-.198 E F2 -.165(ev)97 385.8 S(ent-window).165 E +F0(,)A F2(window)2.75 E F0(,)A F2(place)2.75 E F0(.)A F1(cir)72 404.4 Q +(culate-r)-.198 E(equest:)-.198 E F2(par)97 419.4 Q(ent-window)-.407 E F0(,)A +F2(window)2.75 E F0(,)A F2(place)2.75 E F0(.)A F1(pr)72 438 Q(operty-notify:) +-.198 E F2(window)97 453 Q F0(,)A F2(atom)2.75 E F0(,)A F2(time)2.75 E F0(,)A +F2(pr)2.75 E(operty-state)-.495 E F0(\(one of the symbols)2.75 E/F3 11 +/Courier@0 SF(new-value)2.75 E F0(,)A F3(deleted)2.75 E F0(\).)A F1 +(selection-clear:)72 471.6 Q F2(window)97 486.6 Q F0(,)A F2(selection-atom)2.75 +E F0(,)A F2(time)2.75 E F0(.)A F1(selection-r)72 505.2 Q(equest:)-.198 E F2 +(owner)97 520.2 Q(-window)-.22 E F0(,)A F2 -.407(re)2.75 G(questor).407 E +(-window)-.22 E F0(,)A F2(selection-atom)2.75 E F0(,)A F2(tar)2.75 E -.11(ge) +-.407 G(t-atom).11 E F0(,)A F2(pr)2.75 E(operty-atom)-.495 E F0(,)A F2(time) +2.75 E F0(.)A F1(selection-notify:)72 538.8 Q F2 -.407(re)97 553.8 S(questor) +.407 E(-window)-.22 E F0(,)A F2(selection-atom)2.75 E F0(,)A F2(tar)2.75 E -.11 +(ge)-.407 G(t-atom).11 E F0(,)A F2(pr)2.75 E(operty-atom)-.495 E F0(,)A F2 +(time)2.75 E F0(.)A F1(colormap-notify:)72 572.4 Q F2(window)97 587.4 Q F0(,)A +F2(colormap)2.75 E F0(,)A F2(ne)2.75 E(w?)-.165 E F0(,)A F2 +(colormap-installed?)2.75 E F0(.)A F1(client-message:)72 606 Q F2(window)97 621 +Q F0(,)A F2(messa)3.075 E .545 -.11(ge t)-.11 H(ype).11 E F0 .325(\(an atom\),) +3.075 F F2(messa)3.075 E .546 -.11(ge d)-.11 H(ata).11 E F0 .326 +(\(a string of length 20, or a v)3.076 F .326(ector of 10 or 5)-.165 F(inte)97 +636 Q(ger numbers, or)-.165 E 2.75(,i)-.44 G 2.75(ft)190.797 636 S +(he format \214eld of the e)200.268 636 Q -.165(ve)-.275 G +(nt is wrong, the format as a number\).).165 E F1(mapping-notify:)72 654.6 Q F2 +(window)97 669.6 Q F0(,)A F2 -.407(re)3.058 G(quest).407 E F0 .308 +(\(one of the symbols)3.058 F F3(modifier)3.058 E F0(,)A F3(keyboard)3.058 E F0 +(,)A F3(pointer)3.058 E F0(\),)A F2 -.11(ke)3.058 G(ycode)-.22 E F0(,)A F2 +(count)3.058 E F0(.)A EP +%%Page: 24 24 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(4-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(16. Inter)72 87 R +(-Client Communication Functions)-.407 E(\(iconify-windo)72 117 Q(w)-.11 E/F2 +11/Times-Italic@0 SF(window scr)4.583 E(een-number)-.407 E F1 197.66(\)p)C +-.198(ro)462.244 117 S(cedur).198 E(e)-.198 E F0(See)72 135.6 Q F2(XIconifyW) +2.75 E(indow)-.605 E F0(.)A F1(\(withdraw-windo)72 165.6 Q(w)-.11 E F2 +(window scr)4.583 E(een-number)-.407 E F1 184.218(\)p)C -.198(ro)462.244 165.6 +S(cedur).198 E(e)-.198 E F0(See)72 184.2 Q F2(XW)2.75 E(ithdr)-.605 E(awW)-.165 +E(indow)-.605 E F0(.)A F1(\(r)72 214.2 Q(econ\214gur)-.198 E(e-wm-windo)-.198 E +(w)-.11 E F2 2.75(.a)4.583 G -.407(rg)205.613 214.2 S(s).407 E F1 233.201(\)p)C +-.198(ro)462.244 214.2 S(cedur).198 E(e)-.198 E F0(See)72 232.8 Q F2 +(XRecon\214gur)2.75 E(eWMW)-.407 E(indow)-.605 E F0(.)A -.165(Fo)72 251.4 S +3.298(rt).165 G .549(he format of the ar)93.47 251.4 R .549(guments see)-.198 F +F2(cr)3.299 E(eate-window)-.407 E F0(abo)3.299 E -.165(ve)-.165 G 6.049(.M).165 +G .549(andatory attrib)348.046 251.4 R .549(utes are)-.22 F F2(window)3.299 E +F0(and)3.299 E F2(scr)72 266.4 Q(een-number)-.407 E F0 1.618(\(an inte)4.368 F +4.368(ger\). Optional)-.165 F(attrib)4.368 E 1.618(utes are)-.22 F F2(x)4.368 E +F0(,)A F2(y)4.368 E F0(,)A F2(width)4.368 E F0(,)A F2 1.617(height bor)4.367 F +(der)-.407 E(-width)-.22 E F0(\(inte)4.367 E(gers\),)-.165 E F2(sibling)72 +281.4 Q F0 .676(\(a windo)3.426 F .676(w\), and)-.275 F F2(stac)3.426 E(k-mode) +-.22 E F0 .676(\(a symbol; one of)3.426 F/F3 11/Courier@0 SF(above)3.426 E F0 +(,)A F3(below)3.427 E F0(,)A F3(top-if)3.427 E F0(,)A F3(bottom-if)3.427 E F0 +(,)A F3(opposite)72 296.4 Q F0(\).)A F1(\(get-text-pr)72 326.4 Q(operty)-.198 E +F2(window atom)4.583 E F1 232.805(\)p)C -.198(ro)462.244 326.4 S(cedur).198 E +(e)-.198 E F0(See)72 345 Q F2(XGetT)3.633 E -.22(ex)-1.012 G(tPr).22 E(operty) +-.495 E F0 6.383(.R)C .883(eturns a te)186.912 345 R .882 +(xt property as a list of strings or #f if the speci\214ed property)-.165 F +(does not e)72 360 Q(xist.)-.165 E F1(\(set-text-pr)72 390 Q(operty!)-.198 E F2 +(window value atom)4.583 E F1 203.787(\)p)C -.198(ro)462.244 390 S(cedur).198 E +(e)-.198 E F0(See)72 408.6 Q F2(XSetT)2.75 E -.22(ex)-1.012 G(tPr).22 E(operty) +-.495 E F0(.)A F2(value)5.5 E F0(is a list holding the items of the te)2.75 E +(xt property \(strings or symbols\).)-.165 E F1(\(wm-pr)72 438.6 Q(otocols) +-.198 E F2(window)4.583 E F1 274.033(\)p)C -.198(ro)462.244 438.6 S(cedur).198 +E(e)-.198 E F0(See)72 457.2 Q F2(XGetWMPr)2.75 E(otocols)-.495 E F0 5.5(.R)C +(eturns a v)189.436 457.2 Q(ector of atoms.)-.165 E F1(\(set-wm-pr)72 487.2 Q +(otocols!)-.198 E F2(window pr)4.583 E(otocols)-.495 E F1 210.068(\)p)C -.198 +(ro)462.244 487.2 S(cedur).198 E(e)-.198 E F0(See)72 505.8 Q F2(XSetWMPr)2.75 E +(otocols)-.495 E F0(.)A F2(pr)5.5 E(otocols)-.495 E F0(is a v)2.75 E +(ector of atoms.)-.165 E F1(\(wm-name)72 535.8 Q F2(window)4.583 E F1 291.556 +(\)p)C -.198(ro)462.244 535.8 S(cedur).198 E(e)-.198 E F0(See)72 554.4 Q F2 +(XGetT)3.607 E -.22(ex)-1.012 G(tPr).22 E(operty)-.495 E F0 6.357(.R)C .857 +(eturns the WM_N)186.86 554.4 R .857 +(AME property as a list of strings or #f if it does not)-.385 F -.165(ex)72 +569.4 S(ist.).165 E F1(\(set-wm-name!)72 599.4 Q F2(window name)4.583 E F1 +244.828(\)p)C -.198(ro)462.244 599.4 S(cedur).198 E(e)-.198 E F0(See)72 618 Q +F2(XSetT)2.75 E -.22(ex)-1.012 G(tPr).22 E(operty)-.495 E F0(.)A F2(name)5.5 E +F0(is a list of strings or symbols.)2.75 E F1(\(wm-icon-name)72 648 Q F2 +(window)4.583 E F1 268.335(\)p)C -.198(ro)462.244 648 S(cedur).198 E(e)-.198 E +F0(See)72 666.6 Q F2(XGetT)4.254 E -.22(ex)-1.012 G(tPr).22 E(operty)-.495 E F0 +7.004(.R)C 1.504(eturns the WM_ICON_N)188.154 666.6 R 1.504 +(AME property as a list of strings or #f if it)-.385 F(does not e)72 681.6 Q +(xist.)-.165 E EP +%%Page: 25 25 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(5-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(set-wm-icon-name!)72 87 Q/F2 11 +/Times-Italic@0 SF(window name)4.583 E F1 221.607(\)p)C -.198(ro)462.244 87 S +(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2(XSetT)2.75 E -.22(ex)-1.012 G(tPr) +.22 E(operty)-.495 E F0(.)A F2(name)5.5 E F0(is a list of strings or symbols.) +2.75 E F1(\(wm-client-machine)72 135.6 Q F2(window)4.583 E F1 248.172(\)p)C +-.198(ro)462.244 135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q F2(XGetT) +2.784 E -.22(ex)-1.012 G(tPr).22 E(operty)-.495 E F0(,)A F2(XGetWMClientMac) +2.784 E(hine)-.165 E F0 5.534(.R)C .034(eturns the WM_CLIENT_MA)296.898 154.2 R +.035(CHINE property)-.44 F(as a list of strings or #f if it does not e)72 169.2 +Q(xist.)-.165 E F1(\(set-wm-client-machine!)72 199.2 Q F2(window value)4.583 E +F1 201.444(\)p)C -.198(ro)462.244 199.2 S(cedur).198 E(e)-.198 E F0(See)72 +217.8 Q F2(XSetT)2.75 E -.22(ex)-1.012 G(tPr).22 E(operty)-.495 E F0(,)A F2 +(XSetWMClientMac)2.75 E(hine)-.165 E F0(.)A F2(value)5.5 E F0 +(is a list of strings or symbols.)2.75 E F1(\(wm-class)72 247.8 Q F2(window) +4.583 E F1 295.219(\)p)C -.198(ro)462.244 247.8 S(cedur).198 E(e)-.198 E F0 +(See)72 266.4 Q F2(XGetClassHint)3.465 E F0 6.214(.R)C .714 +(eturns a pair \(name and class\) each component of which is either a string) +174.266 266.4 R(or #f.)72 281.4 Q F1(\(set-wm-class!)72 311.4 Q F2 +(window name class)4.583 E F1 223.741(\)p)C -.198(ro)462.244 311.4 S(cedur).198 +E(e)-.198 E F0(See)72 330 Q F2(XSetClassHint)2.75 E F0(.)A F2(name)5.5 E F0 +(and)2.75 E F2(class)2.75 E F0(are strings or symbols.)2.75 E F1(\(wm-command) +72 360 Q F2(window)4.583 E F1 270.777(\)p)C -.198(ro)462.244 360 S(cedur).198 E +(e)-.198 E F0(See)72 378.6 Q F2(XGetCommand)7.989 E F0 5.239 +(\(in X11 Release 4 or ne)7.989 F 5.239(wer releases\).)-.275 F 5.239 +(Returns the v)378.223 378.6 R 5.24(alue of the)-.275 F +(WM_COMMAND property of the gi)72 393.6 Q -.165(ve)-.275 G 2.75(nw).165 G(indo) +261.893 393.6 Q 2.75(wa)-.275 G 2.75(sal)296.752 393.6 S(ist of strings.) +314.473 393.6 Q F1(\(set-wm-command!)72 423.6 Q F2(window command)4.583 E F1 +205.107(\)p)C -.198(ro)462.244 423.6 S(cedur).198 E(e)-.198 E F0(See)72 442.2 Q +F2(XSetCommand)2.75 E F0(.)A F2(command)5.5 E F0 +(is a list; each element is either a string or a symbol.)2.75 E F1 +(\(transient-f)72 472.2 Q(or)-.275 E F2(window)4.583 E F1 278.389(\)p)C -.198 +(ro)462.244 472.2 S(cedur).198 E(e)-.198 E F0(See)72 490.8 Q F2(XGetT)2.75 E +-.165(ra)-.605 G(nsientF).165 E(orHint)-1.155 E F0 5.5(.R)C(eturns a windo) +205.133 490.8 Q -.715(w.)-.275 G F1(\(set-transient-f)72 520.8 Q(or!)-.275 E F2 +(window pr)4.583 E(operty-window)-.495 E F1 180.203(\)p)C -.198(ro)462.244 +520.8 S(cedur).198 E(e)-.198 E F0(See)72 539.4 Q F2(XSetT)2.75 E -.165(ra)-.605 +G(nsientF).165 E(orHint)-1.155 E F0(.)A F1(\(wm-normal-hints)72 569.4 Q F2 +(window)4.583 E F1 256.103(\)p)C -.198(ro)462.244 569.4 S(cedur).198 E(e)-.198 +E F0(See)72 588 Q F2(XGetWMSizeHints)3.163 E F0 5.913(.R)C .413 +(eturns a list of hints.)189.536 588 R .412 +(Each element is set to the empty list if the corre-)5.913 F +(sponding hint has not been set for the speci\214ed windo)72 603 Q -.715(w.) +-.275 G .841(The elements of the list correspond to the follo)72 621.6 R .842 +(wing hints \(in this order\):)-.275 F F2(x)3.592 E F0(,)A F2(y)3.592 E F0(,)A +F2(width)3.592 E F0 3.592(,a)C(nd)461.908 621.6 Q F2(height)3.592 E F0 .305 +(\(program speci\214ed\);)72 636.6 R F2(x)3.055 E F0(,)A F2(y)3.055 E F0(,)A F2 +(width)3.055 E F0(and)3.055 E F2(height)3.055 E F0 .305(\(user speci\214ed\);) +3.055 F F2(min-width)3.055 E F0(and)3.055 E F2(min-height)3.055 E F0(;)A F2 +(max-width)3.055 E F0(and)72 651.6 Q F2(max-height)4.757 E F0(;)A F2(width-inc) +4.757 E F0(and)4.758 E F2(height-inc)4.758 E F0(;)A F2(min-aspect-x)4.758 E F0 +(,)A F2(min-aspect-y)4.758 E F0(,)A F2(max-aspect-x)4.758 E F0(and)4.758 E F2 +(max-)4.758 E(aspect-y)72 666.6 Q F0(;)A F2(base-width)3.211 E F0(and)3.211 E +F2(base-height)3.211 E F0 3.211(;a)C(nd)247.985 666.6 Q F2(gr)3.211 E(avity) +-.165 E F0 5.961(.A)C .461(ll elements are inte)309.847 666.6 R .461(gers e) +-.165 F .461(xcept for the v)-.165 F(alue)-.275 E(of)72 681.6 Q F2(gr)2.75 E +(avity)-.165 E F0(which is a symbol \(see the)2.75 E F2(window-gr)2.75 E(avity) +-.165 E F0(procedure abo)2.75 E -.165(ve)-.165 G(\).).165 E EP +%%Page: 26 26 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(6-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(set-wm-normal-hints!)72 87 Q/F2 11 +/Times-Italic@0 SF 2.75(.a)4.583 G -.407(rg)193.282 87 S(s).407 E F1 245.532 +(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2 +(XSetWMSizeHints)3.065 E F0 5.815(.F)C .315(or the format of the ar)185.512 +105.6 R .315(guments see)-.198 F F2(cr)3.065 E(eate-window)-.407 E F0(abo)3.065 +E -.165(ve)-.165 G 5.815(.A).165 G(ttrib)451.665 105.6 Q .316(utes are)-.22 F +F2(window)72 120.6 Q F0(\(mandatory\) and the names of the hints listed under) +2.75 E F2(wm-normal-hints)2.75 E F0(abo)2.75 E -.165(ve)-.165 G(.).165 E F1 +(\(wm-hints)72 150.6 Q F2(window)4.583 E F1 293.987(\)p)C -.198(ro)462.244 +150.6 S(cedur).198 E(e)-.198 E F0(See)72 169.2 Q F2(XGetWMHints)4.206 E F0 +6.955(.R)C 1.455(eturns a list of hints.)173.9 169.2 R 1.455 +(Each element is set to the empty list if the corre-)6.955 F +(sponding hint has not been set for the speci\214ed windo)72 184.2 Q -.715(w.) +-.275 G 1.719(The elements of the list correspond to the follo)72 202.8 R 1.719 +(wing hints \(in this order\):)-.275 F F2(input?)4.469 E F0(,)A F2 +(initial-state)4.469 E F0(,)A F2(icon-pixmap)72 217.8 Q F0(,)A F2(icon-window) +3.264 E F0(,)A F2(icon-x)3.264 E F0(,)A F2(icon-y)3.264 E F0(,)A F2(icon-mask) +3.264 E F0 3.264(,a)C(nd)318.968 217.8 Q F2(window-gr)3.264 E(oup)-.495 E F0 +6.014(.T)C .514(he v)412.396 217.8 R .513(alue of)-.275 F F2(input?)3.263 E F0 +(is)3.263 E 2.973(ab)72 232.8 S(oolean.)85.357 232.8 Q F2(initial-state)5.723 E +F0 .224(is a symbol \()2.973 F/F3 11/Courier@0 SF(dont-care)A F0(,)A F3(normal) +2.974 E F0(,)A F3(zoom)2.974 E F0(,)A F3(iconic)2.974 E F0(,)A F3(inactive) +2.974 E F0 2.974(\). The)B -.275(va)72 247.8 S .04(lues of).275 F F2 +(icon-pixmap)2.79 E F0(and)2.79 E F2(icon-mask)2.79 E F0 .04(are pixmaps.)2.79 +F F2(icon-window)5.54 E F0(and)2.79 E F2(window-gr)2.789 E(oup)-.495 E F0 .039 +(are windo)2.789 F(ws.)-.275 E F2(icon-x)72 262.8 Q F0(and)2.75 E F2(icon-y) +2.75 E F0(are inte)2.75 E(gers.)-.165 E F1(\(set-wm-hints!)72 292.8 Q F2 2.75 +(.a)4.583 G -.407(rg)155.398 292.8 S(s).407 E F1 283.416(\)p)C -.198(ro)462.244 +292.8 S(cedur).198 E(e)-.198 E F0(See)72 311.4 Q F2(XSetWMHints)4.541 E F0 +7.291(.F)C 1.792(or the format of the ar)170.743 311.4 R 1.792(guments see) +-.198 F F2(cr)4.542 E(eate-window)-.407 E F0(abo)4.542 E -.165(ve)-.165 G 7.292 +(.A).165 G(ttrib)450.189 311.4 Q 1.792(utes are)-.22 F F2(window)72 326.4 Q F0 +(\(mandatory\) and the names of the hints listed under)2.75 E F2(wm-hints)2.75 +E F0(abo)2.75 E -.165(ve)-.165 G(.).165 E F1(\(icon-sizes)72 356.4 Q F2(window) +4.583 E F1 293.382(\)p)C -.198(ro)462.244 356.4 S(cedur).198 E(e)-.198 E F0 +(See)72 375 Q F2(XGetIconSizes)3.821 E F0 6.571(.R)C 1.071(eturns a v)172.515 +375 R 1.07(ector of lists of six inte)-.165 F 1.07(gers \()-.165 F F2 +(min-width)A F0(,)A F2(min-height)3.82 E F0(,)A F2(max-width)3.82 E F0(,)A F2 +(max-height)72 390 Q F0(,)A F2(width-inc)2.75 E F0 2.75(,a)C(nd)178.931 390 Q +F2(height-inc)2.75 E F0(\).)A F1(\(set-icon-sizes!)72 420 Q F2 +(window icon-sizes)4.583 E F1 227.096(\)p)C -.198(ro)462.244 420 S(cedur).198 E +(e)-.198 E F0(See)72 438.6 Q F2(XSetIconSizes)2.75 E F0(.)A F2(icon-sizes)5.5 E +F0(is a v)2.75 E(ector of lists of six inte)-.165 E(gers \(see)-.165 E F2 +(icon-sizes)2.75 E F0(abo)2.75 E -.165(ve)-.165 G(\).).165 E F1 2.75(17. K)72 +468.6 R(eyboard Utility Functions)-.275 E(\(display-min-k)72 498.6 Q(eycode) +-.11 E F2(display)4.583 E F1 243.376(\)p)C -.198(ro)462.244 498.6 S(cedur).198 +E(e)-.198 E(\(display-max-k)72 513.6 Q(eycode)-.11 E F2(display)4.583 E F1 +241.55(\)p)C -.198(ro)462.244 513.6 S(cedur).198 E(e)-.198 E F0 +(Returns the minimum/maximum k)72 532.2 Q -.165(ey)-.11 G(code \(an inte).165 E +(ger\) for the gi)-.165 E -.165(ve)-.275 G 2.75(nd).165 G(isplay)375.116 532.2 +Q(.)-.715 E F1(\(display-k)72 562.2 Q(eysyms-per)-.11 E(-k)-.407 E(eycode)-.11 +E F2(display)4.583 E F1 202.962(\)p)C -.198(ro)462.244 562.2 S(cedur).198 E(e) +-.198 E(Retur)72 577.2 Q(ns the number of k)-.165 E(eysyms per k)-.11 E +(eycode f)-.11 E(or the gi)-.275 E -.11(ve)-.11 G 2.75(nd).11 G(isplay)350.982 +577.2 Q(.)-.77 E(\(string)72 607.2 Q/F4 11/Symbol SF(-)A F1(>k)A(eysym)-.11 E +F2(string)4.583 E F1 271.404(\)p)C -.198(ro)462.244 607.2 S(cedur).198 E(e) +-.198 E F0(See)72 625.8 Q F2(XStringT)2.875 E(oK)-1.012 E -.33(ey)-.385 G(sym) +.33 E F0(.)A F2(string)5.625 E F0 .125(is a string or a symbol.)2.875 F .126 +(Returns an inte)5.626 F .126(ger if)-.165 F F2(XStringT)2.876 E(oK)-1.012 E +-.33(ey)-.385 G(sym).33 E F0(suc-)2.876 E(ceeds, #f otherwise.)72 640.8 Q F1 +(\(k)72 670.8 Q(eysym)-.11 E F4(-)A F1(>string)A F2 -.11(ke)4.583 G(ysym)-.22 E +F1 265.761(\)p)C -.198(ro)462.244 670.8 S(cedur).198 E(e)-.198 E F0(See)72 +689.4 Q F2(XK)2.75 E -.33(ey)-.385 G(symT).33 E(oString)-1.012 E F0(.)A F2 -.11 +(ke)5.5 G(ysym)-.22 E F0(is an inte)2.75 E(ger)-.165 E 5.5(.R)-.605 G +(eturns #f if)279.251 689.4 Q F2(XK)2.75 E -.33(ey)-.385 G(symT).33 E(oString) +-1.012 E F0 -.11(fa)2.75 G(ils.).11 E EP +%%Page: 27 27 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(7-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(k)72 87 Q(eycode)-.11 E/F2 11/Symbol SF(-)A +F1(>k)A(eysym)-.11 E/F3 11/Times-Italic@0 SF(display k)4.583 E -.33(ey)-.11 G +(code inde).33 E(x)-.22 E F1 190.939(\)p)C -.198(ro)462.244 87 S(cedur).198 E +(e)-.198 E F0(See)72 105.6 Q F3(XK)2.75 E -.33(ey)-.385 G(codeT).33 E(oK)-1.012 +E -.33(ey)-.385 G(sym).33 E F0(.)A F3 -.11(ke)5.5 G(ycode)-.22 E F0(and)2.75 E +F3(inde)2.75 E(x)-.22 E F0(are inte)2.75 E(gers.)-.165 E F1(\(k)72 135.6 Q +(eysym)-.11 E F2(-)A F1(>k)A(eycode)-.11 E F3(display k)4.583 E -.33(ey)-.11 G +(sym).33 E F1 220.958(\)p)C -.198(ro)462.244 135.6 S(cedur).198 E(e)-.198 E F0 +(See)72 154.2 Q F3(XK)2.75 E -.33(ey)-.385 G(symT).33 E(oK)-1.012 E -.33(ey) +-.385 G(code).33 E F0(.)A F3 -.11(ke)5.5 G(ysym)-.22 E F0(is an inte)2.75 E +(ger)-.165 E(.)-.605 E F1(\(lookup-string)72 184.2 Q F3(display k)4.583 E -.33 +(ey)-.11 G(code mask).33 E F1 213.786(\)p)C -.198(ro)462.244 184.2 S(cedur).198 +E(e)-.198 E F0(See)72 202.8 Q F3(XLookupString)3.171 E F0(.)A F3 -.11(ke)5.921 +G(ycode)-.22 E F0 .421(is an inte)3.171 F(ger)-.165 E(.)-.605 E F3(mask)5.921 E +F0 .421(is a list of symbols \()3.171 F/F4 11/Courier@0 SF(shift)A F0(,)A F4 +(lock)3.171 E F0(,)A F4(control)3.17 E F0(,)A F4(mod1)72 217.8 Q F0(...)2.75 E +F4(mod5)2.75 E F0(,)A F4(button1)2.75 E F0(...)2.75 E F4(button5)2.75 E F0 2.75 +(,o)C(r)261.2 217.8 Q F4(any-modifier)2.75 E F0(\).)A F1(\(r)72 247.8 Q +(ebind-k)-.198 E(eysym)-.11 E F3(display k)4.583 E -.33(ey)-.11 G +(sym modi\214er).33 E 2.75(ss)-.11 G(tring)266.674 247.8 Q F1 164.396(\)p)C +-.198(ro)462.244 247.8 S(cedur).198 E(e)-.198 E F0(See)72 266.4 Q F3(XRebindK) +2.75 E -.33(ey)-.385 G(sym).33 E F0(.)A F3 -.11(ke)5.5 G(ysym)-.22 E F0 +(is an inte)2.75 E(ger)-.165 E(.)-.605 E F3(modi\214er)5.5 E(s)-.11 E F0 +(is a v)2.75 E(ector of inte)-.165 E(gers.)-.165 E F1(\(r)72 296.4 Q(efr)-.198 +E(esh-k)-.198 E(eyboard-mapping)-.11 E F3(window type)4.583 E F1 190.312(\)p)C +-.198(ro)462.244 296.4 S(cedur).198 E(e)-.198 E F0(See)72 315 Q F3(XRefr)5.47 E +(eshK)-.407 E -.33(ey)-.385 G(boar).33 E(dMapping)-.407 E F0(.)A F3(type)8.22 E +F0 2.72(is a symbol \()5.47 F F4(modifier)A F0(,)A F4(keyboard)5.471 E F0 5.471 +(,o)C(r)442.253 315 Q F4(pointer)5.471 E F0(\).)A(In)72 330 Q -.22(vo)-.44 G +-.11(ke).22 G(s).11 E F3(XRefr)4.419 E(eshK)-.407 E -.33(ey)-.385 G(boar).33 E +(dMapping)-.407 E F0 1.669(with a f)4.419 F(ak)-.11 E 1.668(ed e)-.11 F -.165 +(ve)-.275 G 1.668(nt structure holding the speci\214ed windo).165 F(w)-.275 E +(and request type.)72 345 Q F1 2.75(18. Other)72 375 R(Utility Functions)2.75 E +(\(xlib-r)72 405 Q(elease-4-or)-.198 E -.917(-later? \))-.407 F(pr)456.128 405 +Q(ocedur)-.198 E(e)-.198 E F0(Returns al)72 423.6 Q -.11(wa)-.11 G(ys #t.).11 E +F1(\(xlib-r)72 453.6 Q(elease-5-or)-.198 E -.917(-later? \))-.407 F(pr)456.128 +453.6 Q(ocedur)-.198 E(e)-.198 E F0 .598(Returns #t if)72 472.2 R 3.348(ft) +-.275 G .598(he Xlib e)137.99 472.2 R .598(xtension is link)-.165 F .599 +(ed together with the X11 Release 5 Xlib or later v)-.11 F(ersions)-.165 E +(of the Xlib)72 487.2 Q(.)-.44 E F1(\(xlib-r)72 517.2 Q(elease-6-or)-.198 E +-.917(-later? \))-.407 F(pr)456.128 517.2 Q(ocedur)-.198 E(e)-.198 E F0 .599 +(Returns #t if)72 535.8 R 3.349(ft)-.275 G .599(he Xlib e)137.993 535.8 R .599 +(xtension is link)-.165 F .598 +(ed together with the X11 Release 6 Xlib or later v)-.11 F(ersions)-.165 E +(of the Xlib)72 550.8 Q(.)-.44 E F1(\(get-default)72 580.8 Q F3(display pr) +4.583 E -.11(og)-.495 G -.165(ra).11 G 2.75(mo).165 G(ption)211.465 580.8 Q F1 +218.384(\)p)C -.198(ro)462.244 580.8 S(cedur).198 E(e)-.198 E F0(See)72 599.4 Q +F3(XGetDefault)3.025 E F0(.)A F3(pr)5.775 E -.11(og)-.495 G -.165(ra).11 G(m) +.165 E F0(and)3.025 E F3(option)3.025 E F0 .275(are strings or symbols.)3.025 F +.276(Returns a string of #f if the option)5.776 F(does not e)72 614.4 Q +(xist for the speci\214ed program.)-.165 E F1(\(r)72 644.4 Q(esour)-.198 E +(ce-manager)-.198 E(-string)-.407 E F3(display)4.583 E F1 224.555(\)p)C -.198 +(ro)462.244 644.4 S(cedur).198 E(e)-.198 E F0(See)72 663 Q F3(XResour)3.872 E +(ceMana)-.407 E -.11(ge)-.11 G(rString).11 E F0 6.622(.R)C 1.122 +(eturns a string or #f if the RESOURCE_MAN)222.711 663 R -.44(AG)-.385 G 1.121 +(ER property).44 F(does not e)72 678 Q(xist on the root windo)-.165 E -.715(w.) +-.275 G EP +%%Page: 28 28 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(8-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(parse-geometry)72 87 Q/F2 11/Times-Italic@0 +SF(string)4.583 E F1 273.241(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 E +F0(See)72 105.6 Q F2(XP)3.658 E(ar)-.88 E(seGeometry)-.11 E F0 6.408(.R)C .908 +(eturns a list of six elements: tw)182.804 105.6 R 3.658(ob)-.11 G .909 +(ooleans indicating whether x or or y)339.684 105.6 R .105(are ne)72 120.6 R +-.055(ga)-.165 G(ti).055 E .435 -.165(ve a)-.275 H .105(nd four inte).165 F +.105(gers \(x, y)-.165 F 2.855(,w)-.715 G .105(idth, and height\).)238.285 +120.6 R .105(Each of the elements can be #f to indicate)5.605 F +(that the respecti)72 135.6 Q .33 -.165(ve v)-.275 H(alue w)-.11 E +(as not found in the string.)-.11 E F1(\(parse-color)72 165.6 Q F2 +(colormap string)4.583 E F1 248.48(\)p)C -.198(ro)462.244 165.6 S(cedur).198 E +(e)-.198 E F0(See)72 184.2 Q F2(XP)2.75 E(ar)-.88 E(seColor)-.11 E F0 5.5(.R)C +(eturns an object of type)163.289 184.2 Q F2(color)2.75 E F0(or #f if)2.75 E F2 +(XP)2.75 E(ar)-.88 E(seColor)-.11 E F0 -.11(fa)2.75 G(ils.).11 E F1(\(stor)72 +214.2 Q(e-b)-.198 E(uffer)-.22 E F2(display bytes b)4.583 E(uf)-.22 E(fer)-.198 +E F1 230.693(\)p)C -.198(ro)462.244 214.2 S(cedur).198 E(e)-.198 E F0(See)72 +232.8 Q F2(XStor)2.75 E(eBuf)-.407 E(fer)-.198 E F0(.)A F2(bytes)5.5 E F0 +(is a string;)2.75 E F2 -.22(bu)2.75 G -.198(ff).22 G(er).198 E F0(is an inte) +2.75 E(ger between 0 and 7.)-.165 E F1(\(stor)72 262.8 Q(e-bytes)-.198 E F2 +(display bytes)4.583 E F1 263.968(\)p)C -.198(ro)462.244 262.8 S(cedur).198 E +(e)-.198 E F0(See)72 281.4 Q F2(XStor)2.75 E(eBytes)-.407 E F0(.)A F2(bytes)5.5 +E F0(is a string.)2.75 E F1(\(fetch-b)72 311.4 Q(uffer)-.22 E F2(display b) +4.583 E(uf)-.22 E(fer)-.198 E F1 255.85(\)p)C -.198(ro)462.244 311.4 S(cedur) +.198 E(e)-.198 E F0(See)72 330 Q F2(XF)2.75 E(etc)-.825 E(hBuf)-.165 E(fer) +-.198 E F0(.)A F2 -.22(bu)5.5 G -.198(ff).22 G(er).198 E F0(is an inte)2.75 E +(ger between 0 and 7.)-.165 E(Returns a string.)5.5 E F1(\(fetch-bytes)72 360 Q +F2(display)4.583 E F1 289.125(\)p)C -.198(ro)462.244 360 S(cedur).198 E(e)-.198 +E F0(See)72 378.6 Q F2(XF)2.75 E(etc)-.825 E(hBytes)-.165 E F0 5.5(.R)C +(eturns a string.)160.825 378.6 Q F1(\(r)72 408.6 Q(otate-b)-.198 E(uffers)-.22 +E F2(display delta)4.583 E F1 250.746(\)p)C -.198(ro)462.244 408.6 S(cedur).198 +E(e)-.198 E F0(See)72 427.2 Q F2(XRotateBuf)2.75 E(fer)-.198 E(s)-.11 E F0(.)A +F2(delta)5.5 E F0(is an inte)2.75 E(ger \(the amount to rotate the b)-.165 E +(uf)-.22 E(fers\).)-.275 E F1(\(with)72 457.2 Q F2(object . body-forms)4.583 E +F1 283.515(\)s)C(yntax)477.721 457.2 Q F2(with)72 475.8 Q F0 1.16(is a macro.) +3.91 F F2(object)6.66 E F0 1.16(must be a dra)3.91 F -.11(wa)-.165 G 1.16 +(ble, a graphics conte).11 F 1.16(xt, or a font.)-.165 F(The)6.66 E F2 +(body-forms)3.91 E F0(are)3.91 E -.275(eva)72 490.8 S(luated in order;).275 E +F2(with)2.75 E F0(returns the v)2.75 E(alue of the last body-form.)-.275 E -.44 +(Wi)72 509.4 S .271(thin the scope of the).44 F F2(with)3.021 E F0 3.021(,t)C +.271(he \214rst call to an accessor function accessing)206.099 509.4 R F2 +(object)3.021 E F0 .271(\(such as)3.021 F/F3 11/Courier@0 SF(win-)3.02 E(dow-) +72 524.4 Q F2(attrib)A(ute)-.22 E F0(or)4.76 E F3(font-)4.761 E F2(attrib)A +(ute)-.22 E F0 4.761(\)c)C 2.011 +(auses the result of the corresponding Xlib function to be)238.742 524.4 R .406 +(retained in a cache; subsequent calls just return the v)72 539.4 R .406 +(alue from the cache.)-.275 F(Lik)5.906 E -.275(ew)-.11 G .406 +(ise, calls to Xlib).275 F 3.987(functions for mutator functions modifying)72 +554.4 R F2(object)6.738 E F0 3.988(\(such as)6.738 F F3(set-window-)6.738 E F2 +(attrib)A(ute)-.22 E F3(!)A F0 9.488(\)a)C(re)495.453 554.4 Q .554 +(delayed until e)72 569.4 R .554(xit of the)-.165 F F2(with)3.304 E F0 .553 +(body or until an accessor function is called and the cached data for)3.304 F +(this accessor function has been in)72 584.4 Q -.275(va)-.44 G +(lidated by the call to a mutator function.).275 E F1 2.75(19. Ser)72 614.4 R +-.11(ve)-.11 G 2.75(rE).11 G(xtension Functions)132.269 614.4 Q +(\(list-extensions)72 644.4 Q F2(display)4.583 E F1 274.44(\)p)C -.198(ro) +462.244 644.4 S(cedur).198 E(e)-.198 E F0(See)72 663 Q F2(XListExtensions)2.75 +E F0 5.5(.R)C(eturns a v)177.116 663 Q(ector of strings.)-.165 E EP +%%Page: 29 29 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2)276.087 51 S 2.75(9-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(query-extension)72 87 Q/F2 11 +/Times-Italic@0 SF(display name)4.583 E F1 238.701(\)p)C -.198(ro)462.244 87 S +(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2(XQueryExtension)3.437 E F0(.)A F2 +(name)6.187 E F0 .687(is a string or a symbol.)3.437 F .688 +(Returns a list of three elements: the major)6.187 F .335(opcode \(an inte)72 +120.6 R .334(ger\) or #f if the e)-.165 F .334 +(xtension has no major opcode, the base e)-.165 F -.165(ve)-.275 G .334 +(nt type code \(an inte-).165 F .268(ger\) of #f if the e)72 135.6 R .268 +(xtension has no additional e)-.165 F -.165(ve)-.275 G .269 +(nt types, and the base error code \(an inte).165 F .269(ger\) of #f)-.165 F +.959(if the e)72 150.6 R .959(xtension has no additional error codes.)-.165 F +F2(query-e)6.458 E(xtension)-.22 E F0 .958(returns #f if the speci\214ed e) +3.708 F(xten-)-.165 E(sion is not present.)72 165.6 Q F1 2.75(20. Err)72 195.6 +R(or Handling)-.198 E(x-err)72 225.6 Q(or)-.198 E 316.929(-handler v)-.407 F +(ariable)-.11 E F0(See)72 244.2 Q F2(XSetErr)4.18 E(orHandler)-.495 E F0 6.93 +(.I)C 4.18(fa)186.796 244.2 S 4.18(ne)199.523 244.2 S 1.43(rror e)214.087 244.2 +R -.165(ve)-.275 G 1.431(nt is recei).165 F -.165(ve)-.275 G 4.181(da).165 G +1.431(nd the global v)319.723 244.2 R(ariable)-.275 E F2(x-err)4.181 E(or)-.495 +E(-handler)-.22 E F0(is)4.181 E .853 +(bound to a compound procedure, this procedure is in)72 259.2 R -.22(vo)-.44 G +-.11(ke).22 G 3.602(dw).11 G .852(ith the follo)348.358 259.2 R .852(wing ar) +-.275 F .852(guments: a dis-)-.198 F(play)72 274.2 Q 2.818(,t)-.715 G .068 +(he serial number of the f)98.853 274.2 R .068(ailed request \(an inte)-.11 F +.068(ger\), the error code \(either an inte)-.165 F .069(ger or one of)-.165 F +.812(the symbols)72 289.2 R/F3 11/Courier@0 SF(bad-request)3.562 E F0(,)A F3 +(bad-value)3.562 E F0(,)A F3(bad-window)3.562 E F0(,)A F3(bad-pixmap)3.562 E F0 +(,)A F3(bad-atom)3.562 E F0(,)A F3(bad-)3.562 E(cursor)72 304.2 Q F0(,)A F3 +(bad-font)5.45 E F0(,)A F3(bad-match)5.45 E F0(,)A F3(bad-drawable)5.45 E F0(,) +A F3(bad-access)5.45 E F0(,)A F3(bad-alloc)5.45 E F0(,)A F3(bad-)5.45 E(color) +72 319.2 Q F0(,)A F3(bad-gcontext)118.732 319.2 Q F0(,)A F3(bad-id-choice) +211.663 319.2 Q F0(,)A F3(bad-name)311.194 319.2 Q F0(,)A F3(bad-length)377.725 +319.2 Q F0 10.981(,o)C(r)462.956 319.2 Q F3(bad-)477.6 319.2 Q(implementation) +72 334.2 Q F0 3.223(\), the major and minor op-code of the f)B 3.223 +(ailed request \(inte)-.11 F 3.223(gers\), and a)-.165 F(resource-ID \(an inte) +72 349.2 Q(ger\).)-.165 E 1.364(If an error e)72 367.8 R -.165(ve)-.275 G 1.364 +(nt is recei).165 F -.165(ve)-.275 G 4.114(da).165 G 1.364(nd this v)208.191 +367.8 R 1.364(ariable is not bound to a compound procedure, the Xlib)-.275 F +(def)72 382.8 Q(ault error handler is in)-.11 E -.22(vo)-.44 G -.11(ke).22 G +2.75(d. The).11 F(initial v)2.75 E(alue of this v)-.275 E +(ariable is the empty list.)-.275 E F1(x-fatal-err)72 412.8 Q(or)-.198 E +291.882(-handler v)-.407 F(ariable)-.11 E F0(See)72 431.4 Q F2(XSetIOErr)3.039 +E(orHandler)-.495 E F0 5.789(.I)C 3.039(faf)196.119 431.4 S .29 +(atal I/O error occurs and the global v)214.297 431.4 R(ariable)-.275 E F2 +(x-fatal-err)3.04 E(or)-.495 E(-handler)-.22 E F0 1.206 +(is bound to a compound procedure, this procedure is in)72 446.4 R -.22(vo)-.44 +G -.11(ke).22 G 3.955(dw).11 G 1.205(ith a display as ar)362.829 446.4 R 3.955 +(gument. The)-.198 F .711(procedure must in)72 461.4 R -.22(vo)-.44 G -.11(ke) +.22 G F2 -.22(ex)3.571 G(it).22 E F0 6.211(.I)C 3.461(faf)205.216 461.4 S .712 +(atal error occurs and this v)224.238 461.4 R .712 +(ariable is not bound to a compound)-.275 F .156 +(procedure, or if the procedure returns, the Xlib def)72 476.4 R .156(ault f) +-.11 F .156(atal error handler is in)-.11 F -.22(vo)-.44 G -.11(ke).22 G 2.906 +(da).11 G .155(nd the inter)450.142 476.4 R(-)-.22 E +(preter terminates with an e)72 491.4 Q(xit code of 1.)-.165 E(The initial v) +5.5 E(alue of this v)-.275 E(ariable is the empty list.)-.275 E F1 2.75 +(21. Interaction)72 521.4 R(with the Garbage Collector)2.75 E F0 2.28 +(The Scheme g)97 540 R 2.28(arbage collector destro)-.055 F 2.28 +(ys objects of type)-.11 F F2(colormap)5.03 E F0(,)A F2(cur)5.03 E(sor)-.11 E +F0(,)A F2(display)5.03 E F0(,)A F2(font)5.03 E F0(,)A F2(gconte)72 555 Q(xt) +-.22 E F0(,)A F2(pixmap)4.554 E F0 4.554(,o)C(r)161.54 555 Q F2(window)4.554 E +F0 1.804(that are not longer accessible from within the Scheme program.)4.554 F +.874(This is done by in)72 570 R -.22(vo)-.44 G .875(king the function).22 F F2 +(fr)3.625 E(ee-colormap)-.407 E F0(,)A F2(fr)3.625 E(ee-cur)-.407 E(sor)-.11 E +F0(,)A F2(close-display)3.625 E F0(,)A F2(close-font)3.625 E F0(,)A F2(fr)3.625 +E(ee-)-.407 E(gconte)72 585 Q(xt)-.22 E F0(,)A F2(fr)2.787 E(ee-pixmap)-.407 E +F0 2.787(,o)C(r)178.367 585 Q F2(destr)2.786 E(oy-window)-.495 E F0 2.786(,r)C +(especti)263.799 585 Q -.165(ve)-.275 G(ly).165 E 2.786(,w)-.715 G .036 +(ith the object to be destro)325.611 585 R .036(yed as an ar)-.11 F(gu-)-.198 E +(ment.)72 600 Q 1.154(The g)97 618.6 R 1.154(arbage collector only destro)-.055 +F 1.154(ys objects that ha)-.11 F 1.484 -.165(ve b)-.22 H 1.154 +(een created from with the Scheme).165 F .078(program \(by functions lik)72 +633.6 R(e)-.11 E F2(cr)2.828 E(eate-pixmap)-.407 E F0(or)2.828 E F2 +(open-display)2.828 E F0 2.828(\). Objects)B .077(that ha)2.828 F .407 -.165 +(ve b)-.22 H .077(een obtained from).165 F 1.024 +(the Xlib through functions lik)72 648.6 R(e)-.11 E F2 +(display-default-colormap)3.774 E F0 1.025(\(and are o)3.775 F 1.025 +(wned by the Xlib internals\),)-.275 F(are ignored by the g)72 663.6 Q +(arbage collector)-.055 E(.)-.605 E .342(Programmers must mak)97 682.2 R 3.092 +(es)-.11 G .342(ure that an object is accessible during the object')214.934 +682.2 R 3.091(se)-.605 G .341(ntire lifetime,)443.775 682.2 R 1.119 +(otherwise future runs of the g)72 697.2 R 1.12 +(arbage collector can result in undesired termination of the object.)-.055 F +.518(One must be especially careful when results of functions that create ne)72 +712.2 R 3.267(wo)-.275 G .517(bjects \(such as)404.802 712.2 R F2(cr)3.267 E +(eate-)-.407 E(window)72 727.2 Q F0 2.75(\)a)C +(re ignored or assigned to local v)117.529 727.2 Q(ariables as in)-.275 E EP +%%Page: 30 30 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(0-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(define dpy \(open-display\)\))100.346 94.503 Q +(\(define root \(display-root-window dpy\)\))100.346 108.503 Q +(\(do \(\(x 0 \(+ x 10\)\) \(y 0 \(+ y 10\)\)\) \(\(= x 50\)\))100.346 129.503 +Q(\(let \(\(win)112.346 143.503 Q +(\(create-window 'parent root 'x x 'y y 'width 20 'height 20\)\)\))160.346 +157.503 Q(\(manage-window win\)\)\))124.346 171.503 Q F0 2.028(In this e)97 +197.103 R 2.028(xample, after termination of the do-loop, the g)-.165 F 2.029 +(arbage collector will destro)-.055 F 4.779(yt)-.11 G(he)493.616 197.103 Q(ne) +72 212.103 Q .161(wly created windo)-.275 F .161(ws, as the)-.275 F 2.911(ya) +-.165 G .161(re not accessible from within the program.)219.941 212.103 R .16 +(If this is not desired,)5.66 F .013(the windo)72 227.103 R .013 +(ws could be put into a v)-.275 F .013(ariable \(for instance, be)-.275 F/F2 11 +/Times-Italic@0 SF(consed)2.763 E F0 .014 +(into a list\) that is de\214ned outside)2.763 F(of the body of the loop.)72 +242.103 Q EP +%%Page: 31 31 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(1-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 13/Times-Bold@0 SF(Index)272.108 123 Q(A)72 174 Q F0(after)72 +204 Q(-function,)-.22 E/F2 12/Times-Bold@0 SF(4)2.75 E F0(alloc-color)72 219 Q +(,)-.44 E F2(9)2.75 E F0(alloc-named-color)72 234 Q(,)-.44 E F2(9)2.75 E F0 +(allo)72 249 Q(w-e)-.275 E -.165(ve)-.275 G(nts,).165 E F2(19)2.75 E F0 +(atom-name,)72 264 Q F2(8)2.75 E F0(atom?,)72 279 Q F2(7)2.75 E F1(B)72 309 Q +F0(bell,)72 339 Q F2(21)2.75 E F0(black-pix)72 354 Q(el,)-.165 E F2(10)2.75 E +F1(C)72 384 Q F0(change-acti)72 414 Q -.165(ve)-.275 G(-pointer).165 E(-grab,) +-.22 E F2(19)2.75 E F0(change-property)72 429 Q(,)-.715 E F2(8)2.75 E F0 +(change-sa)72 444 Q -.165(ve)-.22 G(-set,).165 E F2(21)2.75 E F0(char)72 459 Q +(-ascent,)-.22 E F2(16)2.75 E F0(char)72 474 Q(-descent,)-.22 E F2(16)2.75 E F0 +(char)72 489 Q(-lbearing,)-.22 E F2(16)2.75 E F0(char)72 504 Q(-rbearing,)-.22 +E F2(16)2.75 E F0(char)72 519 Q(-width,)-.22 E F2(16)2.75 E F0 +(circulate-subwindo)72 534 Q(ws,)-.275 E F2(7)2.75 E F0(clear)72 549 Q(-area,) +-.22 E F2(13)2.75 E F0(clear)72 564 Q(-windo)-.22 E -.715(w,)-.275 G F2(7)3.465 +E F0(close-display)72 579 Q(,)-.715 E F2(2)2.75 E F0(close-font,)72 594 Q F2 +(15)2.75 E F0(color)72 609 Q(-r)-.22 E(gb-v)-.198 E(alues,)-.275 E F2(9)2.75 E +F0(color?,)72 624 Q F2(9)2.75 E F0(colormap-display)72 639 Q(,)-.715 E F2(10) +2.75 E F0(colormap?,)72 654 Q F2(9)2.75 E F0(con)72 669 Q -.165(ve)-.44 G +(rt-selection,).165 E F2(9)2.75 E F0(cop)72 684 Q(y-area,)-.11 E F2(13)2.75 E +F0(cop)72 699 Q(y-gconte)-.11 E(xt,)-.165 E F2(11)2.75 E F0(cop)72 714 Q +(y-plane,)-.11 E F2(14)2.75 E F0(create-bitmap-from-data,)72 729 Q F2(10)2.75 E +F0(create-cursor)302.4 174 Q(,)-.44 E F2(18)2.75 E F0(create-font-cursor)302.4 +189 Q(,)-.44 E F2(18)2.75 E F0(create-gconte)302.4 204 Q(xt,)-.165 E F2(11)2.75 +E F0(create-glyph-cursor)302.4 219 Q(,)-.44 E F2(18)2.75 E F0(create-pixmap,) +302.4 234 Q F2(10)2.75 E F0(create-pixmap-from-bitmap-data,)302.4 249 Q F2(10) +2.75 E F0(create-windo)302.4 264 Q -.715(w,)-.275 G F2(4)3.465 E F0 2.75(,2)C +(4, 26)389.272 264 Q(cursor)302.4 279 Q(-display)-.22 E(,)-.715 E F2(18)2.75 E +F0(cursor?,)302.4 294 Q F2(18)2.75 E F1(D)302.4 324 Q F0(de\214ne-cursor)302.4 +354 Q(,)-.44 E F2(18)2.75 E F0(delete-property)302.4 369 Q(,)-.715 E F2(8)2.75 +E F0(destro)302.4 384 Q(y-subwindo)-.11 E(ws,)-.275 E F2(6)2.75 E F0(destro) +302.4 399 Q(y-windo)-.11 E -.715(w,)-.275 G F2(6)3.465 E F0 +(display-bitmap-bit-order)302.4 414 Q(,)-.44 E F2(3)2.75 E F0 +(display-bitmap-pad,)302.4 429 Q F2(3)2.75 E F0(display-bitmap-unit,)302.4 444 +Q F2(3)2.75 E F0(display-cells,)302.4 459 Q F2(2)2.75 E F0(display-colormap,) +302.4 474 Q F2(2)2.75 E F0(display-def)302.4 489 Q(ault-colormap,)-.11 E F2(2) +2.75 E F0(display-def)302.4 504 Q(ault-depth,)-.11 E F2(2)2.75 E F0 +(display-def)302.4 519 Q(ault-gconte)-.11 E(xt,)-.165 E F2(2)2.75 E F0 +(display-def)302.4 534 Q(ault-root-windo)-.11 E -.715(w,)-.275 G F2(2)3.465 E +F0(display-def)302.4 549 Q(ault-screen-number)-.11 E(,)-.44 E F2(2)2.75 E F0 +(display-\215ush-output,)302.4 564 Q F2(3)2.75 E F0(display-height,)302.4 579 Q +F2(3)2.75 E F0(display-height-mm,)302.4 594 Q F2(3)2.75 E F0 +(display-image-byte-order)302.4 609 Q(,)-.44 E F2(3)2.75 E F0(display-k)302.4 +624 Q -.165(ey)-.11 G(syms-per).165 E(-k)-.22 E -.165(ey)-.11 G(code,).165 E F2 +(26)2.75 E F0(display-max-k)302.4 639 Q -.165(ey)-.11 G(code,).165 E F2(26)2.75 +E F0(display-min-k)302.4 654 Q -.165(ey)-.11 G(code,).165 E F2(26)2.75 E F0 +(display-motion-b)302.4 669 Q(uf)-.22 E(fer)-.275 E(-size,)-.22 E F2(3)2.75 E +F0(display-planes,)302.4 684 Q F2(2)2.75 E F0(display-protocol-v)302.4 699 Q +(ersion,)-.165 E F2(2)2.75 E F0(display-root-windo)302.4 714 Q -.715(w,)-.275 G +F2(2)3.465 E F0(display-screen-count,)302.4 729 Q F2(2)2.75 E EP +%%Page: 32 32 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(2-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(display-string,)72 87 Q/F1 12/Times-Bold@0 SF(2)2.75 E F0 +(display-v)72 102 Q(endor)-.165 E(,)-.44 E F1(2)2.75 E F0(display-w)72 117 Q +(ait-output,)-.11 E F1(3)2.75 E F0(display-width,)72 132 Q F1(3)2.75 E F0 +(display-width-mm,)72 147 Q F1(3)2.75 E F0(display?,)72 162 Q F1(1)2.75 E F0 +(dra)72 177 Q(w-arc,)-.165 E F1(14)2.75 E F0(dra)72 192 Q(w-arcs,)-.165 E F1 +(15)2.75 E F0(dra)72 207 Q(w-image-te)-.165 E(xt,)-.165 E F1(17)2.75 E F0(dra) +72 222 Q(w-line,)-.165 E F1(14)2.75 E F0(dra)72 237 Q(w-lines,)-.165 E F1(14) +2.75 E F0(dra)72 252 Q(w-point,)-.165 E F1(14)2.75 E F0(dra)72 267 Q(w-points,) +-.165 E F1(14)2.75 E F0 2.75(,1)C(5)152.882 267 Q(dra)72 282 Q(w-poly-te)-.165 +E(xt,)-.165 E F1(17)2.75 E F0(dra)72 297 Q(w-rectangle,)-.165 E F1(14)2.75 E F0 +(dra)72 312 Q(w-rectangles,)-.165 E F1(14)2.75 E F0(dra)72 327 Q(w-se)-.165 E +(gments,)-.165 E F1(14)2.75 E F0(dra)72 342 Q -.11(wa)-.165 G(ble-border).11 E +(-width,)-.22 E F1(6)2.75 E F0(dra)72 357 Q -.11(wa)-.165 G(ble-depth,).11 E F1 +(6)2.75 E F0(dra)72 372 Q -.11(wa)-.165 G(ble-height,).11 E F1(6)2.75 E F0(dra) +72 387 Q -.11(wa)-.165 G(ble-root,).11 E F1(6)2.75 E F0(dra)72 402 Q -.11(wa) +-.165 G(ble-width,).11 E F1(6)2.75 E F0(dra)72 417 Q -.11(wa)-.165 G(ble-x,).11 +E F1(6)2.75 E F0(dra)72 432 Q -.11(wa)-.165 G(ble-y).11 E(,)-.715 E F1(6)2.75 E +F0(dra)72 447 Q -.11(wa)-.165 G(ble?,).11 E F1(4)2.75 E/F2 13/Times-Bold@0 SF +(E)72 477 Q F0(Ev)72 507 Q(ent types#)-.165 E -.22(bu)80.25 522 S +(tton-press, 22).22 E -.22(bu)80.25 537 S(tton-release, 22).22 E +(circulate-notify)80.25 552 Q 2.75(,2)-.715 G(3)158.35 552 Q +(circulate-request, 23)80.25 567 Q(client-message, 23)80.25 582 Q +(colormap-notify)80.25 597 Q 2.75(,2)-.715 G(3)162.024 597 Q +(con\214gure-notify)80.25 612 Q 2.75(,2)-.715 G(3)162.024 612 Q +(con\214gure-request, 23)80.25 627 Q(create-notify)80.25 642 Q 2.75(,2)-.715 G +(2)146.734 642 Q(destro)80.25 657 Q(y-notify)-.11 E 2.75(,2)-.715 G(2)152.751 +657 Q(enter)80.25 672 Q(-notify)-.22 E 2.75(,2)-.715 G(2)142.246 672 Q -.165 +(ex)80.25 687 S(pose, 22).165 E(focus-in, 22)80.25 702 Q(focus-out, 22)80.25 +717 Q(graphics-e)80.25 732 Q(xpose, 22)-.165 E(gra)310.65 87 Q(vity-notify)-.22 +E 2.75(,2)-.715 G(3)381.82 87 Q -.11(ke)310.65 102 S(y-press, 22)-.055 E -.11 +(ke)310.65 117 S(y-release, 22)-.055 E -.11(ke)310.65 132 S(ymap-notify)-.055 E +2.75(,2)-.715 G(2)385.428 132 Q(lea)310.65 147 Q -.165(ve)-.22 G(-notify).165 E +2.75(,2)-.715 G(2)373.702 147 Q(map-notify)310.65 162 Q 2.75(,2)-.715 G(3) +369.819 162 Q(map-request, 23)310.65 177 Q(mapping-notify)310.65 192 Q 2.75(,2) +-.715 G(3)389.377 192 Q(motion-notify)310.65 207 Q 2.75(,2)-.715 G(2)382.051 +207 Q(no-e)310.65 222 Q(xpose, 22)-.165 E(property-notify)310.65 237 Q 2.75(,2) +-.715 G(3)388.145 237 Q(reparent-notify)310.65 252 Q 2.75(,2)-.715 G(3)386.913 +252 Q(resize-request, 23)310.65 267 Q(selection-clear)310.65 282 Q 2.75(,2)-.44 +G(3)385.351 282 Q(selection-notify)310.65 297 Q 2.75(,2)-.715 G(3)389.982 297 Q +(selection-request, 23)310.65 312 Q(unmap-notify)310.65 327 Q 2.75(,2)-.715 G +(3)380.819 327 Q(visibility-notify)310.65 342 Q 2.75(,2)-.715 G(2)390.004 342 Q +-2.365 -.275(ev e)302.4 357 T(nt-listen,).275 E F1(21)2.75 E F0 -.165(ex)302.4 +372 S(tents-ascent,).165 E F1(17)2.75 E F0 -.165(ex)302.4 387 S(tents-descent,) +.165 E F1(17)2.75 E F0 -.165(ex)302.4 402 S(tents-lbearing,).165 E F1(17)2.75 E +F0 -.165(ex)302.4 417 S(tents-rbearing,).165 E F1(17)2.75 E F0 -.165(ex)302.4 +432 S(tents-width,).165 E F1(17)2.75 E F2(F)302.4 462 Q F0(fetch-b)302.4 492 Q +(uf)-.22 E(fer)-.275 E(,)-.44 E F1(28)2.75 E F0(fetch-bytes,)302.4 507 Q F1(28) +2.75 E F0(\214ll-arc,)302.4 522 Q F1(14)2.75 E F0(\214ll-arcs,)302.4 537 Q F1 +(15)2.75 E F0(\214ll-polygon,)302.4 552 Q F1(15)2.75 E F0(\214ll-rectangle,) +302.4 567 Q F1(14)2.75 E F0(\214ll-rectangles,)302.4 582 Q F1(14)2.75 E F0 +(\214nd-atom,)302.4 597 Q F1(8)2.75 E F0(font-all-chars-e)302.4 612 Q(xist?,) +-.165 E F1(16)2.75 E F0(font-ascent,)302.4 627 Q F1(16)2.75 E F0(font-def)302.4 +642 Q(ault-char)-.11 E(,)-.44 E F1(16)2.75 E F0(font-descent,)302.4 657 Q F1 +(16)2.75 E F0(font-direction,)302.4 672 Q F1(16)2.75 E F0(font-display)302.4 +687 Q(,)-.715 E F1(15)2.75 E F0(font-max-byte1,)302.4 702 Q F1(16)2.75 E F0 +(font-max-byte2,)302.4 717 Q F1(16)2.75 E F0(font-min-byte1,)302.4 732 Q F1(16) +2.75 E EP +%%Page: 33 33 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(3-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(font-min-byte2,)72 87 Q/F1 12/Times-Bold@0 SF(16)2.75 E F0 +(font-name,)72 102 Q F1(15)2.75 E F0(font-path,)72 117 Q F1(17)2.75 E F0 +(font-properties,)72 132 Q F1(16)2.75 E F0(font-property)72 147 Q(,)-.715 E F1 +(17)2.75 E F0(font?,)72 162 Q F1(15)2.75 E F0(free-colormap,)72 177 Q F1(10) +2.75 E F0(free-cursor)72 192 Q(,)-.44 E F1(18)2.75 E F0(free-gconte)72 207 Q +(xt,)-.165 E F1(11)2.75 E F0(free-pixmap,)72 222 Q F1(10)2.75 E/F2 13 +/Times-Bold@0 SF(G)72 252 Q F0 -.055(ga)72 282 S(rbage collector).055 E 2.75 +(,2)-.44 G(9)158.559 282 Q(gconte)72 297 Q(xt-arc-mode,)-.165 E F1(12)2.75 E F0 +(gconte)72 312 Q(xt-background,)-.165 E F1(12)2.75 E F0(gconte)72 327 Q +(xt-cap-style,)-.165 E F1(12)2.75 E F0(gconte)72 342 Q(xt-clip-x,)-.165 E F1 +(12)2.75 E F0(gconte)72 357 Q(xt-clip-y)-.165 E(,)-.715 E F1(12)2.75 E F0 +(gconte)72 372 Q(xt-dash-of)-.165 E(fset,)-.275 E F1(12)2.75 E F0(gconte)72 387 +Q(xt-display)-.165 E(,)-.715 E F1(11)2.75 E F0(gconte)72 402 Q(xt-e)-.165 E +(xposures,)-.165 E F1(12)2.75 E F0(gconte)72 417 Q(xt-\214ll-rule,)-.165 E F1 +(12)2.75 E F0(gconte)72 432 Q(xt-\214ll-style,)-.165 E F1(12)2.75 E F0(gconte) +72 447 Q(xt-font,)-.165 E F1(15)2.75 E F0(gconte)72 462 Q(xt-fore)-.165 E +(ground,)-.165 E F1(12)2.75 E F0(gconte)72 477 Q(xt-function,)-.165 E F1(12) +2.75 E F0(gconte)72 492 Q(xt-join-style,)-.165 E F1(12)2.75 E F0(gconte)72 507 +Q(xt-line-style,)-.165 E F1(12)2.75 E F0(gconte)72 522 Q(xt-line-width,)-.165 E +F1(12)2.75 E F0(gconte)72 537 Q(xt-plane-mask,)-.165 E F1(12)2.75 E F0(gconte) +72 552 Q(xt-stipple,)-.165 E F1(12)2.75 E F0(gconte)72 567 Q(xt-subwindo)-.165 +E(w-mode,)-.275 E F1(12)2.75 E F0(gconte)72 582 Q(xt-tile,)-.165 E F1(12)2.75 E +F0(gconte)72 597 Q(xt-ts-x,)-.165 E F1(12)2.75 E F0(gconte)72 612 Q(xt-ts-y) +-.165 E(,)-.715 E F1(12)2.75 E F0(gconte)72 627 Q(xt?,)-.165 E F1(11)2.75 E F0 +(general-w)72 642 Q(arp-pointer)-.11 E(,)-.44 E F1(20)2.75 E F0(get-def)72 657 +Q(ault,)-.11 E F1(27)2.75 E F0(get-motion-e)72 672 Q -.165(ve)-.275 G(nts,).165 +E F1(21)2.75 E F0(get-pointer)72 687 Q(-mapping,)-.22 E F1(21)2.75 E F0 +(get-property)72 702 Q(,)-.715 E F1(8)2.75 E F0(get-te)72 717 Q(xt-property) +-.165 E(,)-.715 E F1(24)2.75 E F0(grab-b)72 732 Q(utton, 7,)-.22 E F1(19)2.75 E +F0(grab-k)302.4 87 Q -.165(ey)-.11 G(,)-.55 E F1(19)2.75 E F0(grab-k)302.4 102 +Q -.165(ey)-.11 G(board,).165 E F1(19)2.75 E F0(grab-pointer)302.4 117 Q(,)-.44 +E F1(18)2.75 E F0 2.75(,1)C(9)384.833 117 Q(grab-serv)302.4 132 Q(er)-.165 E(,) +-.44 E F1(19)2.75 E F2(H)302.4 162 Q F0(handle-e)302.4 192 Q -.165(ve)-.275 G +(nts,).165 E F1(21)2.75 E F2(I)302.4 222 Q F0(icon-sizes,)302.4 252 Q F1(26) +2.75 E F0(iconify-windo)302.4 267 Q -.715(w,)-.275 G F1(24)3.465 E F0 +(input-focus,)302.4 282 Q F1(20)2.75 E F0(install-colormap,)302.4 297 Q F1(20) +2.75 E F0(intern-atom,)302.4 312 Q F1(8)2.75 E F2(K)302.4 342 Q F0 -.11(ke) +302.4 372 S(ycode)-.055 E/F3 11/Symbol SF(-)A F0(>k)A -.165(ey)-.11 G(sym,).165 +E F1(27)2.75 E F0 -.11(ke)302.4 387 S(ysym)-.055 E F3(-)A F0(>k)A -.165(ey)-.11 +G(code,).165 E F1(27)2.75 E F0 -.11(ke)302.4 402 S(ysym)-.055 E F3(-)A F0 +(>string,)A F1(26)2.75 E F2(L)302.4 432 Q F0(list-depths,)302.4 462 Q F1(3)2.75 +E F0(list-e)302.4 477 Q(xtensions,)-.165 E F1(28)2.75 E F0(list-font-names,) +302.4 492 Q F1(15)2.75 E F0(list-fonts,)302.4 507 Q F1(15)2.75 E F0 +(list-installed-colormaps,)302.4 522 Q F1(20)2.75 E F0(list-pixmap-formats,) +302.4 537 Q F1(3)2.75 E F0(list-properties,)302.4 552 Q F1(8)2.75 E F0 +(lookup-color)302.4 567 Q(,)-.44 E F1(9)2.75 E F0(lookup-string,)302.4 582 Q F1 +(27)2.75 E F0(lo)302.4 597 Q(wer)-.275 E(-windo)-.22 E -.715(w,)-.275 G F1(7) +3.465 E F2(M)302.4 627 Q F0(mak)302.4 657 Q(e-atom,)-.11 E F1(8)2.75 E F0(mak) +302.4 672 Q(e-color)-.11 E(,)-.44 E F1(9)2.75 E F0(map-subwindo)302.4 687 Q +(ws,)-.275 E F1(7)2.75 E F0(map-windo)302.4 702 Q -.715(w,)-.275 G F1(6)3.465 E +F0(max-char)302.4 717 Q(-ascent,)-.22 E F1(16)2.75 E F0(max-char)302.4 732 Q +(-descent,)-.22 E F1(16)2.75 E EP +%%Page: 34 34 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(4-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(max-char)72 87 Q(-lbearing,)-.22 E/F1 12/Times-Bold@0 SF(16)2.75 E +F0(max-char)72 102 Q(-rbearing,)-.22 E F1(16)2.75 E F0(max-char)72 117 Q +(-width,)-.22 E F1(16)2.75 E F0(min-char)72 132 Q(-ascent,)-.22 E F1(16)2.75 E +F0(min-char)72 147 Q(-descent,)-.22 E F1(16)2.75 E F0(min-char)72 162 Q +(-lbearing,)-.22 E F1(16)2.75 E F0(min-char)72 177 Q(-rbearing,)-.22 E F1(16) +2.75 E F0(min-char)72 192 Q(-width,)-.22 E F1(16)2.75 E F0(multiple-v)72 207 Q +(alue-bind, 1)-.275 E/F2 13/Times-Bold@0 SF(N)72 237 Q F0(no-op,)72 267 Q F1(3) +2.75 E F2(O)72 297 Q F0(open-display)72 327 Q(,)-.715 E F1(1)2.75 E F0 +(open-font,)72 342 Q F1(15)2.75 E F2(P)72 372 Q F0(parse-color)72 402 Q(,)-.44 +E F1(28)2.75 E F0(parse-geometry)72 417 Q(,)-.715 E F1(28)2.75 E F0(pix)72 432 +Q(el-v)-.165 E(alue,)-.275 E F1(10)2.75 E F0(pix)72 447 Q(el?,)-.165 E F1(10) +2.75 E F0(pixmap-display)72 462 Q(,)-.715 E F1(10)2.75 E F0(pixmap?,)72 477 Q +F1(10)2.75 E F2(Q)72 507 Q F0(query-best-cursor)72 537 Q(,)-.44 E F1(11)2.75 E +F0(query-best-size,)72 552 Q F1(11)2.75 E F0(query-best-stipple,)72 567 Q F1 +(11)2.75 E F0(query-best-tile,)72 582 Q F1(11)2.75 E F0(query-color)72 597 Q(,) +-.44 E F1(9)2.75 E F0(query-colors,)72 612 Q F1(9)2.75 E F0(query-e)72 627 Q +(xtension,)-.165 E F1(29)2.75 E F0(query-pointer)72 642 Q(,)-.44 E F1(7)2.75 E +F0(query-tree,)72 657 Q F1(7)2.75 E F2(R)72 687 Q F0(raise-windo)72 717 Q -.715 +(w,)-.275 G F1(7)3.465 E F0(read-bitmap-\214le,)72 732 Q F1(11)2.75 E F0 +(rebind-k)302.4 87 Q -.165(ey)-.11 G(sym,).165 E F1(27)2.75 E F0(recolor)302.4 +102 Q(-cursor)-.22 E(,)-.44 E F1(18)2.75 E F0(recon\214gure-wm-windo)302.4 117 +Q -.715(w,)-.275 G F1(24)3.465 E F0(refresh-k)302.4 132 Q -.165(ey)-.11 G +(board-mapping,).165 E F1(27)2.75 E F0(reparent-windo)302.4 147 Q -.715(w,) +-.275 G F1(20)3.465 E F0(resource-manager)302.4 162 Q(-string,)-.22 E F1(27) +2.75 E F0(restack-windo)302.4 177 Q(ws,)-.275 E F1(7)2.75 E F0(rotate-b)302.4 +192 Q(uf)-.22 E(fers,)-.275 E F1(28)2.75 E F0(rotate-properties,)302.4 207 Q F1 +(8)2.75 E F2(S)302.4 237 Q F0(selection-o)302.4 267 Q(wner)-.275 E(,)-.44 E F1 +(9)2.75 E F0(set-access-control,)302.4 282 Q F1(21)2.75 E F0(set-after)302.4 +297 Q(-function!,)-.22 E F1(4)2.75 E F0(set-close-do)302.4 312 Q(wn-mode,)-.275 +E F1(21)2.75 E F0(set-font-path!,)302.4 327 Q F1(17)2.75 E F0(set-gconte)302.4 +342 Q(xt-arc-mode!,)-.165 E F1(13)2.75 E F0(set-gconte)302.4 357 Q +(xt-background!,)-.165 E F1(12)2.75 E F0(set-gconte)302.4 372 Q(xt-cap-style!,) +-.165 E F1(13)2.75 E F0(set-gconte)302.4 387 Q(xt-clip-mask!,)-.165 E F1(13) +2.75 E F0(set-gconte)302.4 402 Q(xt-clip-rectangles!,)-.165 E F1(13)2.75 E F0 +(set-gconte)302.4 417 Q(xt-clip-x!,)-.165 E F1(13)2.75 E F0(set-gconte)302.4 +432 Q(xt-clip-y!,)-.165 E F1(13)2.75 E F0(set-gconte)302.4 447 Q(xt-dash-of) +-.165 E(fset!,)-.275 E F1(13)2.75 E F0(set-gconte)302.4 462 Q(xt-dashlist!,) +-.165 E F1(13)2.75 E F0(set-gconte)302.4 477 Q(xt-e)-.165 E(xposures!,)-.165 E +F1(13)2.75 E F0(set-gconte)302.4 492 Q(xt-\214ll-rule!,)-.165 E F1(13)2.75 E F0 +(set-gconte)302.4 507 Q(xt-\214ll-style!,)-.165 E F1(13)2.75 E F0(set-gconte) +302.4 522 Q(xt-font!,)-.165 E F1(13)2.75 E F0(set-gconte)302.4 537 Q(xt-fore) +-.165 E(ground!,)-.165 E F1(12)2.75 E F0(set-gconte)302.4 552 Q(xt-function!,) +-.165 E F1(12)2.75 E F0(set-gconte)302.4 567 Q(xt-join-style!,)-.165 E F1(13) +2.75 E F0(set-gconte)302.4 582 Q(xt-line-style!,)-.165 E F1(13)2.75 E F0 +(set-gconte)302.4 597 Q(xt-line-width!,)-.165 E F1(13)2.75 E F0(set-gconte) +302.4 612 Q(xt-plane-mask!,)-.165 E F1(12)2.75 E F0(set-gconte)302.4 627 Q +(xt-stipple!,)-.165 E F1(13)2.75 E F0(set-gconte)302.4 642 Q(xt-subwindo)-.165 +E(w-mode!,)-.275 E F1(13)2.75 E F0(set-gconte)302.4 657 Q(xt-tile!,)-.165 E F1 +(13)2.75 E F0(set-gconte)302.4 672 Q(xt-ts-x!,)-.165 E F1(13)2.75 E F0 +(set-gconte)302.4 687 Q(xt-ts-y!,)-.165 E F1(13)2.75 E F0(set-icon-sizes!,) +302.4 702 Q F1(26)2.75 E F0(set-input-focus,)302.4 717 Q F1(20)2.75 E F0 +(set-pointer)302.4 732 Q(-mapping,)-.22 E F1(21)2.75 E EP +%%Page: 35 35 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(5-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(set-selection-o)72 87 Q(wner!,)-.275 E/F1 12/Times-Bold@0 SF(8)2.75 +E F0(set-te)72 102 Q(xt-property!,)-.165 E F1(24)2.75 E F0(set-transient-for!,) +72 117 Q F1(25)2.75 E F0(set-windo)72 132 Q(w-background-pix)-.275 E(el!,)-.165 +E F1(4)2.75 E F0(set-windo)72 147 Q(w-background-pixmap!,)-.275 E F1(4)2.75 E +F0(set-windo)72 162 Q(w-backing-pix)-.275 E(el!,)-.165 E F1(5)2.75 E F0 +(set-windo)72 177 Q(w-backing-planes!,)-.275 E F1(5)2.75 E F0(set-windo)72 192 +Q(w-backing-store!,)-.275 E F1(5)2.75 E F0(set-windo)72 207 Q(w-bit-gra)-.275 E +(vity!,)-.22 E F1(5)2.75 E F0(set-windo)72 222 Q(w-border)-.275 E(-pix)-.22 E +(el!,)-.165 E F1(5)2.75 E F0(set-windo)72 237 Q(w-border)-.275 E(-pixmap!,)-.22 +E F1(4)2.75 E F0(set-windo)72 252 Q(w-border)-.275 E(-width!,)-.22 E F1(4)2.75 +E F0(set-windo)72 267 Q(w-colormap!,)-.275 E F1(5)2.75 E F0(set-windo)72 282 Q +(w-cursor!,)-.275 E F1(5)2.75 E F0(set-windo)72 297 Q(w-do-not-propag)-.275 E +(ate-mask!,)-.055 E F1(5)2.75 E F0(set-windo)72 312 Q(w-e)-.275 E -.165(ve) +-.275 G(nt-mask!,).165 E F1(5)2.75 E F0(set-windo)72 327 Q(w-gra)-.275 E +(vity!,)-.22 E F1(5)2.75 E F0(set-windo)72 342 Q(w-height!,)-.275 E F1(4)2.75 E +F0(set-windo)72 357 Q(w-o)-.275 E -.165(ve)-.165 G(rride-redirect!,).165 E F1 +(5)2.75 E F0(set-windo)72 372 Q(w-sa)-.275 E -.165(ve)-.22 G(-under!,).165 E F1 +(5)2.75 E F0(set-windo)72 387 Q(w-sibling!,)-.275 E F1(4)2.75 E F0(set-windo)72 +402 Q(w-stack-mode!,)-.275 E F1(4)2.75 E F0(set-windo)72 417 Q(w-width!,)-.275 +E F1(4)2.75 E F0(set-windo)72 432 Q(w-x!,)-.275 E F1(4)2.75 E F0(set-windo)72 +447 Q(w-y!,)-.275 E F1(4)2.75 E F0(set-wm-class!,)72 462 Q F1(25)2.75 E F0 +(set-wm-client-machine!,)72 477 Q F1(25)2.75 E F0(set-wm-command!,)72 492 Q F1 +(25)2.75 E F0(set-wm-hints!,)72 507 Q F1(26)2.75 E F0(set-wm-icon-name!,)72 522 +Q F1(25)2.75 E F0(set-wm-name!,)72 537 Q F1(24)2.75 E F0(set-wm-normal-hints!,) +72 552 Q F1(26)2.75 E F0(set-wm-protocols!,)72 567 Q F1(24)2.75 E F0(store-b)72 +582 Q(uf)-.22 E(fer)-.275 E(,)-.44 E F1(28)2.75 E F0(store-bytes,)72 597 Q F1 +(28)2.75 E F0(string)72 612 Q/F2 11/Symbol SF(-)A F0(>k)A -.165(ey)-.11 G(sym,) +.165 E F1(26)2.75 E F0(synchronize,)72 627 Q F1(4)2.75 E/F3 13/Times-Bold@0 SF +(T)72 657 Q F0(te)72 687 Q(xt-width,)-.165 E F1(17)2.75 E F0(transient-for)72 +702 Q(,)-.44 E F1(25)2.75 E F0(translate-coordinates,)72 717 Q F1(7)2.75 E F0 +(translate-te)302.4 87 Q(xt,)-.165 E F1(17)2.75 E F3(U)302.4 117 Q F0 +(unde\214ne-cursor)302.4 147 Q(,)-.44 E F1(18)2.75 E F0(ungrab-b)302.4 162 Q +(utton,)-.22 E F1(19)2.75 E F0(ungrab-k)302.4 177 Q -.165(ey)-.11 G(,)-.55 E F1 +(19)2.75 E F0(ungrab-k)302.4 192 Q -.165(ey)-.11 G(board,).165 E F1(19)2.75 E +F0(ungrab-pointer)302.4 207 Q(,)-.44 E F1(19)2.75 E F0(ungrab-serv)302.4 222 Q +(er)-.165 E(,)-.44 E F1(19)2.75 E F0(uninstall-colormap,)302.4 237 Q F1(20)2.75 +E F0(unmap-subwindo)302.4 252 Q(ws,)-.275 E F1(7)2.75 E F0(unmap-windo)302.4 +267 Q -.715(w,)-.275 G F1(6)3.465 E F3(W)302.4 297 Q F0 -.11(wa)302.4 327 S +(rp-pointer).11 E(,)-.44 E F1(20)2.75 E F0 -.11(wa)302.4 342 S(rp-pointer).11 E +(-relati)-.22 E -.165(ve)-.275 G(,).165 E F1(20)2.75 E F0(white-pix)302.4 357 Q +(el,)-.165 E F1(10)2.75 E F0(windo)302.4 372 Q(w-all-e)-.275 E -.165(ve)-.275 G +(nt-masks,).165 E F1(5)2.75 E F0(windo)302.4 387 Q(w-backing-pix)-.275 E(el,) +-.165 E F1(5)2.75 E F0(windo)302.4 402 Q(w-backing-planes,)-.275 E F1(5)2.75 E +F0(windo)302.4 417 Q(w-backing-store,)-.275 E F1(5)2.75 E F0(windo)302.4 432 Q +(w-bit-gra)-.275 E(vity)-.22 E(,)-.715 E F1(5)2.75 E F0(windo)302.4 447 Q +(w-border)-.275 E(-width,)-.22 E F1(5)2.75 E F0(windo)302.4 462 Q(w-class,) +-.275 E F1(5)2.75 E F0(windo)302.4 477 Q(w-colormap,)-.275 E F1(5)2.75 E F0 +(windo)302.4 492 Q(w-depth,)-.275 E F1(5)2.75 E F0(windo)302.4 507 Q(w-display) +-.275 E(,)-.715 E F1(4)2.75 E F0(windo)302.4 522 Q(w-do-not-propag)-.275 E +(ate-mask,)-.055 E F1(5)2.75 E F0(windo)302.4 537 Q(w-gra)-.275 E(vity)-.22 E +(,)-.715 E F1(5)2.75 E F0 2.75(,2)C(5)393.958 537 Q(windo)302.4 552 Q +(w-height,)-.275 E F1(5)2.75 E F0(windo)302.4 567 Q(w-map-installed,)-.275 E F1 +(5)2.75 E F0(windo)302.4 582 Q(w-map-state,)-.275 E F1(5)2.75 E F0(windo)302.4 +597 Q(w-o)-.275 E -.165(ve)-.165 G(rride-redirect,).165 E F1(5)2.75 E F0(windo) +302.4 612 Q(w-root,)-.275 E F1(5)2.75 E F0(windo)302.4 627 Q(w-sa)-.275 E -.165 +(ve)-.22 G(-under).165 E(,)-.44 E F1(5)2.75 E F0(windo)302.4 642 Q(w-screen,) +-.275 E F1(6)2.75 E F0(windo)302.4 657 Q(w-visual,)-.275 E F1(5)2.75 E F0 +(windo)302.4 672 Q(w-width,)-.275 E F1(5)2.75 E F0(windo)302.4 687 Q(w-x,)-.275 +E F1(5)2.75 E F0(windo)302.4 702 Q(w-y)-.275 E(,)-.715 E F1(5)2.75 E F0(windo) +302.4 717 Q(w-your)-.275 E(-e)-.22 E -.165(ve)-.275 G(nt-mask,).165 E F1(5)2.75 +E F0(windo)302.4 732 Q(w?,)-.275 E F1(4)2.75 E EP +%%Page: 36 36 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3)276.087 51 S 2.75(6-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(with,)72 87 Q/F1 12/Times-Bold@0 SF(28)2.75 E F0(with-serv)72 102 Q +(er)-.165 E(-grabbed,)-.22 E F1(20)2.75 E F0(withdra)72 117 Q(w-windo)-.165 E +-.715(w,)-.275 G F1(24)3.465 E F0(wm-class,)72 132 Q F1(25)2.75 E F0 +(wm-client-machine,)72 147 Q F1(25)2.75 E F0(wm-command,)72 162 Q F1(25)2.75 E +F0(wm-hints,)72 177 Q F1(26)2.75 E F0(wm-icon-name,)72 192 Q F1(24)2.75 E F0 +(wm-name,)72 207 Q F1(24)2.75 E F0(wm-normal-hints,)72 222 Q F1(25)2.75 E F0 +2.75(,2)C(6)176.884 222 Q(wm-protocols,)72 237 Q F1(24)2.75 E F0 +(write-bitmap-\214le,)72 252 Q F1(11)2.75 E/F2 13/Times-Bold@0 SF(X)72 282 Q F0 +(x-error)72 312 Q(-handler)-.22 E(,)-.44 E F1(29)2.75 E F0(x-f)72 327 Q +(atal-error)-.11 E(-handler)-.22 E(,)-.44 E F1(29)2.75 E F0(xlib, 1)72 342 Q +(xlib-release-4-or)72 357 Q(-later?,)-.22 E F1(27)2.75 E F0(xlib-release-5-or) +72 372 Q(-later?,)-.22 E F1(27)2.75 E F0(xlib-release-6-or)72 387 Q(-later?,) +-.22 E F1(27)2.75 E EP +%%Page: 37 37 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 13/Times-Bold@0 SF -1.196(Ta)239.127 123 S(ble of Contents)1.196 E/F1 11 +/Times-Roman@0 SF .866(Introduction ..........................................\ +..............................................................................\ +......)72 177.6 R(1)498.5 177.6 Q(Display Functions)72 196.2 Q 19.25(.........\ +..............................................................................\ +............................. 1)5.134 F -.44(Wi)72 214.8 S(ndo).44 E 2.75(wF) +-.275 G 2.186(unctions .......................................................\ +............................................................)118.035 214.8 R(4) +498.5 214.8 Q -.44(Wi)72 233.4 S(ndo).44 E 2.75(wP)-.275 G +(roperty and Selection Functions)118.035 233.4 Q 19.25(.......................\ +....................................................... 7)3.726 F +(Colormap Functions)72 252 Q 19.25(...........................................\ +...................................................................... 9)3.605 +F(Pix)72 270.6 Q(el Functions)-.165 E 13.75(..................................\ +..............................................................................\ +......... 10)3.154 F(Pixmap Functions)72 289.2 Q 13.75(.......................\ +..............................................................................\ +................ 10)2.989 F(Graphics Conte)72 307.8 Q(xt Functions)-.165 E +13.75(........................................................................\ +............................. 11)3.473 F(Graphics Functions)72 326.4 Q 13.75(.\ +..............................................................................\ +................................... 13)5.145 F -.165(Fo)72 345 S(nt Functions) +.165 E 13.75(.................................................................\ +......................................................... 15)2.846 F -1.375 +-.77(Te x)72 363.6 T 2.75(tM).77 G(etrics and T)103.757 363.6 Q -.165(ex)-.77 G +2.75(tD).165 G(ra)178.887 363.6 Q(wing Functions)-.165 E 13.75(...............\ +................................................................ 17)3.836 F +(Cursor Functions)72 382.2 Q 13.75(...........................................\ +........................................................................... 18) +3.913 F(Grab Functions)72 400.8 Q 13.75(......................................\ +..............................................................................\ +..... 18)3.616 F -.44(Wi)72 419.4 S(ndo).44 E 2.75(wM)-.275 G(anager Functions) +121.698 419.4 Q 13.75(........................................................\ +............................................ 20)4.342 F(Ev)72 438 Q +(ent Handling Functions)-.165 E 13.75(........................................\ +................................................................ 21)3.165 F +(Inter)72 456.6 Q(-Client Communication Functions)-.22 E 13.75(...............\ +.................................................................... 24)5.354 F +-2.365 -.275(Ke y)72 475.2 T(board Utility Functions).275 E 13.75(............\ +..............................................................................\ +............ 26)3.44 F(Other Utility Functions)72 493.8 Q 13.75(..............\ +..............................................................................\ +................ 27)4.826 F(Serv)72 512.4 Q(er Extension Functions)-.165 E +13.75(........................................................................\ +............................. 28)5.31 F(Error Handling)72 531 Q 13.75(........\ +..............................................................................\ +................................... 29)4.848 F +(Interaction with the Garbage Collector)72 549.6 Q 13.75(.....................\ +............................................................... 29)3.649 F +(Inde)72 568.2 Q 2.868(x.)-.165 G 13.75(......................................\ +..............................................................................\ +.................... 31)102.5 568.2 R EP +%%Trailer +end +%%EOF diff --git a/doc/xt/Makefile b/doc/xt/Makefile new file mode 100644 index 0000000..e901769 --- /dev/null +++ b/doc/xt/Makefile @@ -0,0 +1,24 @@ +MANUAL= xt +TROFF= groff -ms -t +UNROFF= unroff -ms + +$(MANUAL).ps: $(MANUAL).ms index.ms + (cat $(MANUAL).ms ../util/tmac.index index.ms; echo ".Tc")\ + | $(TROFF) 2> /dev/null > $(MANUAL).ps + +$(MANUAL).html: $(MANUAL).ms + (cat $?; echo ".Tc") | $(UNROFF) document=$(MANUAL) + +index.ms: $(MANUAL).ms index.raw + sort -f -t# +1 -3 +0n index.raw | awk -f ../util/fixindex.awk\ + | awk -f ../util/block.awk >index.ms + +index.raw: $(MANUAL).ms + $(TROFF) $(MANUAL).ms 2> index.raw >/dev/null + +check: + checknr -c.Ul.Pr.Sy.Va.Sh.Ix.Id.Ch -a.Ss.Se.[[.]] $(MANUAL).ms |\ + grep -v "Empty command" + +clean: + rm -f index.raw index.ms $(MANUAL).ps $(MANUAL).html diff --git a/doc/xt/xt.ms b/doc/xt/xt.ms new file mode 100644 index 0000000..6f92870 --- /dev/null +++ b/doc/xt/xt.ms @@ -0,0 +1,579 @@ +.so ../util/tmac.scheme +.Ul +.TL +Elk/Xt Reference Manual +.AU +Oliver Laumann +. +.Ch "Introduction" +.PP +This manual describes the functions, special forms, and +variables defined by the Xt (X Toolkit Intrinsics) extension included +in the Elk distribution. +Most of the functions are directly equivalent to a function of the +X toolkit C library, so that the description need not be repeated. +In such cases, only the name of the corresponding Xt function is +mentioned. +Thus, you should have the \f2X Toolkit Intrinsics \- C Language Interface\fP +manual within reach when using this reference manual. +.PP +The functions listed in this document are loaded when the expression +.DS +.ft 5 +(require 'xwidgets) +.ft +.DE +.Ix xwidgets +is evaluated or, when the OSF/Motif software has been installed on +your system and you want to use Motif widgets from within Scheme, +when +.DS +.ft 5 +(require 'motif) +.ft +.DE +.Ix motif +is evaluated in the interpreter's top level or in a Scheme program. +If you only want to use the toolkit functionality (and no widgets), +evaluate +.DS +.ft 5 +(require 'xt). +.ft +.DE +.Ix xt +Note that all of the above forms cause the Elk/Xlib functions to be +loaded as well. +.LP +Individual widgets are loaded by evaluating +.DS +.ft 5 +(load-widgets . \f2widget-names\fP) +.ft +.DE +.LP +.Id load-widgets +Each \f2widget-name\fP is a symbol (not quoted, since \f2load-widgets\fP +is a macro). +.PP +The widgets are loaded from subdirectories of ``$install_dir/runtime/obj'' +(where $install_dir is the directory where you have installed Elk on +your system). +.PP +In the following, the types of arguments of the listed procedures are +not specified when they are obvious from the context or from the name. +For instance, an argument named \f2widget\fP is always of type \f2widget\fP, +an argument named \f2context\fP is an object of type \f2context\fP +(application context), etc. +Arguments the names of which end in ``?'' are always of type \f2boolean\fP. +.if !\n(.U \{\ +.PP +In the following, each description of a procedure, special form, or +variable lists the kind of object in boldface. +Here, \f3procedure\fP denotes either a primitive procedure or a +compound procedure, \f3syntax\fP denotes a special form or a macro, +and \f3variable\fP denotes a global variable that has some initial +value and can be re-assigned a new value by the user (by means +of \f2set!\fP or \f2fluid-let\fP). +.\} +. +.Ch "Widget Classes" +. +.Pr class? x +.LP +Returns #t iff \f2x\fP is an object of type \f2class\fP (widget class). +. +.Pr find-class name-of-class +.LP +Returns the widget class of the specified name (an object of +type \f2class\fP). +\f2name-of-class\fP is a string or a symbol. +. +.Pr class-resources widget-class +.LP +See \f2XtGetResourceList\fP. +Returns the resource list of the specified widget class. +Each element of the list is a list of three symbols \- +the resource name, the resource class, and the resource type. +. +.Pr class-constraint-resources widget-class +.LP +See \f2XtGetConstraintRespourceList\fP. +Returns the list of constraint resources that are defined for the +specified widget class. +Each element of the list is a list of three symbols \- +the resource name, the resource class, and the resource type. +. +.Pr class-sub-resources widget-class +.LP +Returns the list of sub-resources (if there are any) of the +specified widget class. +See \f2class-resources\fP above. +. +.Pr class-exists? name-of-class +.LP +Returns #t iff a widget class of the given name exists +(i.\|e.\& has been loaded by means of \f2load-widgets\fP). +\f2name-of-class\fP is a string or a symbol. +. +.Ch "Widget Functions" +. +.Pr widget? x +.LP +Returns #t iff \f2x\fP is an object of type \f2widget\fP. +. +.Pr destroy-widget widget +.LP +See \f2XtDestroyWidget\fP. +. +.Pr create-shell application-name application-class parent display . args +.LP +See \f2XtAppCreateShell\fP. +\f2application-name\fP and \f2application-class\fP are strings or symbols +or #f (NULL is used in the latter case). +\f2parent\fP is a widget. +The number of \f2args\fP must be even, the 1st, 3rd, etc.\& argument +is the name of a resource to be set (a string or a symbol), the +2nd, 4th, etc.\& argument is the corresponding value. +. +.[[ +.Pr create-widget widget-class parent . args +.Pr create-widget widget-name widget-class parent . args +.]] +.LP +See \f2XtCreateWidget\fP. +\f2widget-name\fP is a string or a symbol; \f2parent\fP is a widget. +If no \f2widget-name\fP is given, the name of the widget class is used. +The number of \f2args\fP must be even, the 1st, 3rd, etc.\& argument +is the name of a resource to be set (a string or a symbol), the +2nd, 4th, etc.\& argument is the corresponding value. +. +.Pr create-managed-widget . args +.LP +Applies \f2create-widget\fP to the arguments and then calls \f2manage-child\fP +with the newly created widget. +. +.Pr realize-widget widget +.LP +See \f2XtRealizeWidget\fP. +. +.Pr unrealize-widget widget +.LP +See \f2XtUnrealizeWidget\fP. +. +.Pr widget-realized? widget +.LP +See \f2XtIsRealized\fP. +. +.Pr widget-display widget +.LP +See \f2XtDisplay\fP. +Returns an object of type \f2display\fP. +. +.Pr widget-parent widget +.LP +See \f2XtParent\fP. +. +.Pr widget-name widget +.LP +See \f2XtName\fP. +Returns the name of a widget as a string. +. +.[[ +.Pr widget\(mi>window widget +.Pr widget-window widget +.]] +.LP +See \f2XtWindow\fP. +Returns an object of type \f2window\fP. +. +.Pr widget-composite? widget +.LP +See \f2XtIsComposite\fP. +. +.Pr manage-children . widgets +.LP +See \f2XtManageChildren\fP. +. +.Pr manage-child widget +.LP +Calls \f2manage-children\fP with the specified widget. +. +.Pr unmanage-children . widgets +.LP +See \f2XtUnmanageChildren\fP. +. +.Pr unmanage-child widget +.LP +Calls \f2unmanage-children\fP with the specified widget. +. +.Pr widget-managed? widget +.LP +See \f2XtIsManaged\fP. +. +.Pr widget-class widget +.LP +See \f2XtClass\fP. +Returns an object of type \f2class\fP. +. +.Pr widget-superclass widget +.LP +See \f2XtSuperclass\fP. +Returns an object of type \f2class\fP or the symbol \f5none\fP +when the widget's class does not have a super-class. +. +.Pr widget-subclass? widget class +.LP +See \f2XtIsSubclass\fP. +. +.Pr set-mapped-when-managed! widget managed? +.LP +See \f2XtSetMappedWhenManaged\fP. +. +.Pr map-widget widget +.LP +See \f2XtMapWidget\fP. +. +.Pr unmap-widget widget +.LP +See \f2XtUnmapWidget\fP. +. +.Pr set-values! widget . args +.LP +See \f2XtSetValues\fP. +The number of \f2args\fP must be even, the 1st, 3rd, etc.\& argument +is the name of a resource to be set (a string or a symbol), the +2nd, 4th, etc.\& argument is the corresponding value. +. +.Pr get-values widget . args +.LP +See \f2XtGetValues\fP. +Each \f2arg\fP is the name of a resource (a string or a symbol). +Returns a list of the values of the specified resources. +. +.Pr widget-context widget +.LP +See \f2XtWidgetToApplicationContext\fP. +Returns an object of type \f2context\fP. +. +.Pr set-sensitive! widget sensitive? +.LP +See \f2XtSetSensitive\fP. +. +.Pr widget-sensitive? widget +.LP +See \f2XtIsSensitive\fP. +. +.Pr window\(mi>widget window +.LP +See \f2XtWindowToWidget\fP. +. +.Pr name\(mi>widget root-widget name +.LP +See \f2XtNameToWidget\fP. +\f2name\fP is a string or a symbol. +. +.Pr widget-translate-coordinates widget x y +.LP +See \f2XtTranslateCoords\fP. +Returns the root-relative x and y coordinates as a pair of integers. +. +.Ch "Callback Functions" +. +.Pr add-callbacks widget callback-name . callback-functions +.LP +See \f2XtAddCallbacks\fP. +Adds the functions to a callback list of the specified widget. +\f2callback-name\fP is a string or a symbol. +Each callback function will be called with at least one argument \- +the widget to which the function has been attached. +. +.Pr add-callback widget callback-name callback-function +.LP +Calls \f2add-callbacks\fP with the specified function. +. +.\" .Pr call-callbacks widget callback-name object +.\" Calls each callback procedure that is registered in the callback +.\" list named \f2callback-name\fP of the given \f2widget\fP with +.\" \f2object\fP as an argument. +.\" . +.Ch "Popup Shells" +. +.[[ +.Pr create-popup-shell widget-class parent-widget . args +.Pr create-popup-shell widget-name widget-class parent-widget . args +.]] +.LP +See \f2XtCreatePopupShell\fP. +\f2widget-name\fP is a string or a symbol. +If no widget name is given, the name of the shell class is used. +The number of \f2args\fP must be even, the 1st, 3rd, etc.\& argument +is the name of a resource to be set (a string or a symbol), the +2nd, 4th, etc.\& argument is the corresponding value. +. +.Pr popup shell-widget grab-kind +.LP +See \f2XtPopup\fP. +\f2grab-kind\fP is a symbol (\f5grab-once\fP, \f5grab-nonexclusive\fP, +or \f5grab-exclusive\fP). +. +.Pr popdown shell-widget +.LP +See \f2XtPopdown\fP. +. +.Ch "Application Contexts" +. +.Pr context? x +.LP +Returns #t iff \f2x\fP is an object of type \f2context\fP +(application context). +. +.Pr create-context +.LP +See \f2XtCreateApplicationContext\fP. +. +.Pr destroy-context context +.LP +See \f2XtDestroyApplicationContext\fP. +. +.Pr initialize-display context display application-name application-class +.LP +See \f2XtDisplayInitialize\fP, \f2XtOpenDisplay\fP. +If \f2display\fP is an object of type \f2display\fP, +\f2XtDisplayInitialize\fP is called. +If \f2display\fP is a display name (a string or a symbol) or #f, +\f2XtOpenDisplay\fP is called (with a NULL display in the latter case), +and the newly opened display is returned. +\f2application-name\fP and \f2application-class\fP are strings or symbols +or #f (NULL and the empty string are used in the latter case). +. +.Pr application-initialize name . fallback-resources +.LP +A convenience function that creates an application context by a call +to \f2create-context\fP, sets the fallback resources (if any), initializes +the display by a call to \f2initialize-display\fP with the specified +\f2name\fP and a class of #f, and creates and returns an application +shell with the name \f2name\fP and class #f. +.LP +Calling \f2application-initialize\fP more than once may cause the +application contexts and displays that were created by earlier +calls to be closed during a future garbage collection. +. +.Pr display\(mi>context display +.LP +See \f2XtDisplayToApplicationContext\fP. +. +.Pr set-context-fallback-resources! context . resources +.LP +See \f2XtAppSetFallbackResources\fP. +Each \f2resource\fP is a string. +. +.Pr context-main-loop context +.LP +See \f2XtAppMainLoop\fP. +. +.Pr context-pending context +.LP +See \f2XtAppPending\fP. +Returns a list of symbols (\f5x-event\fP, \f5timer\fP, \f5alternate-input\fP). +. +.Pr context-process-event context . mask +.LP +See \f2XtProcessEvent\fP. +The optional argument \f2mask\fP is a list of symbols (see +\f2context-pending\fP above). +\f2XtIMAll\fP is used if the \f2mask\fP argument is omitted +. +.Pr context-add-work-proc context procedure +.LP +See \f2XtAppAddWorkProc\fP. +Returns an \f2identifier\fP that can be used as an argument to +\f2remove-work-proc\fP. +\f2procedure\fP is a procedure with no arguments. +. +.Pr remove-work-proc identifier +.LP +See \f2XtRemoveWorkProc\fP. +\f2identifier\fP must be the return value of a previous call to +\f2context-add-work-proc\fP. +Each such \f2identifier\fP can be used as an argument for +\f2remove-work-proc\fP only once. +. +.Pr context-add-timeout context timer-value procedure +.LP +See \f2XtAppAddTimeOut\fP. +\f2timer-value\fP is an integer. +Returns an \f2identifier\fP that can be used as an argument to +\f2remove-timeout\fP. +The time-out procedure will be called with one argument, the identifier +returned by the call to \f2context-add-timeout\fP (i.\|e.\& the object +that uniquely identifies the timer). +. +.Pr remove-timeout identifier +.LP +See \f2XtRemoveTimeOut\fP. +\f2identifier\fP must be the return value of a previous call to +\f2context-add-timeout\fP. +Each such \f2identifier\fP can be used as an argument for +\f2remove-timeout\fP only once. +. +.Pr context-add-input context source procedure . mask +.LP +See \f2XtAppAddInput\fP. +\f2source\fP is a file port. +Returns an \f2identifier\fP that can be used as an argument to +\f2context-remove-input\fP. +The \f2procedure\fP will be called with two arguments \- \f2source\fP +and the identifier returned by the call to \f2context-add-input\fP. +.LP +The optional \f2mask\fP argument is a list of one or more of the +symbols \f2read\fP, \f2write\fP, and \f2exception\fP. +It specifies the condition on which the procedure will be called. +If no \f2mask\fP argument is given, \f2read\fP is used if \f2source\fP +is an input-port, \f2write\fP if it is an output-port, and +both \f2read\fP and \f2write\fP if it is an input-output-port. +. +.Pr remove-input identifier +.LP +See \f2XtRemoveInput\fP. +\f2identifier\fP must be the return value of a previous call to +\f2context-add-input\fP. +Each such \f2identifier\fP can be used as an argument for +\f2remove-input\fP only once. +. +.Pr identifier? x +.LP +Returns #t iff \f2x\fP is an \f2identifier\fP (an object returned by +functions like \f2context-add-timeout\fP). +. +.Ch "Translations Management Functions" +. +.Pr context-add-action context name procedure +.LP +See \f2XtAppAddActions\fP. +\f2name\fP is the name of the action (a string or a symbol). +The action procedure will be invoked with three arguments: +a widget, a list of event-specific arguments (see \f2handle-events\fP) +and a list of strings (the action arguments). +. +.Pr augment-translations widget translation-table +.LP +See \f2XtAugmentTranslations\fP. +\f2translation-table\fP is a string; \f2XtParseTranslationTable\fP is +applied to it. +. +.Pr override-translations widget translation-table +.LP +See \f2XtOverrideTranslations\fP. +\f2translation-table\fP is a string; \f2XtParseTranslationTable\fP is +applied to it. +. +.Pr uninstall-translations widget +.LP +See \f2XtUninstallTranslations\fP. +. +.Pr install-accelerators dst-widget src-widget +.LP +See \f2XtInstallAccelerators\fP. +. +.Pr install-all-accelerators dst-widget src-widget +.LP +See \f2XtInstallAllAccelerators\fP. +. +.Pr multi-click-time display +.LP +See \f2XtGetMultiClickTime\fP. +Returns an integer. +. +.Pr set-multi-click-time! display time +.LP +See \f2XtSetMultiClickTime\fP. +\f2time\fP is an integer. +. +.Ch "Error Handling" +. +.Va xt-warning-handler +.LP +See \f2XtSetWarningHandler\fP. +When a warning message is to be printed by the Xt intrinsics and the +global variable \f2xt-warning-handler\fP is bound to a compound +procedure, this procedure is invoked with the error message (a string) +as an argument. +When this variable is not bound to a compound procedure, the message +is sent to the current output port. +The initial value of this variable is the empty list. +.LP +This interface is bogus and will be replaced by a more useful mechanism +in future versions of the software. +. +.Ch "Miscellaneous Functions" +. +.Pr xt-release-4-or-later? +.LP +Returns always #t. +. +.Pr xt-release-5-or-later? +.LP +Returns #t iff the Xt extension is linked together with the X11 +Release 5 toolkit intrinsics or later versions of the intrinsics. +. +.Pr xt-release-6-or-later? +.LP +Returns #t iff the Xt extension is linked together with the X11 +Release 6 toolkit intrinsics or later versions of the intrinsics. +. +.Ch "Interaction with the Garbage Collector" +. +.PP +.Ix "garbage collector" +The Scheme garbage collector destroys objects of type \f2context\fP +or \f2widget\fP that are not longer accessible from within the Scheme +program. +This is done by invoking the function \f2destroy-context\fP or +\f2destroy-widget\fP, respectively, with the unreferenced object as +an argument. +.PP +The garbage collector only destroys objects that have been created +from with the Scheme program (by functions like \f2create-context\fP +or \f2create-widget\fP). +Objects that have been obtained from Xt through functions like +\f2widget-context\fP (and are owned by the Xt internals), +are ignored by the garbage collector. +.PP +Programmers must make sure that an object is accessible during the object's +entire lifetime, otherwise future runs of the garbage collector can +result in undesired termination of the object. +One must be especially careful when results of functions that create +new objects (such as \f2create-context\fP) are ignored or assigned +to local variables as in +.Ss +(define (initialize) + (let* ((con (create-context)) + (dpy (initialize-display con #f 'Test #f))) + (create-shell 'Test #f (find-class 'application-shell) dpy)))) +.Se +.PP +In this example, after termination of the function, the garbage +collector will destroy the application context created by the +call to \f2create-context\fP as well as the display, +as they are no longer directly accessible from within the program. +Bugs like this are often hard to find, since (in the above example) +the shell widget returned by \f2initialize\fP can still be used, +although its application context and the display associated with +the application context have already been destroyed. +.PP +The problem can be solved by re-writing the above function like this: +.Ss +(define initialize #f) +.sp .5 +(let ((con) (dpy)) + (set! initialize + (lambda () + (set! con (create-context)) + (set! dpy (initialize-display con #f 'Test #f)) + (create-shell 'Test #f (find-class 'application-shell) dpy)))) +.Se +.PP +An alternative solution is to place the application context and +display into a global variable, so that they can be terminated +explicitly by the program when desired. diff --git a/doc/xt/xt.ps b/doc/xt/xt.ps new file mode 100644 index 0000000..3a55121 --- /dev/null +++ b/doc/xt/xt.ps @@ -0,0 +1,1067 @@ +%!PS-Adobe-3.0 +%%Creator: groff version 1.08 +%%DocumentNeededResources: font Times-Bold +%%+ font Times-Italic +%%+ font Times-Roman +%%+ font Courier +%%+ font Symbol +%%DocumentSuppliedResources: procset grops 1.08 0 +%%Pages: 13 +%%PageOrder: Ascend +%%Orientation: Portrait +%%EndComments +%%BeginProlog +%%BeginResource: procset grops 1.08 0 +/setpacking where{ +pop +currentpacking +true setpacking +}if +/grops 120 dict dup begin +/SC 32 def +/A/show load def +/B{0 SC 3 -1 roll widthshow}bind def +/C{0 exch ashow}bind def +/D{0 exch 0 SC 5 2 roll awidthshow}bind def +/E{0 rmoveto show}bind def +/F{0 rmoveto 0 SC 3 -1 roll widthshow}bind def +/G{0 rmoveto 0 exch ashow}bind def +/H{0 rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/I{0 exch rmoveto show}bind def +/J{0 exch rmoveto 0 SC 3 -1 roll widthshow}bind def +/K{0 exch rmoveto 0 exch ashow}bind def +/L{0 exch rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/M{rmoveto show}bind def +/N{rmoveto 0 SC 3 -1 roll widthshow}bind def +/O{rmoveto 0 exch ashow}bind def +/P{rmoveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/Q{moveto show}bind def +/R{moveto 0 SC 3 -1 roll widthshow}bind def +/S{moveto 0 exch ashow}bind def +/T{moveto 0 exch 0 SC 5 2 roll awidthshow}bind def +/SF{ +findfont exch +[exch dup 0 exch 0 exch neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/MF{ +findfont +[5 2 roll +0 3 1 roll +neg 0 0]makefont +dup setfont +[exch/setfont cvx]cvx bind def +}bind def +/level0 0 def +/RES 0 def +/PL 0 def +/LS 0 def +/PLG{ +gsave newpath clippath pathbbox grestore +exch pop add exch pop +}bind def +/BP{ +/level0 save def +1 setlinecap +1 setlinejoin +72 RES div dup scale +LS{ +90 rotate +}{ +0 PL translate +}ifelse +1 -1 scale +}bind def +/EP{ +level0 restore +showpage +}bind def +/DA{ +newpath arcn stroke +}bind def +/SN{ +transform +.25 sub exch .25 sub exch +round .25 add exch round .25 add exch +itransform +}bind def +/DL{ +SN +moveto +SN +lineto stroke +}bind def +/DC{ +newpath 0 360 arc closepath +}bind def +/TM matrix def +/DE{ +TM currentmatrix pop +translate scale newpath 0 0 .5 0 360 arc closepath +TM setmatrix +}bind def +/RC/rcurveto load def +/RL/rlineto load def +/ST/stroke load def +/MT/moveto load def +/CL/closepath load def +/FL{ +currentgray exch setgray fill setgray +}bind def +/BL/fill load def +/LW/setlinewidth load def +/RE{ +findfont +dup maxlength 1 index/FontName known not{1 add}if dict begin +{ +1 index/FID ne{def}{pop pop}ifelse +}forall +/Encoding exch def +dup/FontName exch def +currentdict end definefont pop +}bind def +/DEFS 0 def +/EBEGIN{ +moveto +DEFS begin +}bind def +/EEND/end load def +/CNT 0 def +/level1 0 def +/PBEGIN{ +/level1 save def +translate +div 3 1 roll div exch scale +neg exch neg exch translate +0 setgray +0 setlinecap +1 setlinewidth +0 setlinejoin +10 setmiterlimit +[]0 setdash +/setstrokeadjust where{ +pop +false setstrokeadjust +}if +/setoverprint where{ +pop +false setoverprint +}if +newpath +/CNT countdictstack def +userdict begin +/showpage{}def +}bind def +/PEND{ +clear +countdictstack CNT sub{end}repeat +level1 restore +}bind def +end def +/setpacking where{ +pop +setpacking +}if +%%EndResource +%%IncludeResource: font Times-Bold +%%IncludeResource: font Times-Italic +%%IncludeResource: font Times-Roman +%%IncludeResource: font Courier +%%IncludeResource: font Symbol +grops begin/DEFS 1 dict def DEFS begin/u{.001 mul}bind def end/RES 72 def/PL +841.89 def/LS false def/ENC0[/asciicircum/asciitilde/Scaron/Zcaron/scaron +/zcaron/Ydieresis/trademark/quotesingle/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef +/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/space +/exclam/quotedbl/numbersign/dollar/percent/ampersand/quoteright/parenleft +/parenright/asterisk/plus/comma/hyphen/period/slash/zero/one/two/three/four +/five/six/seven/eight/nine/colon/semicolon/less/equal/greater/question/at/A/B/C +/D/E/F/G/H/I/J/K/L/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft/backslash +/bracketright/circumflex/underscore/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p/q +/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright/tilde/.notdef/quotesinglbase +/guillemotleft/guillemotright/bullet/florin/fraction/perthousand/dagger +/daggerdbl/endash/emdash/ff/fi/fl/ffi/ffl/dotlessi/dotlessj/grave/hungarumlaut +/dotaccent/breve/caron/ring/ogonek/quotedblleft/quotedblright/oe/lslash +/quotedblbase/OE/Lslash/.notdef/exclamdown/cent/sterling/currency/yen/brokenbar +/section/dieresis/copyright/ordfeminine/guilsinglleft/logicalnot/minus +/registered/macron/degree/plusminus/twosuperior/threesuperior/acute/mu +/paragraph/periodcentered/cedilla/onesuperior/ordmasculine/guilsinglright +/onequarter/onehalf/threequarters/questiondown/Agrave/Aacute/Acircumflex/Atilde +/Adieresis/Aring/AE/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave/Iacute +/Icircumflex/Idieresis/Eth/Ntilde/Ograve/Oacute/Ocircumflex/Otilde/Odieresis +/multiply/Oslash/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn/germandbls +/agrave/aacute/acircumflex/atilde/adieresis/aring/ae/ccedilla/egrave/eacute +/ecircumflex/edieresis/igrave/iacute/icircumflex/idieresis/eth/ntilde/ograve +/oacute/ocircumflex/otilde/odieresis/divide/oslash/ugrave/uacute/ucircumflex +/udieresis/yacute/thorn/ydieresis]def/Courier@0 ENC0/Courier RE/Times-Roman@0 +ENC0/Times-Roman RE/Times-Italic@0 ENC0/Times-Italic RE/Times-Bold@0 ENC0 +/Times-Bold RE +%%EndProlog +%%Page: 1 1 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 12/Times-Bold@0 SF(Elk/Xt Refer)222.45 120 Q(ence Manual)-.216 E/F1 10 +/Times-Italic@0 SF(Oliver Laumann)255.085 144 Q/F2 11/Times-Bold@0 SF 2.75 +(1. Intr)72 216 R(oduction)-.198 E/F3 11/Times-Roman@0 SF 2.118 +(This manual describes the functions, special forms, and v)97 234.6 R 2.118 +(ariables de\214ned by the Xt \(X)-.275 F -.88(To)72 249.6 S 1.058 +(olkit Intrinsics\) e).88 F 1.058(xtension included in the Elk distrib)-.165 F +3.808(ution. Most)-.22 F 1.059(of the functions are directly)3.808 F(equi)72 +264.6 Q -.275(va)-.275 G .19(lent to a function of the X toolkit C library).275 +F 2.939(,s)-.715 G 2.939(ot)299.032 264.6 S .189 +(hat the description need not be repeated.)310.529 264.6 R(In)5.689 E .29 +(such cases, only the name of the corresponding Xt function is mentioned.)72 +279.6 R .291(Thus, you should ha)5.79 F -.165(ve)-.22 G(the)72 294.6 Q/F4 11 +/Times-Italic@0 SF 3.792(XT)3.792 G 1.042(oolkit Intrinsics \255 C Langua) +104.851 294.6 R 1.262 -.11(ge I)-.11 H(nterface).11 E F3 1.041 +(manual within reach when using this reference)3.792 F(manual.)72 309.6 Q +(The functions listed in this document are loaded when the e)97 328.2 Q +(xpression)-.165 E/F5 11/Courier@0 SF(\(require 'xwidgets\))108 349.2 Q F3 .476 +(is e)72 370.2 R -.275(va)-.275 G .476(luated or).275 F 3.226(,w)-.44 G .476 +(hen the OSF/Motif softw)150.032 370.2 R .476 +(are has been installed on your system and you w)-.11 F .477(ant to)-.11 F +(use Motif widgets from within Scheme, when)72 385.2 Q F5(\(require 'motif\)) +108 406.2 Q F3 1.216(is e)72 427.2 R -.275(va)-.275 G 1.216 +(luated in the interpreter').275 F 3.966(st)-.605 G 1.216(op le)218.979 427.2 R +-.165(ve)-.275 G 3.966(lo).165 G 3.966(ri)264.355 427.2 S 3.966(naS)275.042 +427.2 S 1.216(cheme program.)299.474 427.2 R 1.216(If you only w)6.716 F 1.216 +(ant to use the)-.11 F(toolkit functionality \(and no widgets\), e)72 442.2 Q +-.275(va)-.275 G(luate).275 E F5(\(require 'xt\).)108 463.2 Q F3 +(Note that all of the abo)72 484.2 Q .33 -.165(ve f)-.165 H +(orms cause the Elk/Xlib functions to be loaded as well.).165 E(Indi)72 502.8 Q +(vidual widgets are loaded by e)-.275 E -.275(va)-.275 G(luating).275 E F5 +(\(load-widgets .)108 523.8 Q F4(widg)6.6 E(et-names)-.11 E F5(\))A F3(Each)72 +548.4 Q F4(widg)2.75 E(et-name)-.11 E F3(is a symbol \(not quoted, since)2.75 E +F4(load-widg)2.75 E(ets)-.11 E F3(is a macro\).)2.75 E 6.324 +(The widgets are loaded from subdirectories of `)97 567 R +(`$install_dir/runtime/obj')-.814 E 9.074('\()-.814 G(where)477.127 567 Q +($install_dir is the directory where you ha)72 582 Q .33 -.165(ve i)-.22 H +(nstalled Elk on your system\).).165 E .17(In the follo)97 600.6 R .17 +(wing, the types of ar)-.275 F .169 +(guments of the listed procedures are not speci\214ed when the)-.198 F(y)-.165 +E 2.05(are ob)72 615.6 R 2.05(vious from the conte)-.165 F 2.05 +(xt or from the name.)-.165 F -.165(Fo)7.55 G 4.8(ri).165 G 2.05 +(nstance, an ar)326.635 615.6 R 2.051(gument named)-.198 F F4(widg)4.801 E(et) +-.11 E F3(is)4.801 E(al)72 630.6 Q -.11(wa)-.11 G .759(ys of type).11 F F4 +(widg)3.509 E(et)-.11 E F3 3.509(,a)C 3.509(na)181.329 630.6 S -.198(rg)195.222 +630.6 S .759(ument named).198 F F4(conte)3.509 E(xt)-.22 E F3 .759 +(is an object of type)3.509 F F4(conte)3.508 E(xt)-.22 E F3 .758 +(\(application con-)3.508 F(te)72 645.6 Q(xt\), etc.)-.165 E(Ar)5.5 E +(guments the names of which end in `)-.198 E(`?')-.814 E 2.75('a)-.814 G(re al) +314.088 645.6 Q -.11(wa)-.11 G(ys of type).11 E F4(boolean)2.75 E F3(.)A .612 +(In the follo)97 664.2 R .612 +(wing, each description of a procedure, special form, or v)-.275 F .613 +(ariable lists the kind of)-.275 F .736(object in boldf)72 679.2 R 3.485 +(ace. Here,)-.11 F F2(pr)3.485 E(ocedur)-.198 E(e)-.198 E F3 .735 +(denotes either a primiti)3.485 F 1.065 -.165(ve p)-.275 H .735 +(rocedure or a compound proce-).165 F(dure,)72 694.2 Q F2(syntax)3.616 E F3 +.866(denotes a special form or a macro, and)3.616 F F2 -.11(va)3.616 G(riable) +.11 E F3 .866(denotes a global v)3.616 F .866(ariable that has)-.275 F +(some initial v)72 709.2 Q(alue and can be re-assigned a ne)-.275 E 2.75(wv) +-.275 G(alue by the user \(by means of)288.986 709.2 Q F4(set!)2.75 E F3(or) +2.75 E F4(\215uid-let)2.75 E F3(\).)A EP +%%Page: 2 2 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-2-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(2. W)72 87 R(idget Classes)-.198 E +(\(class?)72 117 Q/F2 11/Times-Italic@0 SF(x)4.583 E F1 339.835(\)p)C -.198(ro) +462.244 117 S(cedur).198 E(e)-.198 E F0(Returns #t if)72 135.6 Q(f)-.275 E F2 +(x)2.75 E F0(is an object of type)2.75 E F2(class)2.75 E F0(\(widget class\).) +2.75 E F1(\(\214nd-class)72 165.6 Q F2(name-of-class)4.583 E F1 266.498(\)p)C +-.198(ro)462.244 165.6 S(cedur).198 E(e)-.198 E F0 .268 +(Returns the widget class of the speci\214ed name \(an object of type)72 184.2 +R F2(class)3.018 E F0(\).)A F2(name-of-class)5.768 E F0 .268(is a string)3.018 +F(or a symbol.)72 199.2 Q F1(\(class-r)72 229.2 Q(esour)-.198 E(ces)-.198 E F2 +(widg)4.583 E(et-class)-.11 E F1 247.468(\)p)C -.198(ro)462.244 229.2 S(cedur) +.198 E(e)-.198 E F0(See)72 247.8 Q F2(XtGetResour)3.463 E(ceList)-.407 E F0 +6.214(.R)C .714(eturns the resource list of the speci\214ed widget class.) +190.346 247.8 R .714(Each element of)6.214 F(the list is a list of three symbo\ +ls \255 the resource name, the resource class, and the resource type.)72 262.8 +Q F1(\(class-constraint-r)72 292.8 Q(esour)-.198 E(ces)-.198 E F2(widg)4.583 E +(et-class)-.11 E F1 196.142(\)p)C -.198(ro)462.244 292.8 S(cedur).198 E(e)-.198 +E F0(See)72 311.4 Q F2(XtGetConstr)4.107 E(aintRespour)-.165 E(ceList)-.407 E +F0 6.857(.R)C 1.357 +(eturns the list of constraint resources that are de\214ned for)244.037 311.4 R +.182(the speci\214ed widget class.)72 326.4 R .182 +(Each element of the list is a list of three symbols \255 the resource name,) +5.682 F(the resource class, and the resource type.)72 341.4 Q F1(\(class-sub-r) +72 371.4 Q(esour)-.198 E(ces)-.198 E F2(widg)4.583 E(et-class)-.11 E F1 227.294 +(\)p)C -.198(ro)462.244 371.4 S(cedur).198 E(e)-.198 E F0 2.315 +(Returns the list of sub-resources \(if there are an)72 390 R 2.315 +(y\) of the speci\214ed widget class.)-.165 F(See)7.815 E F2(class-)5.064 E +-.407(re)72 405 S(sour).407 E(ces)-.407 E F0(abo)2.75 E -.165(ve)-.165 G(.).165 +E F1(\(class-exists?)72 435 Q F2(name-of-class)4.583 E F1 253.683(\)p)C -.198 +(ro)462.244 435 S(cedur).198 E(e)-.198 E F0 1.271(Returns #t if)72 453.6 R +4.021(faw)-.275 G 1.272(idget class of the gi)153.798 453.6 R -.165(ve)-.275 G +4.022(nn).165 G 1.272(ame e)269.399 453.6 R 1.272(xists \(i.)-.165 F 1.272 +(e. has been loaded by means of)1.833 F F2(load-)4.022 E(widg)72 468.6 Q(ets) +-.11 E F0(\).)A F2(name-of-class)5.5 E F0(is a string or a symbol.)2.75 E F1 +2.75(3. W)72 498.6 R(idget Functions)-.198 E(\(widget?)72 528.6 Q F2(x)4.583 E +F1 330.672(\)p)C -.198(ro)462.244 528.6 S(cedur).198 E(e)-.198 E F0 +(Returns #t if)72 547.2 Q(f)-.275 E F2(x)2.75 E F0(is an object of type)2.75 E +F2(widg)2.75 E(et)-.11 E F0(.)A F1(\(destr)72 577.2 Q(oy-widget)-.198 E F2 +(widg)4.583 E(et)-.11 E F1 273.538(\)p)C -.198(ro)462.244 577.2 S(cedur).198 E +(e)-.198 E F0(See)72 595.8 Q F2(XtDestr)2.75 E(oyW)-.495 E(idg)-.605 E(et)-.11 +E F0(.)A F1(\(cr)72 625.8 Q(eate-shell)-.198 E F2 +(application-name application-class par)4.583 E(ent display . ar)-.407 E(gs) +-.407 E F1 69.532(\)p)C -.198(ro)462.244 625.8 S(cedur).198 E(e)-.198 E F0(See) +72 644.4 Q F2(XtAppCr)5.539 E(eateShell)-.407 E F0(.)A F2(application-name) +8.289 E F0(and)5.538 E F2(application-class)5.538 E F0 2.788 +(are strings or symbols or #f)5.538 F .404 +(\(NULL is used in the latter case\).)72 659.4 R F2(par)5.904 E(ent)-.407 E F0 +.404(is a widget.)3.154 F .404(The number of)5.904 F F2(ar)3.154 E(gs)-.407 E +F0 .404(must be e)3.154 F -.165(ve)-.275 G .404(n, the 1st,).165 F 1.203 +(3rd, etc. ar)72 674.4 R 1.203(gument is the name of a resource to be set \(a \ +string or a symbol\), the 2nd, 4th, etc.)-.198 F(ar)72 689.4 Q +(gument is the corresponding v)-.198 E(alue.)-.275 E EP +%%Page: 3 3 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-3-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(cr)72 87 Q(eate-widget)-.198 E/F2 11 +/Times-Italic@0 SF(widg)4.583 E(et-class par)-.11 E(ent . ar)-.407 E(gs)-.407 E +F1 195.537(\)p)C -.198(ro)462.244 87 S(cedur).198 E(e)-.198 E(\(cr)72 102 Q +(eate-widget)-.198 E F2(widg)4.583 E(et-name widg)-.11 E(et-class par)-.11 E +(ent . ar)-.407 E(gs)-.407 E F1 136.071(\)p)C -.198(ro)462.244 102 S(cedur).198 +E(e)-.198 E F0(See)72 120.6 Q F2(XtCr)3.089 E(eateW)-.407 E(idg)-.605 E(et)-.11 +E F0(.)A F2(widg)5.839 E(et-name)-.11 E F0 .339(is a string or a symbol;)3.089 +F F2(par)3.089 E(ent)-.407 E F0 .34(is a widget.)3.089 F .34(If no)5.84 F F2 +(widg)3.09 E(et-name)-.11 E F0 .141(is gi)72 135.6 R -.165(ve)-.275 G .141 +(n, the name of the widget class is used.).165 F .141(The number of)5.641 F F2 +(ar)2.891 E(gs)-.407 E F0 .14(must be e)2.89 F -.165(ve)-.275 G .14 +(n, the 1st, 3rd, etc.).165 F(ar)72 150.6 Q .418(gument is the name of a resou\ +rce to be set \(a string or a symbol\), the 2nd, 4th, etc. ar)-.198 F .418 +(gument is)-.198 F(the corresponding v)72 165.6 Q(alue.)-.275 E F1(\(cr)72 +195.6 Q(eate-managed-widget)-.198 E F2 2.75(.a)4.583 G -.407(rg)201.015 195.6 S +(s).407 E F1 237.799(\)p)C -.198(ro)462.244 195.6 S(cedur).198 E(e)-.198 E F0 +(Applies)72 214.2 Q F2(cr)3.351 E(eate-widg)-.407 E(et)-.11 E F0 .601 +(to the ar)3.351 F .601(guments and then calls)-.198 F F2(mana)3.35 E -.11(ge) +-.11 G(-c).11 E(hild)-.165 E F0 .6(with the ne)3.35 F .6(wly created wid-)-.275 +F(get.)72 229.2 Q F1(\(r)72 259.2 Q(ealize-widget)-.198 E F2(widg)4.583 E(et) +-.11 E F1 277.212(\)p)C -.198(ro)462.244 259.2 S(cedur).198 E(e)-.198 E F0(See) +72 277.8 Q F2(XtRealizeW)2.75 E(idg)-.605 E(et)-.11 E F0(.)A F1(\(unr)72 307.8 +Q(ealize-widget)-.198 E F2(widg)4.583 E(et)-.11 E F1 264.98(\)p)C -.198(ro) +462.244 307.8 S(cedur).198 E(e)-.198 E F0(See)72 326.4 Q F2(XtUnr)2.75 E +(ealizeW)-.407 E(idg)-.605 E(et)-.11 E F0(.)A F1(\(widget-r)72 356.4 Q +(ealized?)-.198 E F2(widg)4.583 E(et)-.11 E F1 265.596(\)p)C -.198(ro)462.244 +356.4 S(cedur).198 E(e)-.198 E F0(See)72 375 Q F2(XtIsRealized)2.75 E F0(.)A F1 +(\(widget-display)72 405 Q F2(widg)4.583 E(et)-.11 E F1 274.539(\)p)C -.198(ro) +462.244 405 S(cedur).198 E(e)-.198 E F0(See)72 423.6 Q F2(XtDisplay)2.75 E F0 +5.5(.R)C(eturns an object of type)150.221 423.6 Q F2(display)2.75 E F0(.)A F1 +(\(widget-par)72 453.6 Q(ent)-.198 E F2(widg)4.583 E(et)-.11 E F1 277.201(\)p)C +-.198(ro)462.244 453.6 S(cedur).198 E(e)-.198 E F0(See)72 472.2 Q F2(XtP)2.75 E +(ar)-.88 E(ent)-.407 E F0(.)A F1(\(widget-name)72 502.2 Q F2(widg)4.583 E(et) +-.11 E F1 282.503(\)p)C -.198(ro)462.244 502.2 S(cedur).198 E(e)-.198 E F0(See) +72 520.8 Q F2(XtName)2.75 E F0 5.5(.R)C +(eturns the name of a widget as a string.)141.663 520.8 Q F1(\(widget)72 550.8 +Q/F3 11/Symbol SF(-)A F1(>windo)A(w)-.11 E F2(widg)4.583 E(et)-.11 E F1 262.956 +(\)p)C -.198(ro)462.244 550.8 S(cedur).198 E(e)-.198 E(\(widget-windo)72 565.8 +Q(w)-.11 E F2(widg)4.583 E(et)-.11 E F1 271.602(\)p)C -.198(ro)462.244 565.8 S +(cedur).198 E(e)-.198 E F0(See)72 584.4 Q F2(XtW)2.75 E(indow)-.605 E F0 5.5 +(.R)C(eturns an object of type)151.453 584.4 Q F2(window)2.75 E F0(.)A F1 +(\(widget-composite?)72 614.4 Q F2(widg)4.583 E(et)-.11 E F1 255.619(\)p)C +-.198(ro)462.244 614.4 S(cedur).198 E(e)-.198 E F0(See)72 633 Q F2 +(XtIsComposite)2.75 E F0(.)A F1(\(manage-childr)72 663 Q(en)-.198 E F2 2.75(.w) +4.583 G(idg)172.327 663 Q(ets)-.11 E F1 253.969(\)p)C -.198(ro)462.244 663 S +(cedur).198 E(e)-.198 E F0(See)72 681.6 Q F2(XtMana)2.75 E -.11(ge)-.11 G +(Childr).11 E(en)-.407 E F0(.)A EP +%%Page: 4 4 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-4-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(manage-child)72 87 Q/F2 11/Times-Italic@0 +SF(widg)4.583 E(et)-.11 E F1 279.434(\)p)C -.198(ro)462.244 87 S(cedur).198 E +(e)-.198 E F0(Calls)72 105.6 Q F2(mana)2.75 E -.11(ge)-.11 G(-c).11 E(hildr) +-.165 E(en)-.407 E F0(with the speci\214ed widget.)2.75 E F1(\(unmanage-childr) +72 135.6 Q(en)-.198 E F2 2.75(.w)4.583 G(idg)184.559 135.6 Q(ets)-.11 E F1 +241.737(\)p)C -.198(ro)462.244 135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q +F2(XtUnmana)2.75 E -.11(ge)-.11 G(Childr).11 E(en)-.407 E F0(.)A F1 +(\(unmanage-child)72 184.2 Q F2(widg)4.583 E(et)-.11 E F1 267.202(\)p)C -.198 +(ro)462.244 184.2 S(cedur).198 E(e)-.198 E F0(Calls)72 202.8 Q F2(unmana)2.75 E +-.11(ge)-.11 G(-c).11 E(hildr)-.165 E(en)-.407 E F0 +(with the speci\214ed widget.)2.75 E F1(\(widget-managed?)72 232.8 Q F2(widg) +4.583 E(et)-.11 E F1 259.887(\)p)C -.198(ro)462.244 232.8 S(cedur).198 E(e) +-.198 E F0(See)72 251.4 Q F2(XtIsMana)2.75 E -.11(ge)-.11 G(d).11 E F0(.)A F1 +(\(widget-class)72 281.4 Q F2(widg)4.583 E(et)-.11 E F1 286.166(\)p)C -.198(ro) +462.244 281.4 S(cedur).198 E(e)-.198 E F0(See)72 300 Q F2(XtClass)2.75 E F0 5.5 +(.R)C(eturns an object of type)140.453 300 Q F2(class)2.75 E F0(.)A F1 +(\(widget-super)72 330 Q(class)-.198 E F2(widg)4.583 E(et)-.11 E F1 260.085 +(\)p)C -.198(ro)462.244 330 S(cedur).198 E(e)-.198 E F0(See)72 348.6 Q F2 +(XtSuper)3.643 E(class)-.407 E F0 6.393(.R)C .893(eturns an object of type) +165.042 348.6 R F2(class)3.644 E F0 .894(or the symbol)3.644 F/F3 11/Courier@0 +SF(none)3.644 E F0 .894(when the widget')3.644 F 3.644(sc)-.605 G(lass)487.5 +348.6 Q(does not ha)72 363.6 Q .33 -.165(ve a s)-.22 H(uper).165 E(-class.)-.22 +E F1(\(widget-subclass?)72 393.6 Q F2(widg)4.583 E(et class)-.11 E F1 239.405 +(\)p)C -.198(ro)462.244 393.6 S(cedur).198 E(e)-.198 E F0(See)72 412.2 Q F2 +(XtIsSubclass)2.75 E F0(.)A F1(\(set-mapped-when-managed!)72 442.2 Q F2(widg) +4.583 E(et mana)-.11 E -.11(ge)-.11 G(d?).11 E F1 161.426(\)p)C -.198(ro) +462.244 442.2 S(cedur).198 E(e)-.198 E F0(See)72 460.8 Q F2 +(XtSetMappedWhenMana)2.75 E -.11(ge)-.11 G(d).11 E F0(.)A F1(\(map-widget)72 +490.8 Q F2(widg)4.583 E(et)-.11 E F1 287.387(\)p)C -.198(ro)462.244 490.8 S +(cedur).198 E(e)-.198 E F0(See)72 509.4 Q F2(XtMapW)2.75 E(idg)-.605 E(et)-.11 +E F0(.)A F1(\(unmap-widget)72 539.4 Q F2(widg)4.583 E(et)-.11 E F1 275.155(\)p) +C -.198(ro)462.244 539.4 S(cedur).198 E(e)-.198 E F0(See)72 558 Q F2(XtUnmapW) +2.75 E(idg)-.605 E(et)-.11 E F0(.)A F1(\(set-v)72 588 Q(alues!)-.11 E F2(widg) +4.583 E(et . ar)-.11 E(gs)-.407 E F1 266.212(\)p)C -.198(ro)462.244 588 S +(cedur).198 E(e)-.198 E F0(See)72 606.6 Q F2(XtSetV)3.488 E(alues)-1.221 E F0 +6.238(.T)C .738(he number of)159.023 606.6 R F2(ar)3.488 E(gs)-.407 E F0 .738 +(must be e)3.488 F -.165(ve)-.275 G .737(n, the 1st, 3rd, etc. ar).165 F .737 +(gument is the name of a)-.198 F +(resource to be set \(a string or a symbol\), the 2nd, 4th, etc. ar)72 621.6 Q +(gument is the corresponding v)-.198 E(alue.)-.275 E F1(\(get-v)72 651.6 Q +(alues)-.11 E F2(widg)4.583 E(et . ar)-.11 E(gs)-.407 E F1 268.654(\)p)C -.198 +(ro)462.244 651.6 S(cedur).198 E(e)-.198 E F0(See)72 670.2 Q F2(XtGetV)3.109 E +(alues)-1.221 E F0 5.86(.E)C(ach)160.708 670.2 Q F2(ar)3.11 E(g)-.407 E F0 .36 +(is the name of a resource \(a string or a symbol\).)3.11 F .36 +(Returns a list of the)5.86 F -.275(va)72 685.2 S +(lues of the speci\214ed resources.).275 E EP +%%Page: 5 5 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-5-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(widget-context)72 87 Q/F2 11/Times-Italic@0 +SF(widg)4.583 E(et)-.11 E F1 273.956(\)p)C -.198(ro)462.244 87 S(cedur).198 E +(e)-.198 E F0(See)72 105.6 Q F2(XtW)2.75 E(idg)-.605 E(etT)-.11 E +(oApplicationConte)-1.012 E(xt)-.22 E F0 5.5(.R)C(eturns an object of type) +242.39 105.6 Q F2(conte)2.75 E(xt)-.22 E F0(.)A F1(\(set-sensiti)72 135.6 Q +-.11(ve)-.11 G(!).11 E F2(widg)4.583 E(et sensitive?)-.11 E F1 237.205(\)p)C +-.198(ro)462.244 135.6 S(cedur).198 E(e)-.198 E F0(See)72 154.2 Q F2 +(XtSetSensitive)2.75 E F0(.)A F1(\(widget-sensiti)72 184.2 Q -.11(ve)-.11 G(?) +.11 E F2(widg)4.583 E(et)-.11 E F1 263.165(\)p)C -.198(ro)462.244 184.2 S +(cedur).198 E(e)-.198 E F0(See)72 202.8 Q F2(XtIsSensitive)2.75 E F0(.)A F1 +(\(windo)72 232.8 Q(w)-.11 E/F3 11/Symbol SF(-)A F1(>widget)A F2(window)4.583 E +F1 257.951(\)p)C -.198(ro)462.244 232.8 S(cedur).198 E(e)-.198 E F0(See)72 +251.4 Q F2(XtW)2.75 E(indowT)-.605 E(oW)-1.012 E(idg)-.605 E(et)-.11 E F0(.)A +F1(\(name)72 281.4 Q F3(-)A F1(>widget)A F2 -.495(ro)4.583 G(ot-widg).495 E +(et name)-.11 E F1 225.776(\)p)C -.198(ro)462.244 281.4 S(cedur).198 E(e)-.198 +E F0(See)72 300 Q F2(XtNameT)2.75 E(oW)-1.012 E(idg)-.605 E(et)-.11 E F0(.)A F2 +(name)5.5 E F0(is a string or a symbol.)2.75 E F1 +(\(widget-translate-coordinates)72 330 Q F2(widg)4.583 E(et x y)-.11 E F1 +193.304(\)p)C -.198(ro)462.244 330 S(cedur).198 E(e)-.198 E F0(See)72 348.6 Q +F2(XtT)2.75 E -.165(ra)-.605 G(nslateCoor).165 E(ds)-.407 E F0 5.5(.R)C +(eturns the root-relati)189.392 348.6 Q .33 -.165(ve x a)-.275 H +(nd y coordinates as a pair of inte).165 E(gers.)-.165 E F1 2.75(4. Callback)72 +378.6 R(Functions)2.75 E(\(add-callbacks)72 408.6 Q F2(widg)4.583 E(et callbac) +-.11 E(k-name . callbac)-.22 E(k-functions)-.22 E F1 121.617(\)p)C -.198(ro) +462.244 408.6 S(cedur).198 E(e)-.198 E F0(See)72 427.2 Q F2(XtAddCallbac)2.808 +E(ks)-.22 E F0 5.558(.A)C .057 +(dds the functions to a callback list of the speci\214ed widget.)178.222 427.2 +R F2(callbac)5.557 E(k-name)-.22 E F0 1.092(is a string or a symbol.)72 442.2 R +1.093(Each callback function will be called with at least one ar)6.592 F 1.093 +(gument \255 the)-.198 F(widget to which the function has been attached.)72 +457.2 Q F1(\(add-callback)72 487.2 Q F2(widg)4.583 E(et callbac)-.11 E +(k-name callbac)-.22 E(k-function)-.22 E F1 135.675(\)p)C -.198(ro)462.244 +487.2 S(cedur).198 E(e)-.198 E F0(Calls)72 505.8 Q F2(add-callbac)2.75 E(ks) +-.22 E F0(with the speci\214ed function.)2.75 E F1 2.75(5. P)72 535.8 R +(opup Shells)-.22 E(\(cr)72 565.8 Q(eate-popup-shell)-.198 E F2(widg)4.583 E +(et-class par)-.11 E(ent-widg)-.407 E(et . ar)-.11 E(gs)-.407 E F1 138.788(\)p) +C -.198(ro)462.244 565.8 S(cedur).198 E(e)-.198 E(\(cr)72 580.8 Q +(eate-popup-shell)-.198 E F2(widg)4.583 E(et-name widg)-.11 E(et-class par)-.11 +E(ent-widg)-.407 E(et . ar)-.11 E(gs)-.407 E F1 79.322(\)p)C -.198(ro)462.244 +580.8 S(cedur).198 E(e)-.198 E F0(See)72 599.4 Q F2(XtCr)3.727 E(eateP)-.407 E +(opupShell)-.88 E F0(.)A F2(widg)6.477 E(et-name)-.11 E F0 .977 +(is a string or a symbol.)3.727 F .976(If no widget name is gi)6.477 F -.165 +(ve)-.275 G .976(n, the).165 F .714(name of the shell class is used.)72 614.4 R +.714(The number of)6.214 F F2(ar)3.464 E(gs)-.407 E F0 .714(must be e)3.464 F +-.165(ve)-.275 G .715(n, the 1st, 3rd, etc. ar).165 F .715(gument is)-.198 F +.867(the name of a resource to be set \(a string or a symbol\), the 2nd, 4th, \ +etc. ar)72 629.4 R .867(gument is the corre-)-.198 F(sponding v)72 644.4 Q +(alue.)-.275 E F1(\(popup)72 674.4 Q F2(shell-widg)4.583 E(et gr)-.11 E +(ab-kind)-.165 E F1 242.617(\)p)C -.198(ro)462.244 674.4 S(cedur).198 E(e)-.198 +E F0(See)72 693 Q F2(XtP)6.915 E(opup)-.88 E F0(.)A F2(gr)9.665 E(ab-kind)-.165 +E F0 4.165(is a symbol \()6.915 F/F4 11/Courier@0 SF(grab-once)A F0(,)A F4 +(grab-nonexclusive)6.915 E F0 6.915(,o)C(r)460.422 693 Q F4(grab-)6.915 E +(exclusive)72 708 Q F0(\).)A EP +%%Page: 6 6 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-6-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(popdo)72 87 Q(wn)-.11 E/F2 11 +/Times-Italic@0 SF(shell-widg)4.583 E(et)-.11 E F1 275.254(\)p)C -.198(ro) +462.244 87 S(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2(XtP)2.75 E(opdown)-.88 +E F0(.)A F1 2.75(6. A)72 135.6 R(pplication Contexts)-.275 E(\(context?)72 +165.6 Q F2(x)4.583 E F1 327.625(\)p)C -.198(ro)462.244 165.6 S(cedur).198 E(e) +-.198 E F0(Returns #t if)72 184.2 Q(f)-.275 E F2(x)2.75 E F0 +(is an object of type)2.75 E F2(conte)2.75 E(xt)-.22 E F0(\(application conte) +2.75 E(xt\).)-.165 E F1(\(cr)72 214.2 Q -.917(eate-context \))-.198 F(pr) +456.128 214.2 Q(ocedur)-.198 E(e)-.198 E F0(See)72 232.8 Q F2(XtCr)2.75 E +(eateApplicationConte)-.407 E(xt)-.22 E F0(.)A F1(\(destr)72 262.8 Q +(oy-context)-.198 E F2(conte)4.583 E(xt)-.22 E F1 268.17(\)p)C -.198(ro)462.244 +262.8 S(cedur).198 E(e)-.198 E F0(See)72 281.4 Q F2(XtDestr)2.75 E +(oyApplicationConte)-.495 E(xt)-.22 E F0(.)A F1(\(initialize-display)72 311.4 Q +F2(conte)4.583 E(xt display application-name application-class)-.22 E F1 69.631 +(\)p)C -.198(ro)462.244 311.4 S(cedur).198 E(e)-.198 E F0(See)72 330 Q F2 +(XtDisplayInitialize)3.275 E F0(,)A F2(XtOpenDisplay)3.275 E F0 6.025(.I)C(f) +260.564 330 Q F2(display)3.275 E F0 .525(is an object of type)3.275 F F2 +(display)3.274 E F0(,)A F2(XtDisplayInitial-)3.274 E(ize)72 345 Q F0 1.001 +(is called.)3.751 F(If)6.501 E F2(display)3.751 E F0 1.001 +(is a display name \(a string or a symbol\) or #f,)3.751 F F2(XtOpenDisplay) +3.752 E F0 1.002(is called)3.752 F .59 +(\(with a NULL display in the latter case\), and the ne)72 360 R .589 +(wly opened display is returned.)-.275 F F2(application-)6.089 E(name)72 375 Q +F0(and)3.284 E F2(application-class)3.284 E F0 .535 +(are strings or symbols or #f \(NULL and the empty string are used in)3.284 F +(the latter case\).)72 390 Q F1(\(application-initialize)72 420 Q F2 +(name . fallbac)4.583 E(k-r)-.22 E(esour)-.407 E(ces)-.407 E F1 162.735(\)p)C +-.198(ro)462.244 420 S(cedur).198 E(e)-.198 E F0 4.228(Ac)72 438.6 S(on)89.054 +438.6 Q -.165(ve)-.44 G 1.478 +(nience function that creates an application conte).165 F 1.478 +(xt by a call to)-.165 F F2(cr)4.227 E(eate-conte)-.407 E(xt)-.22 E F0 4.227 +(,s)C 1.477(ets the)474.11 438.6 R -.11(fa)72 453.6 S .696 +(llback resources \(if an).11 F .696(y\), initializes the display by a call to) +-.165 F F2(initialize-display)3.446 E F0 .696(with the speci\214ed)3.446 F F2 +(name)72 468.6 Q F0 .257 +(and a class of #f, and creates and returns an application shell with the name) +3.008 F F2(name)3.007 E F0 .257(and class)3.007 F(#f.)72 483.6 Q(Calling)72 +502.2 Q F2(application-initialize)2.863 E F0 .113 +(more than once may cause the application conte)2.863 F .114 +(xts and displays that)-.165 F +(were created by earlier calls to be closed during a future g)72 517.2 Q +(arbage collection.)-.055 E F1(\(display)72 547.2 Q/F3 11/Symbol SF(-)A F1 +(>context)A F2(display)4.583 E F1 260.294(\)p)C -.198(ro)462.244 547.2 S(cedur) +.198 E(e)-.198 E F0(See)72 565.8 Q F2(XtDisplayT)2.75 E(oApplicationConte) +-1.012 E(xt)-.22 E F0(.)A F1(\(set-context-fallback-r)72 595.8 Q(esour)-.198 E +(ces!)-.198 E F2(conte)4.583 E(xt . r)-.22 E(esour)-.407 E(ces)-.407 E F1 +146.686(\)p)C -.198(ro)462.244 595.8 S(cedur).198 E(e)-.198 E F0(See)72 614.4 Q +F2(XtAppSetF)2.75 E(allbac)-.825 E(kResour)-.22 E(ces)-.407 E F0 5.5(.E)C(ach) +229.41 614.4 Q F2 -.407(re)2.75 G(sour).407 E(ce)-.407 E F0(is a string.)2.75 E +F1(\(context-main-loop)72 644.4 Q F2(conte)4.583 E(xt)-.22 E F1 255.124(\)p)C +-.198(ro)462.244 644.4 S(cedur).198 E(e)-.198 E F0(See)72 663 Q F2 +(XtAppMainLoop)2.75 E F0(.)A EP +%%Page: 7 7 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-7-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF(\(context-pending)72 87 Q/F2 11 +/Times-Italic@0 SF(conte)4.583 E(xt)-.22 E F1 264.892(\)p)C -.198(ro)462.244 87 +S(cedur).198 E(e)-.198 E F0(See)72 105.6 Q F2(XtAppP)2.75 E(ending)-.88 E F0 +5.5(.R)C(eturns a list of symbols \()169.504 105.6 Q/F3 11/Courier@0 SF +(x-event)A F0(,)A F3(timer)2.75 E F0(,)A F3(alternate-input)2.75 E F0(\).)A F1 +(\(context-pr)72 135.6 Q(ocess-e)-.198 E -.11(ve)-.165 G(nt).11 E F2(conte) +4.583 E(xt . mask)-.22 E F1 208.88(\)p)C -.198(ro)462.244 135.6 S(cedur).198 E +(e)-.198 E F0(See)72 154.2 Q F2(XtPr)5.373 E(ocessEvent)-.495 E F0 8.123(.T)C +2.623(he optional ar)180.008 154.2 R(gument)-.198 E F2(mask)5.372 E F0 2.622 +(is a list of symbols \(see)5.372 F F2(conte)5.372 E(xt-pending)-.22 E F0(abo) +72 169.2 Q -.165(ve)-.165 G(\).).165 E F2(XtIMAll)5.5 E F0(is used if the)2.75 +E F2(mask)2.75 E F0(ar)2.75 E(gument is omitted)-.198 E F1(\(context-add-w)72 +199.2 Q(ork-pr)-.11 E(oc)-.198 E F2(conte)4.583 E(xt pr)-.22 E(ocedur)-.495 E +(e)-.407 E F1 185.164(\)p)C -.198(ro)462.244 199.2 S(cedur).198 E(e)-.198 E F0 +(See)72 217.8 Q F2(XtAppAddW)3.416 E(orkPr)-1.012 E(oc)-.495 E F0 6.166(.R)C +.666(eturns an)196.477 217.8 R F2(identi\214er)3.416 E F0 .667 +(that can be used as an ar)3.416 F .667(gument to)-.198 F F2 -.407(re)3.417 G +(mo).407 E(ve-work-)-.11 E(pr)72 232.8 Q(oc)-.495 E F0(.)A F2(pr)5.5 E(ocedur) +-.495 E(e)-.407 E F0(is a procedure with no ar)2.75 E(guments.)-.198 E F1(\(r) +72 262.8 Q(emo)-.198 E -.11(ve)-.11 G(-w).11 E(ork-pr)-.11 E(oc)-.198 E F2 +(identi\214er)4.583 E F1 245.257(\)p)C -.198(ro)462.244 262.8 S(cedur).198 E(e) +-.198 E F0(See)72 281.4 Q F2(XtRemo)4.323 E(veW)-.11 E(orkPr)-1.012 E(oc)-.495 +E F0(.)A F2(identi\214er)7.073 E F0 1.573(must be the return v)4.323 F 1.573 +(alue of a pre)-.275 F 1.572(vious call to)-.275 F F2(conte)4.322 E(xt-add-) +-.22 E(work-pr)72 296.4 Q(oc)-.495 E F0 5.5(.E)C(ach such)132.302 296.4 Q F2 +(identi\214er)2.75 E F0(can be used as an ar)2.75 E(gument for)-.198 E F2 -.407 +(re)2.75 G(mo).407 E(ve-work-pr)-.11 E(oc)-.495 E F0(only once.)2.75 E F1 +(\(context-add-timeout)72 326.4 Q F2(conte)4.583 E(xt timer)-.22 E(-value pr) +-.22 E(ocedur)-.495 E(e)-.407 E F1 145.058(\)p)C -.198(ro)462.244 326.4 S +(cedur).198 E(e)-.198 E F0(See)72 345 Q F2(XtAppAddT)4.13 E(imeOut)-.605 E F0 +(.)A F2(timer)6.88 E(-value)-.22 E F0 1.38(is an inte)4.13 F(ger)-.165 E 6.88 +(.R)-.605 G 1.38(eturns an)312.105 345 R F2(identi\214er)4.13 E F0 1.381 +(that can be used as an)4.13 F(ar)72 360 Q .355(gument to)-.198 F F2 -.407(re) +3.105 G(mo).407 E(ve-timeout)-.11 E F0 5.855(.T)C .354 +(he time-out procedure will be called with one ar)211.962 360 R .354 +(gument, the iden-)-.198 F .081(ti\214er returned by the call to)72 375 R F2 +(conte)2.831 E(xt-add-timeout)-.22 E F0 -.917(\(i. e.)2.831 F .081 +(the object that uniquely identi\214es the timer\).)2.831 F F1(\(r)72 405 Q +(emo)-.198 E -.11(ve)-.11 G(-timeout).11 E F2(identi\214er)4.583 E F1 258.391 +(\)p)C -.198(ro)462.244 405 S(cedur).198 E(e)-.198 E F0(See)72 423.6 Q F2 +(XtRemo)4.77 E(veT)-.11 E(imeOut)-.605 E F0(.)A F2(identi\214er)7.52 E F0 2.02 +(must be the return v)4.77 F 2.019(alue of a pre)-.275 F 2.019(vious call to) +-.275 F F2(conte)4.769 E(xt-add-)-.22 E(timeout)72 438.6 Q F0 5.5(.E)C +(ach such)119.971 438.6 Q F2(identi\214er)2.75 E F0(can be used as an ar)2.75 E +(gument for)-.198 E F2 -.407(re)2.75 G(mo).407 E(ve-timeout)-.11 E F0 +(only once.)2.75 E F1(\(context-add-input)72 468.6 Q F2(conte)4.583 E(xt sour) +-.22 E(ce pr)-.407 E(ocedur)-.495 E 2.75(e.m)-.407 G(ask)291.05 468.6 Q F1 +146.752(\)p)C -.198(ro)462.244 468.6 S(cedur).198 E(e)-.198 E F0(See)72 487.2 Q +F2(XtAppAddInput)2.803 E F0(.)A F2(sour)5.553 E(ce)-.407 E F0 .053 +(is a \214le port.)2.803 F .053(Returns an)5.553 F F2(identi\214er)2.804 E F0 +.054(that can be used as an ar)2.804 F .054(gument to)-.198 F F2(conte)72 502.2 +Q(xt-r)-.22 E(emo)-.407 E(ve-input)-.11 E F0 6.076(.T)C(he)180.893 502.2 Q F2 +(pr)3.326 E(ocedur)-.495 E(e)-.407 E F0 .575(will be called with tw)3.325 F +3.325(oa)-.11 G -.198(rg)353.461 502.2 S .575(uments \255).198 F F2(sour)3.325 +E(ce)-.407 E F0 .575(and the identi-)3.325 F(\214er returned by the call to)72 +517.2 Q F2(conte)2.75 E(xt-add-input)-.22 E F0(.)A .317(The optional)72 535.8 R +F2(mask)3.067 E F0(ar)3.067 E .317 +(gument is a list of one or more of the symbols)-.198 F F2 -.407(re)3.067 G(ad) +.407 E F0(,)A F2(write)3.067 E F0 3.067(,a)C(nd)432.713 535.8 Q F2 -.22(ex) +3.067 G(ception).22 E F0 5.817(.I)C(t)500.942 535.8 Q .276 +(speci\214es the condition on which the procedure will be called.)72 550.8 R +.276(If no)5.776 F F2(mask)3.026 E F0(ar)3.026 E .276(gument is gi)-.198 F +-.165(ve)-.275 G(n,).165 E F2 -.407(re)3.026 G(ad).407 E F0 .807(is used if)72 +565.8 R F2(sour)3.557 E(ce)-.407 E F0 .807(is an input-port,)3.557 F F2(write) +3.557 E F0 .808(if it is an output-port, and both)3.557 F F2 -.407(re)3.558 G +(ad).407 E F0(and)3.558 E F2(write)3.558 E F0 .808(if it is an)3.558 F +(input-output-port.)72 580.8 Q F1(\(r)72 610.8 Q(emo)-.198 E -.11(ve)-.11 G +(-input).11 E F2(identi\214er)4.583 E F1 269.369(\)p)C -.198(ro)462.244 610.8 S +(cedur).198 E(e)-.198 E F0(See)72 629.4 Q F2(XtRemo)3.948 E(veInput)-.11 E F0 +(.)A F2(identi\214er)6.697 E F0 1.197(must be the return v)3.947 F 1.197 +(alue of a pre)-.275 F 1.197(vious call to)-.275 F F2(conte)3.947 E +(xt-add-input)-.22 E F0(.)A(Each such)72 644.4 Q F2(identi\214er)2.75 E F0 +(can be used as an ar)2.75 E(gument for)-.198 E F2 -.407(re)2.75 G(mo).407 E +(ve-input)-.11 E F0(only once.)2.75 E F1(\(identi\214er?)72 674.4 Q F2(x)4.583 +E F1 319.056(\)p)C -.198(ro)462.244 674.4 S(cedur).198 E(e)-.198 E F0 +(Returns #t if)72 693 Q(f)-.275 E F2(x)2.75 E F0(is an)2.75 E F2(identi\214er) +2.75 E F0(\(an object returned by functions lik)2.75 E(e)-.11 E F2(conte)2.75 E +(xt-add-timeout)-.22 E F0(\).)A EP +%%Page: 8 8 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-8-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(7. T)72 87 R +(ranslations Management Functions)-.814 E(\(context-add-action)72 117 Q/F2 11 +/Times-Italic@0 SF(conte)4.583 E(xt name pr)-.22 E(ocedur)-.495 E(e)-.407 E F1 +179.048(\)p)C -.198(ro)462.244 117 S(cedur).198 E(e)-.198 E F0(See)72 135.6 Q +F2(XtAppAddActions)3.323 E F0(.)A F2(name)6.073 E F0 .574 +(is the name of the action \(a string or a symbol\).)3.324 F .574 +(The action proce-)6.074 F .638(dure will be in)72 150.6 R -.22(vo)-.44 G -.11 +(ke).22 G 3.388(dw).11 G .638(ith three ar)175.213 150.6 R .638 +(guments: a widget, a list of e)-.198 F -.165(ve)-.275 G .637(nt-speci\214c ar) +.165 F .637(guments \(see)-.198 F F2(han-)3.387 E(dle-e)72 165.6 Q(vents)-.165 +E F0 2.75(\)a)C(nd a list of strings \(the action ar)127.726 165.6 Q +(guments\).)-.198 E F1(\(augment-translations)72 195.6 Q F2(widg)4.583 E(et tr) +-.11 E(anslation-table)-.165 E F1 166.233(\)p)C -.198(ro)462.244 195.6 S(cedur) +.198 E(e)-.198 E F0(See)72 214.2 Q F2(XtA)3.957 E(ugmentT)-.22 E -.165(ra)-.605 +G(nslations).165 E F0(.)A F2(tr)6.707 E(anslation-table)-.165 E F0 1.207 +(is a string;)3.957 F F2(XtP)3.957 E(ar)-.88 E(seT)-.11 E -.165(ra)-.605 G +(nslationT).165 E(able)-1.012 E F0 1.208(is applied to)3.957 F(it.)72 229.2 Q +F1(\(o)72 259.2 Q -.11(ve)-.11 G(rride-translations).11 E F2(widg)4.583 E +(et tr)-.11 E(anslation-table)-.165 E F1 167.685(\)p)C -.198(ro)462.244 259.2 S +(cedur).198 E(e)-.198 E F0(See)72 277.8 Q F2(XtOverrideT)3.866 E -.165(ra)-.605 +G(nslations).165 E F0(.)A F2(tr)6.616 E(anslation-table)-.165 E F0 1.116 +(is a string;)3.866 F F2(XtP)3.865 E(ar)-.88 E(seT)-.11 E -.165(ra)-.605 G +(nslationT).165 E(able)-1.012 E F0 1.115(is applied to)3.865 F(it.)72 292.8 Q +F1(\(uninstall-translations)72 322.8 Q F2(widg)4.583 E(et)-.11 E F1 242.749 +(\)p)C -.198(ro)462.244 322.8 S(cedur).198 E(e)-.198 E F0(See)72 341.4 Q F2 +(XtUninstallT)2.75 E -.165(ra)-.605 G(nslations).165 E F0(.)A F1 +(\(install-accelerators)72 371.4 Q F2(dst-widg)4.583 E(et sr)-.11 E(c-widg) +-.407 E(et)-.11 E F1 188.618(\)p)C -.198(ro)462.244 371.4 S(cedur).198 E(e) +-.198 E F0(See)72 390 Q F2(XtInstallAcceler)2.75 E(ator)-.165 E(s)-.11 E F0(.)A +F1(\(install-all-accelerators)72 420 Q F2(dst-widg)4.583 E(et sr)-.11 E(c-widg) +-.407 E(et)-.11 E F1 173.339(\)p)C -.198(ro)462.244 420 S(cedur).198 E(e)-.198 +E F0(See)72 438.6 Q F2(XtInstallAllAcceler)2.75 E(ator)-.165 E(s)-.11 E F0(.)A +F1(\(multi-click-time)72 468.6 Q F2(display)4.583 E F1 265.288(\)p)C -.198(ro) +462.244 468.6 S(cedur).198 E(e)-.198 E F0(See)72 487.2 Q F2(XtGetMultiClic)2.75 +E(kT)-.22 E(ime)-.605 E F0 5.5(.R)C(eturns an inte)200.117 487.2 Q(ger)-.165 E +(.)-.605 E F1(\(set-multi-click-time!)72 517.2 Q F2(display time)4.583 E F1 +223.444(\)p)C -.198(ro)462.244 517.2 S(cedur).198 E(e)-.198 E F0(See)72 535.8 Q +F2(XtSetMultiClic)2.75 E(kT)-.22 E(ime)-.605 E F0(.)A F2(time)5.5 E F0 +(is an inte)2.75 E(ger)-.165 E(.)-.605 E F1 2.75(8. Err)72 565.8 R(or Handling) +-.198 E(xt-war)72 595.8 Q 298.746(ning-handler v)-.165 F(ariable)-.11 E F0(See) +72 614.4 Q F2(XtSetW)3.089 E(arningHandler)-1.012 E F0 5.839(.W)C .339(hen a w) +207.318 614.4 R .339 +(arning message is to be printed by the Xt intrinsics and the)-.11 F .571 +(global v)72 629.4 R(ariable)-.275 E F2(xt-warning-handler)3.321 E F0 .571 +(is bound to a compound procedure, this procedure is in)3.321 F -.22(vo)-.44 G +-.11(ke).22 G(d).11 E .226(with the error message \(a string\) as an ar)72 +644.4 R 2.976(gument. When)-.198 F .226(this v)2.976 F .227 +(ariable is not bound to a compound)-.275 F .644 +(procedure, the message is sent to the current output port.)72 659.4 R .644 +(The initial v)6.144 F .643(alue of this v)-.275 F .643(ariable is the)-.275 F +(empty list.)72 674.4 Q .215(This interf)72 693 R .215 +(ace is bogus and will be replaced by a more useful mechanism in future v)-.11 +F .216(ersions of the)-.165 F(softw)72 708 Q(are.)-.11 E EP +%%Page: 9 9 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-9-)278.837 51 S .44 LW 77.5 57 72 57 DL 80.5 57 +75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 57 97 57 DL +108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 119 57 DL 130 +57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 57 DL 152 57 +146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 DL 174 57 +168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL 196 57 +190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 57 +212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 11/Times-Bold@0 SF 2.75(9. Miscellaneous)72 87 R(Functions)2.75 +E(\(xt-r)72 117 Q(elease-4-or)-.198 E -.917(-later? \))-.407 F(pr)456.128 117 Q +(ocedur)-.198 E(e)-.198 E F0(Returns al)72 135.6 Q -.11(wa)-.11 G(ys #t.).11 E +F1(\(xt-r)72 165.6 Q(elease-5-or)-.198 E -.917(-later? \))-.407 F(pr)456.128 +165.6 Q(ocedur)-.198 E(e)-.198 E F0 .337(Returns #t if)72 184.2 R 3.087(ft) +-.275 G .337(he Xt e)137.207 184.2 R .336(xtension is link)-.165 F .336 +(ed together with the X11 Release 5 toolkit intrinsics or later)-.11 F -.165 +(ve)72 199.2 S(rsions of the intrinsics.).165 E F1(\(xt-r)72 229.2 Q +(elease-6-or)-.198 E -.917(-later? \))-.407 F(pr)456.128 229.2 Q(ocedur)-.198 E +(e)-.198 E F0 .336(Returns #t if)72 247.8 R 3.086(ft)-.275 G .336(he Xt e) +137.204 247.8 R .336(xtension is link)-.165 F .336 +(ed together with the X11 Release 6 toolkit intrinsics or later)-.11 F -.165 +(ve)72 262.8 S(rsions of the intrinsics.).165 E F1 2.75(10. Interaction)72 +292.8 R(with the Garbage Collector)2.75 E F0 .391(The Scheme g)97 311.4 R .391 +(arbage collector destro)-.055 F .391(ys objects of type)-.11 F/F2 11 +/Times-Italic@0 SF(conte)3.14 E(xt)-.22 E F0(or)3.14 E F2(widg)3.14 E(et)-.11 E +F0 .39(that are not longer)3.14 F 2.133 +(accessible from within the Scheme program.)72 326.4 R 2.133 +(This is done by in)7.633 F -.22(vo)-.44 G 2.133(king the function).22 F F2 +(destr)4.883 E(oy-)-.495 E(conte)72 341.4 Q(xt)-.22 E F0(or)2.75 E F2(destr) +2.75 E(oy-widg)-.495 E(et)-.11 E F0 2.75(,r)C(especti)192.153 341.4 Q -.165(ve) +-.275 G(ly).165 E 2.75(,w)-.715 G(ith the unreferenced object as an ar)253.929 +341.4 Q(gument.)-.198 E 1.155(The g)97 360 R 1.154 +(arbage collector only destro)-.055 F 1.154(ys objects that ha)-.11 F 1.484 +-.165(ve b)-.22 H 1.154(een created from with the Scheme).165 F 2.068 +(program \(by functions lik)72 375 R(e)-.11 E F2(cr)4.819 E(eate-conte)-.407 E +(xt)-.22 E F0(or)4.819 E F2(cr)4.819 E(eate-widg)-.407 E(et)-.11 E F0 4.819 +(\). Objects)B 2.069(that ha)4.819 F 2.399 -.165(ve b)-.22 H 2.069 +(een obtained).165 F .172(from Xt through functions lik)72 390 R(e)-.11 E F2 +(widg)2.922 E(et-conte)-.11 E(xt)-.22 E F0 .171(\(and are o)2.922 F .171 +(wned by the Xt internals\), are ignored by)-.275 F(the g)72 405 Q +(arbage collector)-.055 E(.)-.605 E .341(Programmers must mak)97 423.6 R 3.092 +(es)-.11 G .342(ure that an object is accessible during the object')214.932 +423.6 R 3.092(se)-.605 G .342(ntire lifetime,)443.774 423.6 R 1.12 +(otherwise future runs of the g)72 438.6 R 1.119 +(arbage collector can result in undesired termination of the object.)-.055 F +.517(One must be especially careful when results of functions that create ne)72 +453.6 R 3.268(wo)-.275 G .518(bjects \(such as)404.799 453.6 R F2(cr)3.268 E +(eate-)-.407 E(conte)72 468.6 Q(xt)-.22 E F0 2.75(\)a)C +(re ignored or assigned to local v)114.845 468.6 Q(ariables as in)-.275 E/F3 10 +/Courier@0 SF(\(define \(initialize\))100.346 491.103 Q +(\(let* \(\(con \(create-context\)\))112.346 505.103 Q +(\(dpy \(initialize-display con #f 'Test #f\)\)\))160.346 519.103 Q +(\(create-shell 'Test #f \(find-class 'application-shell\) dpy\)\)\)\))124.346 +533.103 Q F0 1.841(In this e)97 558.703 R 1.84 +(xample, after termination of the function, the g)-.165 F 1.84 +(arbage collector will destro)-.055 F 4.59(yt)-.11 G(he)493.616 558.703 Q 1.691 +(application conte)72 573.703 R 1.691(xt created by the call to)-.165 F F2(cr) +4.442 E(eate-conte)-.407 E(xt)-.22 E F0 1.692(as well as the display)4.442 F +4.442(,a)-.715 G 4.442(st)443.187 573.703 S(he)454.966 573.703 Q 4.442(ya)-.165 +G 1.692(re no)480.011 573.703 R .141 +(longer directly accessible from within the program.)72 588.703 R .141 +(Bugs lik)5.641 F 2.891(et)-.11 G .14(his are often hard to \214nd, since \(in) +352.097 588.703 R .725(the abo)72 603.703 R 1.055 -.165(ve ex)-.165 H .725 +(ample\) the shell widget returned by).165 F F2(initialize)3.475 E F0 .725 +(can still be used, although its applica-)3.475 F(tion conte)72 618.703 Q +(xt and the display associated with the application conte)-.165 E(xt ha)-.165 E +.33 -.165(ve a)-.22 H(lready been destro).165 E(yed.)-.11 E +(The problem can be solv)97 637.303 Q(ed by re-writing the abo)-.165 E .33 +-.165(ve f)-.165 H(unction lik).165 E 2.75(et)-.11 G(his:)385.706 637.303 Q EP +%%Page: 10 10 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(0-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 10/Courier@0 SF(\(define initialize #f\))100.346 94.503 Q +(\(let \(\(con\) \(dpy\)\))100.346 115.503 Q(\(set! initialize)112.346 129.503 +Q(\(lambda \(\))124.346 143.503 Q(\(set! con \(create-context\)\))136.346 +157.503 Q(\(set! dpy \(initialize-display con #f 'Test #f\)\))136.346 171.503 Q +(\(create-shell 'Test #f \(find-class 'application-shell\) dpy\)\)\)\))136.346 +185.503 Q F0 .35(An alternati)97 211.103 R .68 -.165(ve s)-.275 H .35 +(olution is to place the application conte).165 F .349 +(xt and display into a global v)-.165 F(ariable,)-.275 E(so that the)72 226.103 +Q 2.75(yc)-.165 G(an be terminated e)130.19 226.103 Q +(xplicitly by the program when desired.)-.165 E EP +%%Page: 11 11 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(1-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL/F1 13/Times-Bold@0 SF(Index)272.108 123 Q(A)72 174 Q F0 +(add-callback,)72 204 Q/F2 12/Times-Bold@0 SF(5)2.75 E F0(add-callbacks,)72 219 +Q F2(5)2.75 E F0(application-initialize,)72 234 Q F2(6)2.75 E F0 +(augment-translations,)72 249 Q F2(8)2.75 E F1(C)72 279 Q F0 +(class-constraint-resources,)72 309 Q F2(2)2.75 E F0(class-e)72 324 Q(xists?,) +-.165 E F2(2)2.75 E F0(class-resources,)72 339 Q F2(2)2.75 E F0 +(class-sub-resources,)72 354 Q F2(2)2.75 E F0(class?,)72 369 Q F2(2)2.75 E F0 +(conte)72 384 Q(xt-add-action,)-.165 E F2(8)2.75 E F0(conte)72 399 Q +(xt-add-input,)-.165 E F2(7)2.75 E F0(conte)72 414 Q(xt-add-timeout,)-.165 E F2 +(7)2.75 E F0(conte)72 429 Q(xt-add-w)-.165 E(ork-proc,)-.11 E F2(7)2.75 E F0 +(conte)72 444 Q(xt-main-loop,)-.165 E F2(6)2.75 E F0(conte)72 459 Q +(xt-pending,)-.165 E F2(7)2.75 E F0(conte)72 474 Q(xt-process-e)-.165 E -.165 +(ve)-.275 G(nt,).165 E F2(7)2.75 E F0(conte)72 489 Q(xt?,)-.165 E F2(6)2.75 E +F0(create-conte)72 504 Q(xt,)-.165 E F2(6)2.75 E F0(create-managed-widget,)72 +519 Q F2(3)2.75 E F0(create-popup-shell,)72 534 Q F2(5)2.75 E F0(create-shell,) +72 549 Q F2(2)2.75 E F0(create-widget,)72 564 Q F2(3)2.75 E F1(D)72 594 Q F0 +(destro)72 624 Q(y-conte)-.11 E(xt,)-.165 E F2(6)2.75 E F0(destro)72 639 Q +(y-widget,)-.11 E F2(2)2.75 E F0(display)72 654 Q/F3 11/Symbol SF(-)A F0 +(>conte)A(xt,)-.165 E F2(6)2.75 E F1(F)72 684 Q F0(\214nd-class,)302.4 174 Q F2 +(2)2.75 E F1(G)302.4 204 Q F0 -.055(ga)302.4 234 S(rbage collector).055 E 2.75 +(,9)-.44 G(get-v)302.4 249 Q(alues,)-.275 E F2(4)2.75 E F1(I)302.4 279 Q F0 +(identi\214er?,)302.4 309 Q F2(7)2.75 E F0(initialize-display)302.4 324 Q(,) +-.715 E F2(6)2.75 E F0(install-accelerators,)302.4 339 Q F2(8)2.75 E F0 +(install-all-accelerators,)302.4 354 Q F2(8)2.75 E F1(L)302.4 384 Q F0 +(load-widgets,)302.4 414 Q F2(1)2.75 E F1(M)302.4 444 Q F0(manage-child,)302.4 +474 Q F2(4)2.75 E F0(manage-children,)302.4 489 Q F2(3)2.75 E F0(map-widget,) +302.4 504 Q F2(4)2.75 E F0(motif, 1)302.4 519 Q(multi-click-time,)302.4 534 Q +F2(8)2.75 E F1(N)302.4 564 Q F0(name)302.4 594 Q F3(-)A F0(>widget,)A F2(5)2.75 +E F1(O)302.4 624 Q F0 -.165(ove)302.4 654 S(rride-translations,).165 E F2(8) +2.75 E F1(P)302.4 684 Q F0(popdo)302.4 714 Q(wn,)-.275 E F2(6)2.75 E EP +%%Page: 12 12 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 11/Times-Roman@0 SF 2.75(-1)276.087 51 S 2.75(2-)288 51 S .44 LW 77.5 57 72 +57 DL 80.5 57 75 57 DL 86 57 80.5 57 DL 91.5 57 86 57 DL 97 57 91.5 57 DL 102.5 +57 97 57 DL 108 57 102.5 57 DL 113.5 57 108 57 DL 119 57 113.5 57 DL 124.5 57 +119 57 DL 130 57 124.5 57 DL 135.5 57 130 57 DL 141 57 135.5 57 DL 146.5 57 141 +57 DL 152 57 146.5 57 DL 157.5 57 152 57 DL 163 57 157.5 57 DL 168.5 57 163 57 +DL 174 57 168.5 57 DL 179.5 57 174 57 DL 185 57 179.5 57 DL 190.5 57 185 57 DL +196 57 190.5 57 DL 201.5 57 196 57 DL 207 57 201.5 57 DL 212.5 57 207 57 DL 218 +57 212.5 57 DL 223.5 57 218 57 DL 229 57 223.5 57 DL 234.5 57 229 57 DL 240 57 +234.5 57 DL 245.5 57 240 57 DL 251 57 245.5 57 DL 256.5 57 251 57 DL 262 57 +256.5 57 DL 267.5 57 262 57 DL 273 57 267.5 57 DL 278.5 57 273 57 DL 284 57 +278.5 57 DL 289.5 57 284 57 DL 295 57 289.5 57 DL 300.5 57 295 57 DL 306 57 +300.5 57 DL 311.5 57 306 57 DL 317 57 311.5 57 DL 322.5 57 317 57 DL 328 57 +322.5 57 DL 333.5 57 328 57 DL 339 57 333.5 57 DL 344.5 57 339 57 DL 350 57 +344.5 57 DL 355.5 57 350 57 DL 361 57 355.5 57 DL 366.5 57 361 57 DL 372 57 +366.5 57 DL 377.5 57 372 57 DL 383 57 377.5 57 DL 388.5 57 383 57 DL 394 57 +388.5 57 DL 399.5 57 394 57 DL 405 57 399.5 57 DL 410.5 57 405 57 DL 416 57 +410.5 57 DL 421.5 57 416 57 DL 427 57 421.5 57 DL 432.5 57 427 57 DL 438 57 +432.5 57 DL 443.5 57 438 57 DL 449 57 443.5 57 DL 454.5 57 449 57 DL 460 57 +454.5 57 DL 465.5 57 460 57 DL 471 57 465.5 57 DL 476.5 57 471 57 DL 482 57 +476.5 57 DL 487.5 57 482 57 DL 493 57 487.5 57 DL 498.5 57 493 57 DL 504 57 +498.5 57 DL(popup,)72 87 Q/F1 12/Times-Bold@0 SF(5)2.75 E/F2 13/Times-Bold@0 SF +(R)72 117 Q F0(realize-widget,)72 147 Q F1(3)2.75 E F0(remo)72 162 Q -.165(ve) +-.165 G(-input,).165 E F1(7)2.75 E F0(remo)72 177 Q -.165(ve)-.165 G(-timeout,) +.165 E F1(7)2.75 E F0(remo)72 192 Q -.165(ve)-.165 G(-w).165 E(ork-proc,)-.11 E +F1(7)2.75 E F2(S)72 222 Q F0(set-conte)72 252 Q(xt-f)-.165 E +(allback-resources!,)-.11 E F1(6)2.75 E F0(set-mapped-when-managed!,)72 267 Q +F1(4)2.75 E F0(set-multi-click-time!,)72 282 Q F1(8)2.75 E F0(set-sensiti)72 +297 Q -.165(ve)-.275 G(!,).165 E F1(5)2.75 E F0(set-v)72 312 Q(alues!,)-.275 E +F1(4)2.75 E F2(U)72 342 Q F0(uninstall-translations,)72 372 Q F1(8)2.75 E F0 +(unmanage-child,)72 387 Q F1(4)2.75 E F0(unmanage-children,)72 402 Q F1(4)2.75 +E F0(unmap-widget,)72 417 Q F1(4)2.75 E F0(unrealize-widget,)72 432 Q F1(3)2.75 +E F2(W)72 462 Q F0(widget-class,)72 492 Q F1(4)2.75 E F0(widget-composite?,)72 +507 Q F1(3)2.75 E F0(widget-conte)72 522 Q(xt,)-.165 E F1(5)2.75 E F0 +(widget-display)72 537 Q(,)-.715 E F1(3)2.75 E F0(widget-managed?,)72 552 Q F1 +(4)2.75 E F0(widget-name,)72 567 Q F1(3)2.75 E F0(widget-parent,)72 582 Q F1(3) +2.75 E F0(widget-realized?,)72 597 Q F1(3)2.75 E F0(widget-sensiti)72 612 Q +-.165(ve)-.275 G(?,).165 E F1(5)2.75 E F0(widget-subclass?,)72 627 Q F1(4)2.75 +E F0(widget-superclass,)72 642 Q F1(4)2.75 E F0(widget-translate-coordinates,) +72 657 Q F1(5)2.75 E F0(widget-windo)72 672 Q -.715(w,)-.275 G F1(3)3.465 E F0 +(widget?,)72 687 Q F1(2)2.75 E F0(widget)72 702 Q/F3 11/Symbol SF(-)A F0 +(>windo)A -.715(w,)-.275 G F1(3)3.465 E F0(windo)302.4 87 Q(w)-.275 E F3(-)A F0 +(>widget,)A F1(5)2.75 E F2(X)302.4 117 Q F0(xt, 1)302.4 147 Q(xt-release-4-or) +302.4 162 Q(-later?,)-.22 E F1(9)2.75 E F0(xt-release-5-or)302.4 177 Q +(-later?,)-.22 E F1(9)2.75 E F0(xt-release-6-or)302.4 192 Q(-later?,)-.22 E F1 +(9)2.75 E F0(xt-w)302.4 207 Q(arning-handler)-.11 E(,)-.44 E F1(8)2.75 E F0 +(xwidgets, 1)302.4 222 Q EP +%%Page: 13 13 +%%BeginPageSetup +BP +%%EndPageSetup +/F0 13/Times-Bold@0 SF -1.196(Ta)239.127 123 S(ble of Contents)1.196 E/F1 11 +/Times-Roman@0 SF .866(Introduction ..........................................\ +..............................................................................\ +......)72 177.6 R(1)498.5 177.6 Q -.44(Wi)72 196.2 S(dget Classes).44 E 19.25(\ +..............................................................................\ +........................................... 2)4.056 F -.44(Wi)72 214.8 S +(dget Functions).44 E 19.25(..................................................\ +................................................................... 2)4.661 F +(Callback Functions)72 233.4 Q 19.25(.........................................\ +.......................................................................... 5)3 +F(Popup Shells)72 252 Q 19.25(................................................\ +............................................................................. \ +5)2.989 F(Application Conte)72 270.6 Q .107(xts ..............................\ +..............................................................................\ +....)-.165 F(6)498.5 270.6 Q -.385(Tr)72 289.2 S +(anslations Management Functions).385 E 19.25(................................\ +....................................................... 8)4.925 F +(Error Handling)72 307.8 Q 19.25(.............................................\ +............................................................................ 8) +4.848 F(Miscellaneous Functions)72 326.4 Q 19.25(.............................\ +............................................................................. \ +9)3.308 F(Interaction with the Garbage Collector)72 345 Q 19.25(..............\ +...................................................................... 9)3.649 +F(Inde)72 363.6 Q 2.868(x.)-.165 G 13.75(.....................................\ +..............................................................................\ +..................... 11)102.5 363.6 R EP +%%Trailer +end +%%EOF diff --git a/examples/CC/class.c b/examples/CC/class.c new file mode 100644 index 0000000..d8c9347 --- /dev/null +++ b/examples/CC/class.c @@ -0,0 +1,89 @@ +/*----------------------------------------------------------------------------- + +This trivial Elk extension demonstrates encapsulation of a C++ class in +a first-class Scheme type, and encapsulation of member functions in +Scheme primitives. + +See constructor.c in this directory for compilation instructions. + +Here is a transcript showing a test run under Solaris 2.4 using the +GNU g++ compiler: + + % g++ -fpic -I/usr/elk/include -c class.c + % + % scheme + > (load 'class.o) + + > (define x (make-foo)) + x + > (read-val x) + 1234 + > (write-val! x 11) + + > (read-val x) + 11 + > (exit) + % + +-----------------------------------------------------------------------------*/ + +class foo { + int val; +public: + int read_val(void); + void write_val(int); + foo() { val = 1234; }; +}; + +int foo::read_val(void) { + return val; +} + +void foo::write_val(int newval) { + val = newval; +} + +/* ---------------------------------- */ + +#include "scheme.h" + +struct S_Foo { + Object tag; class foo foo; +}; + +int T_Foo; + +#define FOO(x) ((struct S_Foo *)POINTER(x)) + +Object P_Make_Foo(void) { + Object f = Alloc_Object(sizeof (struct S_Foo), T_Foo, 0); + FOO(f)->foo.write_val(1234); /* FOO(f)->foo.foo() is not allowed?! */ + return f; +} + +Object P_Read_Val(Object x) { + Check_Type(x, T_Foo); + return Make_Integer(FOO(x)->foo.read_val()); +} + +Object P_Write_Val(Object x, Object y) { + Check_Type(x, T_Foo); + FOO(x)->foo.write_val(Get_Integer(y)); + return Void; +} + +Foo_Print(Object h, Object port, int raw, int depth, int length) { + Printf(port, "#[foo %d]", FOO(h)->foo.read_val()); +} + +int Foo_Equal(Object x, Object y) { + return FOO(x)->foo.read_val() == FOO(y)->foo.read_val(); +} + +void elk_init_foo() { + T_Foo = Define_Type(0, "foo", NOFUNC, sizeof(struct S_Foo), + Foo_Equal, Foo_Equal, Foo_Print, NOFUNC); + Define_Primitive((Object(*)(...))P_Make_Foo, "make-foo", 0, 0, EVAL); + Define_Primitive((Object(*)(...))P_Read_Val, "read-val", 1, 1, EVAL); + Define_Primitive((Object(*)(...))P_Write_Val, "write-val!", 2, 2, EVAL); +} diff --git a/examples/CC/constructor.c b/examples/CC/constructor.c new file mode 100644 index 0000000..df2d4f2 --- /dev/null +++ b/examples/CC/constructor.c @@ -0,0 +1,74 @@ +/*---------------------------------------------------------------------- + +This simple C++ program demonstrates that static constructors (destructors) +are invoked by Elk when loading a compiled C++ file (when exiting). + +o Compile the program with CC -c -I/usr/elk/include constructor.c, where + /usr/elk is the toplevel directory of your Elk installation. Under + Solaris 2.x (and SysVR4) you also have to specify -pic (-fpic for g++). + +o Invoke Elk and set the load-libraries to point to the C++ and the + C library, e.g. type something like: + + (set! load-libraries "-L/usr/lang/SC2.0.1 -lC -lc") + or + (set! load-libraries "-R/usr/lang/lib -L/usr/lang/lib -lC -lc") + or just + (set! load-libraries "-lC -lc") + + depending on the platform and the place where the C++ library has + been installed on your system. If you are using g++, you may have + to mention both the g++ library and the gcc library. + +o Now "(load 'constructor.o)", observe the "invoking constructor" message, + and evaluate "(test)", which should return 3. Terminate the interpreter + and observe the "invoking destructor" message. + + +o If you get a message from the linker complaining about `Text relocation + remains against symbol _GLOBAL_.D.P_Test__Fv', you have probably run + into a known bug in g++ on ELF-based systems (such as Solaris 2.x). + + In this case you have to link your C++ extensions with Elk statically + or use a different C++ compiler. + + +o If static constructors don't get called when loading compiled C++ files, + your C++ compiler is probably using a naming convention for static + constructors and destructors that is not anticipated by the current + version of Elk. + + In this case, you may want to find out what kind of names are used + (by applying "nm" to an object file) and add the name prefixes to + the Init_Prefixes and Finit_Prefixes lists in src/stab.c in the Elk + source tree. Then recompile Elk. Send me mail. +----------------------------------------------------------------------*/ + + +#include "scheme.h" + +#include + +class C { +public: + int i; + C() { + cerr << "[invoking constructor]" << endl; + i = 3; + } + ~C() { cerr << "[invoking destructor]" << endl; } +}; + +C c; + +Object P_Test() { + return Make_Integer(c.i); +} + +void elk_init_constructor() { + Define_Primitive((Object (*)(...))P_Test, "test", 0, 0, EVAL); +} + +void elk_finit_constructor() { + cerr << "Goodbye." << endl; +} diff --git a/examples/regexp/match.scm b/examples/regexp/match.scm new file mode 100644 index 0000000..ec77c91 --- /dev/null +++ b/examples/regexp/match.scm @@ -0,0 +1,28 @@ +;;; -*-Scheme-*- +;;; +;;; Demonstrate the regular expression primitives. + +(require 'regexp) + +;; Returns a list of substrings of string `str' that match the +;; pattern `pat' + +(define (matches str pat) + (let loop ((r (make-regexp pat '(extended))) (result '()) (from 0)) + (let ((m (regexp-exec r str from))) + (if (regexp-match? m) + (loop r (cons (substring str (+ from (regexp-match-start m 0)) + (+ from (regexp-match-end m 0))) + result) + (+ from (regexp-match-end m 0))) + (reverse result))))) + +(require 'siteinfo) + +(cond + ((feature? ':regular-expressions) + (print (matches "Hello, world!" "[a-zA-z]+")) + (print (matches "Hello, world!" "."))) + (else + (format #t "Regular expressions not supported by ~a-~a~%" + site-machine site-os))) diff --git a/examples/scheme/Y.scm b/examples/scheme/Y.scm new file mode 100644 index 0000000..fbeedc0 --- /dev/null +++ b/examples/scheme/Y.scm @@ -0,0 +1,173 @@ +; Date: 15 Nov 88 23:03:24 GMT +; From: uoregon!markv@beaver.cs.washington.edu (Mark VandeWettering) +; Organization: University of Oregon, Computer Science, Eugene OR +; Subject: The Paradoxical Combinator -- Y (LONG) +; +; Alternatively entitled: +; "Y? Why Not?" :-) +; +; The discussion that has been going on in regards to the Y combinator as +; the basic operation in implementing recursive functions are interesting. +; The practical tests that people have made have shown that the Y +; combinator is orders of magnitude slower for implementing recursion than +; directly compiling it. +; +; This is true for Scheme. I hold that for an interesting set of +; languages, (lazy languages) that this result will not necessarily hold. +; +; The problem with Y isn't its complexity, it is the fact that it is an +; inherently lazy operation. Any implementation in Scheme is clouded by +; the fact that Scheme is an applicative order evaluator, while Y prefers +; to be evaluated in normal order. +; +; + (define Y + (lambda (g) + ((lambda (h) (g (lambda (x) ((h h) x)))) + (lambda (h) (g (lambda (x) ((h h) x))))))) +; + (define fact + (lambda (f) + (lambda (n) + (if (= n 1) + 1 + (* n (f (- n 1))))))) +; +; +; Evaluating (Y fact) 2 results in the following operations in +; Scheme: +; +; The argument is (trivially) evaluated, and returns two. +; (Y fact) must be evaluated. What is it? Y and fact each evaluate +; to closures. When applied, Y binds g to fact, and executes the +; body. +; +; The body is an application of a closure to another closure. The +; operator binds h to the operand, and executes its body which.... +; +; Evaluates (g (lambda (x) ((h h) x))). The operand is a closure, +; which gets built and then returns. g evaluates to fact. We +; substitute the closure (lambda (x) ((h h) x)) in for the function +; f in the definition of fact, giving... +; +; (lambda (n) +; (if (= n 1) +; 1 +; (* n ((lambda (x) ((h h) x)) (- n 1))))) +; +; Which we return as the value of (Y fact). When we apply this to 2, we get +; +; (* 2 ((lambda (x) ((h h) x)) 1)) +; +; We then have to evaluate +; ((lambda (x) ((h h) x)) 1) +; +; or +; ((h h) 1) +; +; But remembering that h was (lambda (h) (g (lambda (x) ((h h) x)))), +; we have +; +; (((lambda (h) (g (lambda (x) ((h h) x)))) +; (lambda (h) (g (lambda (x) ((h h) x))))) +; 1) .... +; +; So, we rebind h to be the right stuff, and evaluate the body, which is +; +; ((g (lambda (x) ((h h) x))) 1) +; +; Which by the definition of g (still == fact) is just 1. +; +; (* 2 1) = 2. +; +; ######################################################################## +; +; Summary: If you didn't follow this, performing this evaluation +; was cumbersome at best. As far as compiler or interpreter is +; concerned, the high cost of evaluating this function is related +; to two different aspects: +; +; It is necessary to create "suspended" values. These suspended +; values are represented as closures, which are in general heap +; allocated and expensive. +; +; For every level of recursion, new closures are created (h gets +; rebound above). While this could probably be optimized out by a +; smart compiler, it does seem like the representation of suspended +; evaluation by lambdas is inefficient. +; +; +; ######################################################################## +; +; You can try to figure out how all this works. It is complicated, I +; believe I understand it. The point in the derivation above is that in +; Scheme, to understand how the implementation of Y works, you have to +; fall back on the evaluation mechanism of Scheme. Suspended values must +; be represented as closures. It is the creation of these closures that +; cause the Scheme implementation to be slow. +; +; If one wishes to abandon Scheme (or at least applicative order +; evaluators of Scheme) one can typically do much better. My thesis work +; is in graph reduction, and trying to understand better the issues having +; to do with implementation. +; +; In graph reduction, all data items (evaluated and unevaluated) have the +; same representation: as graphs in the heap. We choose to evaluate using +; an outermost, leftmost strategy. This allows the natural definition of +; (Y h) = (h (Y h)) to be used. An application node of the form: +; +; @ +; / \ +; / \ +; Y h +; +; can be constructed in the obvious way: +; @ +; / \ +; / \ +; h @ +; / \ +; / \ +; Y h +; +; costing one heap allocation per level of recursion, which is +; certainly cheaper than the multiple allocations of scheme +; closures above. More efficiently, we might choose to implement +; it using a "knot tying" version: +; +; +; /\ +; / \ +; @ | +; / \ / +; / \/ +; h +; +; Which also works quite well. Y has been eliminated, and will +; cause no more reductions. +; +; The basic idea is somehow that recursion in functional languages +; is analogous to cycles in the graph in a graph reduction engine. +; Therefore, the Y combinator is a specific "textual" indicator of +; the graph. +; +; The G-machine (excellently described in Peyton Jones' book "The +; Implementation of Functional Programming Languages") also +; described the Y combinator as being efficient. He chose letrecs +; as being a primitive in the extended lambda calculus. His +; methodology behind compiling these recursive definitions was +; basically to compile fixed code which directly built these cyclic +; structures, rather than having them built at runtime. +; +; I think (and my thesis work is evolving into this kind of +; argument) that Y is overlooked for trivial reasons. Partial +; evaluation and smarter code generation could make an SK based +; compiler generate code which is equal in quality to that produced +; by supercombinator based compilation. +; +; +; This is too long already, ciao for now. +; +; Mark VandeWettering + +(print ((Y fact) 10)) diff --git a/examples/scheme/acker.scm b/examples/scheme/acker.scm new file mode 100644 index 0000000..f6b823c --- /dev/null +++ b/examples/scheme/acker.scm @@ -0,0 +1,14 @@ +;;; -*-Scheme-*- +;;; +;;; The Ackermann function + +(define (acker x y) + (cond + ((zero? x) + (+ y 1)) + ((zero? y) + (acker (- x 1) 1)) + (else + (acker (- x 1) (acker x (- y 1)))))) + +(print (acker 3 2)) diff --git a/examples/scheme/billiard.scm b/examples/scheme/billiard.scm new file mode 100644 index 0000000..1c20be5 --- /dev/null +++ b/examples/scheme/billiard.scm @@ -0,0 +1,1338 @@ +;;; BILLIARD.SCM: This file contains code for a very simple billiard ball +;;; simulator. The simulation takes place in two dimensions. +;;; The balls are really disks in that their height is not taken +;;; into account. All interactions are assumed to be +;;; frictionless so spin in irrelevant and not accounted for. +;;; (See section on limitations.) +;;; +;;; NOTES: A simulation is initiated by creating a number of balls and bumpers +;;; and and specifying a duration for the simulation. For each ball, +;;; its mass, radius, initial position, and initial velocity must be +;;; specified. For each bumper, the location of its two ends must be +;;; specified. (Bumpers are assumed to have zero width.) +;;; +;;; A sample run might be started as follows: +;;; (simulate +;;; (list (make-ball 2 1 9 5 -1 -1) +;;; (make-ball 4 2 2 5 1 -1)) +;;; (list (make-bumper 0 0 0 10) +;;; (make-bumper 0 0 10 0) +;;; (make-bumper 0 10 10 10) +;;; (make-bumper 10 0 10 10)) +;;; 30) +;;; +;;; It would create one billiard ball of mass 2 and radius 1 at position +;;; (9, 5) with initial velocity (-1, -1) and a second ball of mass 4 +;;; and radius 2 at position (2, 5) with initial velocity (1, -1). The +;;; table would be a 10X10 square. (See diagram below) +;;; +;;; +---------------------------+ +;;; | | +;;; | | +;;; | XXXX | +;;; | XXXXXXXX XX | +;;; |XXXXXX4XXXXX XXX2XX| +;;; | XXXXXXXX /XX | +;;; | XXXX \ | +;;; | | +;;; | | +;;; +---------------------------+ +;;; +;;; LIMITATIONS: This simulator does not handle 3 body problems correctly. If +;;; 3 objects interact at one time, only the interactions of 2 of +;;; the bodies will be accounted for. This can lead to strange +;;; effects like balls tunneling through walls and other balls. +;;; It is also possible to get balls bouncing inside of each +;;; other in this way. +;;; + + +;;MAKE-QUEUE-RECORD returns a queue record with the given next, previous, and +;;value values +;;NEXT = The next record pointer +;;PREV = The previous record pointer +;;REST = A list of values for any optional fields (this can be used for +;; creating structure inheritance) +(define-macro (make-queue-record next prev . rest) + `(vector ,next ,prev ,@rest)) + +;;QUEUE-RECORD-NEXT returns the next field of the given queue record +;;QUEUE-RECORD = The queue record whose next field is to be returned +(define-macro (queue-record-next queue-record) + `(vector-ref ,queue-record 0)) + +;;SET-QUEUE-RECORD-NEXT! sets the next field of the given queue record +;;QUEUE-RECORD = The queue record whose next field is to be set +;;VALUE = The value to which the next field is to be set +(define-macro (set-queue-record-next! queue-record value) + `(vector-set! ,queue-record 0 ,value)) + +;;QUEUE-RECORD-PREV returns the prev field of the given queue record +;;QUEUE-RECORD = The queue record whose prev field is to be returned +(define-macro (queue-record-prev queue-record) + `(vector-ref ,queue-record 1)) + +;;SET-QUEUE-RECORD-PREV! sets the prev field of the given queue record +;;QUEUE-RECORD = The queue record whose prev field is to be set +;;VALUE = The value to which the prev field is to be set +(define-macro (set-queue-record-prev! queue-record value) + `(vector-set! ,queue-record 1 ,value)) + +;;QUEUE-RECORD-LEN returns the length of a queue record which has no optional +;;fields +(define-macro (queue-record-len) 2) + +;;QUEUE-HEAD returns a dummy record at the end of the queue with the record +;;with the smallest key. +;;QUEUE = the queue whose head record is to be returned +(define-macro (queue-head queue) + `(vector-ref ,queue 0)) + +;;QUEUE-TAIL returns a dummy record at the end of the queue with the record +;;with the largest key. +;;QUEUE = the queue whose tail record is to be returned +(define-macro (queue-tail queue) + `(vector-ref ,queue 1)) + +;;QUEUE- dot-product + bumper-length-squared)) + '() ;Return infinity + (+ delta-t ;Else, return the contact time + (ball-collision-time + ball)))))))))))) + + +;;BALL-COLLISION-PROCEDURE calculates the new velocities of the given balls +;;based on their collision at the given time. Also, tells all other balls +;;about the new trajectories of these balls so they can update their event +;;queues +;;BALL1 = The first ball +;;BALL2 = The second ball +;;COLLISION-TIME = The collision time +;;GLOBAL-EVENT-QUEUE = The global queue of earliest events for each ball +(define (ball-collision-procedure ball1 ball2 collision-time + global-event-queue) + (queue-remove ;Remove the earliest event associated + (ball-global-event-queue-record ;with each ball from the global event + ball1)) ;queue + (queue-remove + (ball-global-event-queue-record + ball2)) + (let ((ball1-collision-x-position ;Calculate the positions of both balls + (+ (ball-collision-x-position ;when they collide + ball1) + (* (ball-x-velocity + ball1) + (- collision-time + (ball-collision-time + ball1))))) + (ball1-collision-y-position + (+ (ball-collision-y-position + ball1) + (* (ball-y-velocity + ball1) + (- collision-time + (ball-collision-time + ball1))))) + (ball2-collision-x-position + (+ (ball-collision-x-position + ball2) + (* (ball-x-velocity + ball2) + (- collision-time + (ball-collision-time + ball2))))) + (ball2-collision-y-position + (+ (ball-collision-y-position + ball2) + (* (ball-y-velocity + ball2) + (- collision-time + (ball-collision-time + ball2)))))) + (let ((delta-x ;Calculate the displacements of the + (- ball2-collision-x-position ;centers of the two balls + ball1-collision-x-position)) + (delta-y + (- ball2-collision-y-position + ball1-collision-y-position))) + + + (let* ((denominator ;Calculate the angle of the line + (sqrt (+ (square ;joining the centers at the collision + delta-x) ;time with the x-axis (this line is + (square ;the normal to the balls at the + delta-y)))) ;collision point) + (cos-theta + (/ delta-x denominator)) + (sin-theta + (/ delta-y denominator))) + (let ((ball1-old-normal-velocity ;Convert the velocities of the balls + (+ (* (ball-x-velocity ;into the coordinate system defined by + ball1) ;the normal and tangential lines at + cos-theta) ;the collision point + (* (ball-y-velocity + ball1) + sin-theta))) + (ball1-tang-velocity + (- (* (ball-y-velocity + ball1) + cos-theta) + (* (ball-x-velocity + ball1) + sin-theta))) + (ball2-old-normal-velocity + (+ (* (ball-x-velocity + ball2) + cos-theta) + (* (ball-y-velocity + ball2) + sin-theta))) + (ball2-tang-velocity + (- (* (ball-y-velocity + ball2) + cos-theta) + (* (ball-x-velocity + ball2) + sin-theta))) + (mass1 (ball-mass + ball1)) + (mass2 (ball-mass + ball2))) + (let ((ball1-new-normal-velocity ;Calculate the new velocities + (/ ;following the collision (the + (+ ;tangential velocities are unchanged + (* ;because the balls are assumed to be + (* 2 ;frictionless) + mass2) + ball2-old-normal-velocity) + (* + (- mass1 mass2) + ball1-old-normal-velocity)) + (+ mass1 mass2))) + + + (ball2-new-normal-velocity + (/ + (+ + (* + (* 2 + mass1) + ball1-old-normal-velocity) + (* + (- mass2 mass1) + ball2-old-normal-velocity)) + (+ mass1 mass2)))) + (set-ball-x-velocity! ;Store data about the collision in the + ball1 ;structure for each ball after + (- (* ball1-new-normal-velocity ;converting the information back + cos-theta) ;to the x,y frame + (* ball1-tang-velocity + sin-theta))) + (set-ball-y-velocity! + ball1 + (+ (* ball1-new-normal-velocity + sin-theta) + (* ball1-tang-velocity + cos-theta))) + (set-ball-x-velocity! + ball2 + (- (* ball2-new-normal-velocity + cos-theta) + (* ball2-tang-velocity + sin-theta))) + (set-ball-y-velocity! + ball2 + (+ (* ball2-new-normal-velocity + sin-theta) + (* ball2-tang-velocity + cos-theta))) + (set-ball-collision-time! + ball1 + collision-time) + (set-ball-collision-time! + ball2 + collision-time) + (set-ball-collision-x-position! + ball1 + ball1-collision-x-position) + (set-ball-collision-y-position! + ball1 + ball1-collision-y-position) + (set-ball-collision-x-position! + ball2 + ball2-collision-x-position) + (set-ball-collision-y-position! + ball2 + ball2-collision-y-position)))))) + + + (newline) + (display "Ball ") + (display (ball-number ball1)) + (display " collides with ball ") + (display (ball-number ball2)) + (display " at time ") + (display (ball-collision-time ball1)) + (newline) + (display " Ball ") + (display (ball-number ball1)) + (display " has a new velocity of ") + (display (ball-x-velocity ball1)) + (display ",") + (display (ball-y-velocity ball1)) + (display " starting at ") + (display (ball-collision-x-position ball1)) + (display ",") + (display (ball-collision-y-position ball1)) + (newline) + (display " Ball ") + (display (ball-number ball2)) + (display " has a new velocity of ") + (display (ball-x-velocity ball2)) + (display ",") + (display (ball-y-velocity ball2)) + (display " starting at ") + (display (ball-collision-x-position ball2)) + (display ",") + (display (ball-collision-y-position ball2)) + + (recalculate-collisions ball1 global-event-queue) + (recalculate-collisions ball2 global-event-queue)) + + +;;BUMPER-COLLISION-PROCEDURE calculates the new velocity of the given ball +;;following its collision with the given bumper at the given time. Also, tells +;;other balls about the new trajectory of the given ball so they can update +;;their event queues. +;;BALL = The ball +;;BUMPER = The bumper +;;COLLISION-TIME = The collision time +;;GLOBAL-EVENT-QUEUE = The global queue of earliest events for each ball +(define (bumper-collision-procedure ball bumper collision-time + global-event-queue) + (queue-remove ;Remove the earliest event associated + (ball-global-event-queue-record ;with the ball from the global event + ball)) ;queue + (let ((delta-x-bumper ;Compute the bumper's delta-x + (- (bumper-x2 bumper) + (bumper-x1 bumper))) + (delta-y-bumper ;delta-y + (- (bumper-y2 bumper) + (bumper-y1 bumper)))) + (let ((bumper-length ;length + (sqrt + (+ (square + delta-x-bumper) + (square + delta-y-bumper))))) + (let ((cos-theta ;and cosine and sine of its angle with + (/ delta-x-bumper ;respect to the positive x-axis + bumper-length)) + (sin-theta + (/ delta-y-bumper + bumper-length)) + (x-velocity ;Cache the ball's velocity in the x,y + (ball-x-velocity ball)) ;frame + (y-velocity + (ball-y-velocity ball))) + (let ((tang-velocity ;Calculate the ball's velocity in the + (+ (* x-velocity ;bumper frame + cos-theta) + (* y-velocity + sin-theta))) + (normal-velocity + (- (* y-velocity + cos-theta) + (* x-velocity + sin-theta)))) + + + (set-ball-collision-x-position! ;Store the collision position + ball + (+ (ball-collision-x-position + ball) + (* (- collision-time + (ball-collision-time + ball)) + (ball-x-velocity + ball)))) + (set-ball-collision-y-position! + ball + (+ (ball-collision-y-position + ball) + (* (- collision-time + (ball-collision-time + ball)) + (ball-y-velocity + ball)))) + (set-ball-x-velocity! ;Calculate the new velocity in the + ball ;x,y frame based on the fact that + (+ (* tang-velocity ;tangential velocity is unchanged and + cos-theta) ;the normal velocity is inverted when + (* normal-velocity ;the ball collides with the bumper + sin-theta))) + (set-ball-y-velocity! + ball + (- (* tang-velocity + sin-theta) + (* normal-velocity + cos-theta))) + (set-ball-collision-time! + ball + collision-time))))) + (newline) + (display "Ball ") + (display (ball-number ball)) + (display " collides with bumper ") + (display (bumper-number bumper)) + (display " at time ") + (display (ball-collision-time ball)) + (newline) + (display " Ball ") + (display (ball-number ball)) + (display " has a new velocity of ") + (display (ball-x-velocity ball)) + (display ",") + (display (ball-y-velocity ball)) + (display " starting at ") + (display (ball-collision-x-position ball)) + (display ",") + (display (ball-collision-y-position ball)) + + (recalculate-collisions ball global-event-queue)) + + +;;RECALCULATE-COLLISIONS removes all old collisions for the given ball from +;;all other balls' event queues and calcultes new collisions for these balls +;;and places them on the event queues. Also, updates the global event queue if +;;the recalculation of the collision effects the earliest collision for any +;;other balls. +;;BALL = The ball whose collisions are being recalculated +;;GLOBAL-EVENT-QUEUE = The global queue of earliest events for each ball +(define (recalculate-collisions ball global-event-queue) + (clear-queue (ball-event-queue ;Clear the queue of events for this + ball)) ;ball as they have all changed + (let ((event-queue ;Calculate all ball collision events + (ball-event-queue ball))) ;with balls of lower number + (let ((ball-vector + (ball-ball-vector ball))) + (do ((i (-1+ (ball-number ball)) + (-1+ i))) + ((negative? i)) + (let ((ball2-queue-record + (vector-ref + ball-vector + i))) + (set-event-queue-record-collision-time! + ball2-queue-record + (ball-ball-collision-time + ball + (event-queue-record-object + ball2-queue-record))) + (queue-insert + event-queue + ball2-queue-record)))) + (let ((bumper-vector ;Calculate all bumper collision events + (ball-bumper-vector ball))) + (do ((i (-1+ (vector-length + bumper-vector)) + (-1+ i))) + ((negative? i)) + (let ((bumper-queue-record + (vector-ref + bumper-vector + i))) + (set-event-queue-record-collision-time! + bumper-queue-record + (ball-bumper-collision-time + ball + (event-queue-record-object + bumper-queue-record))) + (queue-insert + event-queue + bumper-queue-record)))) + + + (let ((global-queue-record ;Get the global event queue record + (ball-global-event-queue-record ;for this ball + ball))) + (set-event-queue-record-collision-time! ;Set the new earliest event time + global-queue-record ;for this ball + (if (empty-queue? event-queue) + '() + (event-queue-record-collision-time + (queue-smallest event-queue)))) + (queue-insert ;Enqueue on the global event queue + global-event-queue ;the earliest event between this ball + global-queue-record))) ;and any ball of lower number or any + ;bumper + (for-each ;For each ball on the ball list: + (lambda (ball2) + (let ((ball2-event-queue + (ball-event-queue ball2))) + (let ((alter-global-event-queue? ;Set flag to update global event queue + (and ;if the earliest event for ball2 was + (not (empty-queue? ;with the deflected ball + ball2-event-queue)) + (eq? ball + (event-queue-record-object + (queue-smallest + ball2-event-queue))))) + (ball-event-queue-record ;Get the queue record for the deflected + (vector-ref ;ball for this ball + (ball-ball-vector + ball2) + (ball-number ball)))) + (queue-remove ;Remove the queue record for the + ball-event-queue-record) ;deflected ball + (set-event-queue-record-collision-time! ;Recalculate the collision + ball-event-queue-record ;time for this ball and the deflected + (ball-ball-collision-time ;ball + ball + ball2)) + (queue-insert ;Enqueue the new collision event + ball2-event-queue + ball-event-queue-record) + (if (or alter-global-event-queue? ;If the earliest collision event for + (eq? ball ;this ball has changed: + (event-queue-record-object + (queue-smallest + ball2-event-queue)))) + (let ((queue-record ;Remove the old event from the global + (ball-global-event-queue-record ;event queue and replace it + ball2))) ;with the new event + (set-event-queue-record-collision-time! + queue-record + (event-queue-record-collision-time + (queue-smallest + ball2-event-queue))) + (queue-remove + queue-record) + (queue-insert + global-event-queue + queue-record)))))) + (ball-ball-list ball))) + + +;;SIMULATE performs the billiard ball simulation for the given ball list and +;;bumper list until the specified time. +;;BALL-LIST = A list of balls +;;BUMPER-LIST = A list of bumpers +;;END-TIME = The time at which the simulation is to terminate +(define (simulate ball-list bumper-list end-time) + (let ((num-of-balls ;Cache the number of balls and bumpers + (length ball-list)) + (num-of-bumpers + (length bumper-list)) + (global-event-queue ;Build the global event queue + (make-sorted-queue + collision-time- n 0) + (begin + (set! n (- n 1)) + (display "resume b") (newline) + (bcc 1)) + #v) + acc)) + +(define (b) + (if (not (= 0 (call-with-current-continuation + (lambda (cc) + (set! bcc cc) 0)))) + (begin + (display "resume a") (newline) + (acc 1))) + bcc) + +(a) +(b) +(acc 1) diff --git a/examples/scheme/cell.scm b/examples/scheme/cell.scm new file mode 100644 index 0000000..bbe16a4 --- /dev/null +++ b/examples/scheme/cell.scm @@ -0,0 +1,23 @@ +;;; -*-Scheme-*- + +(define (make-cell) + (call-with-current-continuation + (lambda (return-from-make-cell) + (letrec ((state + (call-with-current-continuation + (lambda (return-new-state) + (return-from-make-cell + (lambda (op) + (case op + ((set) + (lambda (value) + (call-with-current-continuation + (lambda (return-from-access) + (return-new-state + (list value return-from-access)))))) + ((get) (car state))))))))) + ((cadr state) 'done))))) + +(define c (make-cell)) +(print ((c 'set) 99)) +(print (c 'get)) diff --git a/examples/scheme/co.scm b/examples/scheme/co.scm new file mode 100644 index 0000000..ff646eb --- /dev/null +++ b/examples/scheme/co.scm @@ -0,0 +1,96 @@ +;;; -*-Scheme-*- + +(require 'cscheme) + +(define (displayLine . someArgs) + (for-each + (lambda (aTerm) (display aTerm) (display " ")) + someArgs) + (newline)) + +(define (Monitor) + + (define stopAtMonitorLevel #f) + (define clock 0) + (define stopTime 0) + (define processIndicators '()) + + (define (setInitialProcessState! aContinuation) + (set! processIndicators + (cons (list 0 aContinuation) processIndicators)) + (stopAtMonitorLevel #f)) + + (define (startSimulation! aDuration) + (set! stopTime aDuration) + (if (not (null? processIndicators)) + (let ((firstIndicatorOnList (car processIndicators))) + (set! processIndicators + (remove firstIndicatorOnList processIndicators)) + (resumeSimulation! firstIndicatorOnList)) + (displayLine "*** no active process recorded!"))) + + (define (resumeSimulation! aProcessState) + (set! processIndicators + (cons aProcessState processIndicators)) + (let ((nextProcessState aProcessState)) + (for-each (lambda (aStatePair) + (if (< (car aStatePair) (car nextProcessState)) + (set! nextProcessState aStatePair))) + processIndicators) + (let ((time (car nextProcessState)) + (continuation (cadr nextProcessState))) + (set! processIndicators + (remove nextProcessState processIndicators)) + (if (<= time stopTime) + (begin (set! clock time) + (continuation #f)) + (begin (displayLine "*** simulation stops at:" clock) + (stopAtMonitorLevel #f)))))) + + (define (dispatch aMessage . someArguments) + (cond ((eq? aMessage 'initialize) + (setInitialProcessState! (car someArguments))) + ((eq? aMessage 'startSimulation) + (startSimulation! (car someArguments))) + ((eq? aMessage 'proceed) + (resumeSimulation! (car someArguments))) + ((eq? aMessage 'time) + clock) + ((eq? aMessage 'processIndicators) + processIndicators) + (else + "Sorry, I don't know how to do this!"))) + + (call-with-current-continuation + (lambda (anArg) + (set! stopAtMonitorLevel anArg))) + dispatch) + + + + +(define (Tourist aName aMonitor) + (call-with-current-continuation + (lambda (anArg) + (aMonitor 'initialize anArg))) + (displayLine aName "starts at" (aMonitor 'time)) + (while #t + (displayLine aName "walks on at" (aMonitor 'time)) + (call-with-current-continuation + (lambda (anArg) + (aMonitor 'proceed + (list (+ (aMonitor 'time) 1) anArg)))) + (displayLine aName "arrives at new attraction at" (aMonitor 'time)) + (call-with-current-continuation + (lambda (anArg) + (aMonitor 'proceed + (list (+ (aMonitor 'time) 2) + anArg)))))) + + +(define Gallery (Monitor)) + +(Tourist 'Jane Gallery) +(Tourist 'Bruce Gallery) + +(Gallery 'startSimulation 5) diff --git a/examples/scheme/compile.scm b/examples/scheme/compile.scm new file mode 100644 index 0000000..1b82110 --- /dev/null +++ b/examples/scheme/compile.scm @@ -0,0 +1,494 @@ +(require 'cscheme) + +; +; Optimizing scheme compiler +; supports quote, set!, if, lambda special forms, +; constant refs, variable refs and proc applications +; +; Using Clusures for Code Generation +; Marc Feeley and Guy LaPalme +; Computer Language, Vol. 12, No. 1, pp. 47-66 +; 1987 +; + +(define (compile expr) + ((gen expr nil '()))) + +(define (gen expr env term) + (cond + ((symbol? expr) + (ref (variable expr env) term)) + ((not (pair? expr)) + (cst expr term)) + ((eq? (car expr) 'quote) + (cst (cadr expr) term)) + ((eq? (car expr) 'set!) + (set (variable (cadr expr) env) (gen (caddr expr) env '()) term)) + ((eq? (car expr) 'if) + (gen-tst (gen (cadr expr) env '()) + (gen (caddr expr) env term) + (gen (cadddr expr) env term))) + ((eq? (car expr) 'lambda) + (let ((p (cadr expr))) + (prc p (gen (caddr expr) (allocate p env) #t) term))) + (else + (let ((args (map (lambda (x) (gen x env '())) (cdr expr)))) + (let ((var (and (symbol? (car expr)) (variable (car expr) env)))) + (if (global? var) + (app (cons var args) #t term) + (app (cons (gen (car expr) env '()) args) '() term))))))) + + +(define (allocate parms env) + (cond ((null? parms) env) + ((symbol? parms) (cons parms env)) + (else + (cons (car parms) (allocate (cdr parms) env))))) + +(define (variable symb env) + (let ((x (memq symb env))) + (if x + (- (length env) (length x)) + (begin + (if (not (assq symb -glo-env-)) (define-global symb '-undefined-)) + (assq symb -glo-env-))))) + +(define (global? var) + (pair? var)) + +(define (cst val term) + (cond ((eqv? val 1) + ((if term gen-1* gen-1))) + ((eqv? val 2) + ((if term gen-2* gen-2))) + ((eqv? val nil) + ((if term gen-null* gen-null))) + (else + ((if term gen-cst* gen-cst) val)))) + +(define (ref var term) + (cond ((global? var) + ((if term gen-ref-glo* gen-ref-glo) var)) + ((= var 0) + ((if term gen-ref-loc-1* gen-ref-loc-1))) + ((= var 1) + ((if term gen-ref-loc-2* gen-ref-loc-2))) + ((= var 2) + ((if term gen-ref-loc-3* gen-ref-loc-3))) + (else + ((if term gen-ref* gen-ref) var)))) + +(define (set var val term) + (cond ((global? var) + ((if term gen-set-glo* gen-set-glo) var val)) + ((= var 0) + ((if term gen-set-loc-1* gen-set-loc-1) val)) + ((= var 1) + ((if term gen-set-loc-2* gen-set-loc-2) val)) + ((= var 2) + ((if term gen-set-loc-3* gen-set-loc-3) val)) + (else + ((if term gen-set* gen-set) var val)))) + +(define (prc parms body term) + ((cond ((null? parms) + (if term gen-pr0* gen-pr0)) + ((symbol? parms) + (if term gen-pr1/rest* gen-pr1/rest)) + ((null? (cdr parms)) + (if term gen-pr1* gen-pr1)) + ((symbol? (cdr parms)) + (if term gen-pr2/rest* gen-pr2/rest)) + ((null? (cddr parms)) + (if term gen-pr2* gen-pr2)) + ((symbol? (cddr parms)) + (if term gen-pr3/rest* gen-pr3/rest)) + ((null? (cdddr parms)) + (if term gen-pr3 gen-pr3)) + (else + (error "too many parameters in a lambda-expression"))) + body)) + +(define (app vals glo term) + (apply (case (length vals) + ((1) (if glo + (if term gen-ap0-glo* gen-ap0-glo) + (if term gen-ap0* gen-ap0))) + ((2) (if glo + (if term gen-ap1-glo* gen-ap1-glo) + (if term gen-ap1* gen-ap1))) + ((3) (if glo + (if term gen-ap2-glo* gen-ap2-glo) + (if term gen-ap2* gen-ap2))) + ((4) (if glo + (if term gen-ap3-glo* gen-ap3-glo) + (if term gen-ap3* gen-ap3))) + (else (error "too many arguments in a proc application"))) + vals)) +; +; code generation for non-terminal evaluations +; + +; +; constants +; + +(define (gen-1) (lambda () 1)) +(define (gen-2) (lambda () 2)) +(define (gen-null) (lambda () '())) +(define (gen-cst a) (lambda () a)) + +; +; variable reference +; + +(define (gen-ref-glo a) (lambda () (cdr a))) ; global var +(define (gen-ref-loc-1) (lambda () (cadr *env*))) ; first local var +(define (gen-ref-loc-2) (lambda () (caddr *env*))) ; second local var +(define (gen-ref-loc-3) (lambda () (cadddr *env*))) ; third local var +(define (gen-ref a) (lambda () (do ((i 0 (1+ i)) ; any non-global + (env (cdr *env*) (cdr env))) + ((= i a) (car env))))) + +; +; assignment +; + +(define (gen-set-glo a b) (lambda () (set-cdr! a (b)))) +(define (gen-set-loc-1 a) (lambda () (set-car! (cdr *env*) (a)))) +(define (gen-set-loc-2 a) (lambda () (set-car! (cddr *env*) (a)))) +(define (gen-set-loc-3 a) (lambda () (set-car! (cdddr *env*) (a)))) +(define (gen-set a b) (lambda () (do ((i 0 (1+ i)) + (env (cdr *env*) (cdr env))) + ((= i a) (set-car! env (b)))))) + +; +; conditional +; + +(define (gen-tst a b c) (lambda () (if (a) (b) (c)))) + +; +; procedure application +; + +(define (gen-ap0-glo a) (lambda () ((cdr a)))) +(define (gen-ap1-glo a b) (lambda () ((cdr a) (b)))) +(define (gen-ap2-glo a b c) (lambda () ((cdr a) (b) (c)))) +(define (gen-ap3-glo a b c d) (lambda () ((cdr a) (b) (c) (d)))) + +(define (gen-ap0 a) (lambda () ((a)))) +(define (gen-ap1 a b) (lambda () ((a) (b)))) +(define (gen-ap2 a b c) (lambda () ((a) (b) (c)))) +(define (gen-ap3 a b c d) (lambda () ((a) (b) (c) (d)))) + +; +; lambda expressions +; + +(define (gen-pr0 a) ; without "rest" parameter + (lambda () + (let ((def (cdr *env*))) + (lambda () + (set! *env* (cons *env* def)) + (a))))) + +(define (gen-pr1 a) + (lambda () + (let ((def (cdr *env*))) + (lambda (x) + (set! *env* (cons *env* (cons x def))) + (a))))) + +(define (gen-pr2 a) + (lambda () + (let ((def (cdr *env*))) + (lambda (x y) + (set! *env* (cons *env* (cons x (cons y def)))) + (a))))) + +(define (gen-pr3 a) + (lambda () + (let ((def (cdr *env*))) + (lambda (x y z) + (set! *env* (cons *env* (cons x (cons y (cons z def))))) + (a))))) + +(define (gen-pr1/rest a) + (lambda () + (let ((def (cdr *env*))) + (lambda x + (set! *env* (cons *env* (cons x def))) + (a))))) + +(define (gen-pr2/rest a) + (lambda () + (let ((def (cdr *env*))) + (lambda (x . y) + (set! *env* (cons *env* (cons x (cons y def)))) + (a))))) + +(define (gen-pr3/rest a) + (lambda () + (let ((def (cdr *env*))) + (lambda (x y . z) + (set! *env* (cons *env* (cons x (cons y (cons z def))))) + (a))))) + +; +; code generation for terminal evaluations +; + +; +; constants +; + +(define (gen-1*) + (lambda () + (set! *env* (car *env*)) + 1)) + +(define (gen-2*) + (lambda () + (set! *env* (car *env*)) + 2)) + +(define (gen-null*) + (lambda () + (set! *env* (car *env*)) + ())) + +(define (gen-cst* a) + (lambda () + (set! *env* (car *env*)) + a)) + +; +; variable reference +; + +(define (gen-ref-glo* a) + (lambda () + (set! *env* (car *env*)) + (cdr a))) + +(define (gen-ref-loc-1*) + (lambda () + (let ((val (cadr *env*))) + (set! *env* (car *env*)) + val))) + +(define (gen-ref-loc-2*) + (lambda () + (let ((val (caddr *env*))) + (set! *env* (car *env*)) + val))) + +(define (gen-ref-loc-3*) + (lambda () + (let ((val (cadddr *env*))) + (set! *env* (car *env*)) + val))) + +(define (gen-ref* a) + (lambda () + (do ((i 0 (1+ i)) + (env (cdr *env*) (cdr env))) + ((= i a) + (set! *env* (car *env*)) + (car env))))) + +; +; assignment +; + +(define (gen-set-glo* a b) + (lambda () + (set! *env* (car *env*)) + (set-cdr! a (b)))) + +(define (gen-set-loc-1* a) + (lambda () + (set! *env* (car *env*)) + (set-car! (cdr *env*) (a)))) + +(define (gen-set-loc-2* a) + (lambda () + (set! *env* (car *env*)) + (set-car! (cddr *env*) (a)))) + +(define (gen-set-loc-3* a) + (lambda () + (set! *env* (car *env*)) + (set-car! (cdddr *env*) (a)))) + +(define (gen-set* a b) + (lambda () + (do ((i 0 (1+ i)) + (env (cdr *env*) (cdr env))) + ((= i 0) + (set! *env* (car *env*)) + (set-car! env (b)))))) + +; +; procedure application +; + +(define (gen-ap0-glo* a) + (lambda () + (set! *env* (car *env*)) + ((cdr a)))) + +(define (gen-ap1-glo* a b) + (lambda () + (let ((x (b))) + (set! *env* (car *env*)) + ((cdr a) x)))) + +(define (gen-ap2-glo* a b c) + (lambda () + (let ((x (b)) (y (c))) + (set! *env* (car *env*)) + ((cdr a) x y)))) + +(define (gen-ap3-glo* a b c d) + (lambda () + (let ((x (b)) (y (c)) (z (d))) + (set! *env* (car *env*)) + ((cdr a) x y z)))) + +(define (gen-ap0* a) + (lambda () + (let ((w (a))) + (set! *env* (car *env*)) + (w)))) + +(define (gen-ap1* a b) + (lambda () + (let ((w (a)) (x (b))) + (set! *env* (car *env*)) + (w x)))) + +(define (gen-ap2* a b c) + (lambda () + (let ((w (a)) (x (b)) (y (c))) + (set! *env* (car *env*)) + (w x y)))) + +(define (gen-ap3* a b c d) + (lambda () + (let ((w (a)) (x (b)) (y (c)) (z (d))) + (set! *env* (car *env*)) + (w x y z)))) + +; +; lambda +; + +(define (gen-pr0* a) + (lambda () + (let ((def (cdr *env*))) + (set! *env* (car *env*)) + (lambda () + (set! *env* (cons *env* def)) + (a))))) + + +(define (gen-pr1* a) + (lambda () + (let ((def (cdr *env*))) + (set! *env* (car *env*)) + (lambda (x) + (set! *env* (cons *env* (cons x def))) + (a))))) + +(define (gen-pr2* a) + (lambda () + (let ((def (cdr *env*))) + (set! *env* (car *env*)) + (lambda (x y) + (set! *env* (cons *env* (cons x (cons y def)))) + (a))))) + +(define (gen-pr3* a) + (lambda () + (let ((def (cdr *env*))) + (set! *env* (car *env*)) + (lambda (x y z) + (set! *env* (cons *env* (cons x (cons y (cons z def))))) + (a))))) + +(define (gen-pr1/rest* a) + (lambda () + (let ((def (cdr *env*))) + (set! *env* (car *env*)) + (lambda x + (set! *env* (cons *env* (cons x def))) + (a))))) + +(define (gen-pr2/rest* a) + (lambda () + (let ((def (cdr *env*))) + (set! *env* (car *env*)) + (lambda (x . y) + (set! *env* (cons *env* (cons x (cons y def)))) + (a))))) + +(define (gen-pr1/rest* a) + (lambda () + (let ((def (cdr *env*))) + (set! *env* (car *env*)) + (lambda (x y . z) + (set! *env* (cons *env* (cons x (cons y (cons z def))))) + (a))))) + +; +; global defs +; + +(define (define-global var val) + (if (assq var -glo-env-) + (set-cdr! (assq var -glo-env-) val) + (set! -glo-env- (cons (cons var val) -glo-env-)))) + +(define -glo-env- (list (cons 'define define-global))) + +(define-global 'cons cons) +(define-global 'car car) +(define-global 'cdr cdr) +(define-global 'null? null?) +(define-global 'not not) +(define-global '< <) +(define-global '-1+ -1+) +(define-global '+ +) +(define-global '- -) + +; +; current environment +; + +(define *env* '(dummy)) + +; +; environment manipulation +; + +(define (restore-env) + (set! *env* (car *env*))) + +; +; evaluator +; + +(define (evaluate expr) + ((compile (list 'lambda '() expr)))) + + + (evaluate '(define 'fib + (lambda (x) + (if (< x 2) + x + (+ (fib (- x 1)) + (fib (- x 2))))))) + +(print (evaluate '(fib 10))) diff --git a/examples/scheme/cps.scm b/examples/scheme/cps.scm new file mode 100644 index 0000000..f4f15eb --- /dev/null +++ b/examples/scheme/cps.scm @@ -0,0 +1,17 @@ +;;; -*-Scheme-*- + +(define (identity value) value) + +(define (gcd a b) (cps-gcd a b identity)) + +(define (cps-gcd a b k) + (if (= b 0) + (k a) + (cps-remainder a b (lambda (v) (cps-gcd b v k))))) + +(define (cps-remainder n d k) + (if (< n d) + (k n) + (cps-remainder (- n d) d k))) + +(print (gcd 4 6)) diff --git a/examples/scheme/dynamic.scm b/examples/scheme/dynamic.scm new file mode 100644 index 0000000..a281d39 --- /dev/null +++ b/examples/scheme/dynamic.scm @@ -0,0 +1,25 @@ +;;; -*-Scheme-*- + +(define cont #f) +(define done #f) + +(define (pr msg) + (display msg) (newline)) + +(define (doit) + (dynamic-wind + (lambda () (pr " 1:in")) + (lambda () + (set! done (call-with-current-continuation + (lambda (c) (set! cont c) (pr " catch") #f)))) + (lambda () (pr " 1:out"))) + (if (not done) + (dynamic-wind + (lambda () (pr " 2:in")) + (lambda () (pr " throw") (cont #t)) + (lambda () (pr " 2:out"))))) + +(dynamic-wind + (lambda () (pr "0:in")) + doit + (lambda () (pr "0:out"))) diff --git a/examples/scheme/fib.scm b/examples/scheme/fib.scm new file mode 100644 index 0000000..285721b --- /dev/null +++ b/examples/scheme/fib.scm @@ -0,0 +1,18 @@ +;;; -*-Scheme-*- + +(define (f n) + (if (= n 0) + 0 + (let fib ((i n) (a1 1) (a2 0)) + (if (= i 1) + a1 + (fib (- i 1) (+ a1 a2) a1))))) + +(print (f 20)) + +(define tau (/ (+ 1 (sqrt 5.0)) 2)) + +(define (fib n) + (/ (+ (expt tau n) (expt tau (- 0 n))) (sqrt 5.0))) + +(print (fib 20)) diff --git a/examples/scheme/fix.scm b/examples/scheme/fix.scm new file mode 100644 index 0000000..11a09cd --- /dev/null +++ b/examples/scheme/fix.scm @@ -0,0 +1,28 @@ +;;; -*-Scheme-*- +;;; +;;; from BYTE Feb. 88 page 208 + +(define (fixed-point f initial-value) + (define epsilon 1.0e-10) + (define (close-enough? v1 v2) + (< (abs (- v1 v2)) epsilon)) + (define (loop value) + (let ((next-value (f value))) + (if (close-enough? value next-value) + next-value + (loop next-value)))) + (loop initial-value)) + +(define (average-damp f) + (lambda (x) + (average x (f x)))) + +(define (average x y) + (/ (+ x y) 2)) + +(define (sqrt x) + (fixed-point (average-damp (lambda (y) (/ x y))) + 1)) + +(print (sqrt 2)) +(print (sqrt 4)) diff --git a/examples/scheme/flame.scm b/examples/scheme/flame.scm new file mode 100644 index 0000000..efae959 --- /dev/null +++ b/examples/scheme/flame.scm @@ -0,0 +1,258 @@ +;;; -*-Scheme-*- +;;; +;;; flame -- print a flame (ported from the Gnu-Emacs flame.el) + +(define flame) + +(let ((pos) (end-margin 55) (margin 65)) + +(set! flame (lambda n + (cond ((null? n) + (set! n '(1))) + ((or (not (integer? (car n))) (negative? (car n))) + (error 'flame "positive integer argument expected"))) + (set! pos 0) + (fluid-let ((garbage-collect-notify? #f)) + (do ((i (car n) (1- i))) ((zero? i)) + (if (> pos end-margin) + (begin + (set! pos 0) (newline))) + (flame-print #t (flatten (flame-expand '(sentence)))) + (display " ")) + (newline)) + #v)) + +(define (flame-expand x) + (if (pair? x) + (map flame-expand ((eval (car x)))) + x)) + +(define (flatten x) + (if (pair? x) + (apply append (map flatten x)) + (list x))) + +(define (capitalize w) + (display (char-upcase (string-ref w 0))) + (if (> (string-length w) 1) + (display (substring w 1 (string-length w))))) + +(define (flame-print first x) + (if (not (null? x)) + (begin + (let* ((w (symbol->string (car x))) (len (string-length w))) + ((if first capitalize display) w) + (set! pos (+ 1 pos len)) + (if (not (null? (cdr x))) + (begin + (if (not (memq (cadr x) '(? \. \, s! ! s \'s -loving))) + (if (< pos margin) + (display " ") + (set! pos 0) (newline))) + (flame-print #f (cdr x)))))))) + +(define (choose class) + (list-ref class (modulo (random) (length class)))) + +(define (sentence) (choose sentences)) + +(define sentences + '((how can you say that (statement) ?) + (I can't believe how (adjective) you are.) + (only a (der-term) like you would say that (statement) \.) + ((statement) \, huh?) (so, (statement) ?) + ((statement) \, right?) (I mean, (sentence)) + (don't you realise that (statement) ?) + (I firmly believe that (statement) \.) + (let me tell you something, you (der-term) \, (statement) \.) + (furthermore, you (der-term) \, (statement) \.) + (I couldn't care less about your (thing) \.) + (How can you be so (adjective) ?) + (you make me sick.) + (it's well known that (statement) \.) + ((statement) \.) + (it takes a (group-adj) (der-term) like you to say that (statement) \.) + (I don't want to hear about your (thing) \.) + (you're always totally wrong.) + (I've never heard anything as ridiculous as the idea that (statement) \.) + (you must be a real (der-term) to think that (statement) \.) + (you (adjective) (group-adj) (der-term) !) + (you're probably (group-adj) yourself.) + (you sound like a real (der-term) \.) + (why, (statement) !) + (I have many (group-adj) friends.) + (save the (thing) s!) (no nukes!) (ban (thing) s!) + (I'll bet you think that (thing) s are (adjective) \.) + (you know, (statement) \.) + (your (quality) reminds me of a (thing) \.) + (you have the (quality) of a (der-term) \.) + ((der-term) !) + ((adjective) (group-adj) (der-term) !) + (you're a typical (group-adj) person, totally (adjective) \.) + (man, (sentence)))) + +(define (quality) (choose qualities)) + +(define qualities + '((ignorance) (stupidity) (worthlessness) + (prejudice) (lack of intelligence) (lousiness) + (bad grammar) (lousy spelling) + (lack of common decency) (ugliness) (nastiness) + (subtlety) (dishonesty) ((adjective) (quality)))) + +(define (adjective) (choose adjectives)) + +(define adjectives + '((ignorant) (crass) (pathetic) (sick) + (bloated) (malignant) (perverted) (sadistic) + (stupid) (unpleasant) (lousy) (abusive) (bad) + (braindamaged) (selfish) (improper) (nasty) + (disgusting) (foul) (intolerable) (primitive) + (depressing) (dumb) (phoney) + ((adjective) and (adjective)) + (as (adjective) as a (thing)))) + +(define (der-term) (choose der-terms)) + +(define der-terms + '(((adjective) (der-term)) (sexist) (fascist) + (weakling) (coward) (beast) (peasant) (racist) + (cretin) (fool) (jerk) (ignoramus) (idiot) + (wanker) (rat) (slimebag) (DAF driver) + (Neanderthal) (sadist) (drunk) (capitalist) + (wimp) (dogmatist) (wally) (maniac) + (whimpering scumbag) (pea brain) (arsehole) + (moron) (goof) (incompetant) (lunkhead) (Nazi) + (SysThug) ((der-term) (der-term)))) + +(define (thing) (choose things)) + +(define things + '(((adjective) (thing)) (computer) + (Honeywell DPS8) (whale) (operation) + (sexist joke) (ten-incher) (dog) (MicroVAX II) + (source license) (real-time clock) + (mental problem) (sexual fantasy) + (venereal disease) (Jewish grandmother) + (cardboard cut-out) (punk haircut) (surfboard) + (system call) (wood-burning stove) + (graphics editor) (right wing death squad) + (disease) (vegetable) (religion) + (cruise missile) (bug fix) (lawyer) (copyright) + (PAD))) + +(define (group-adj) (choose group-adjs)) + +(define group-adjs + '((gay) (old) (lesbian) (young) (black) + (Polish) ((adjective)) (white) + (mentally retarded) (Nicaraguan) (homosexual) + (dead) (underpriviledged) (religious) + ((thing) -loving) (feminist) (foreign) + (intellectual) (crazy) (working) (unborn) + (Chinese) (short) ((adjective)) (poor) (rich) + (funny-looking) (Puerto Rican) (Mexican) + (Italian) (communist) (fascist) (Iranian) + (Moonie))) + +(define (statement) (choose statements)) + +(define statements + '((your (thing) is great) ((thing) s are fun) + ((person) is a (der-term)) + ((group-adj) people are (adjective)) + (every (group-adj) person is a (der-term)) + (most (group-adj) people have (thing) s) + (all (group-adj) dudes should get (thing) s) + ((person) is (group-adj)) (trees are (adjective)) + (if you've seen one (thing) \, you've seen them all) + (you're (group-adj)) (you have a (thing)) + (my (thing) is pretty good) + (the Martians are coming) + (the (paper) is always right) + (just because you read it in the (paper) that doesn't mean it's true) + ((person) was (group-adj)) + ((person) \'s ghost is living in your (thing)) + (you look like a (thing)) + (the oceans are full of dirty fish) + (people are dying every day) + (a (group-adj) man ain't got nothing in the world these days) + (women are inherently superior to men) + (the system staff is fascist) + (there is life after death) + (the world is full of (der-term) s) + (you remind me of (person)) (technology is evil) + ((person) killed (person)) + (the Russians are tapping your phone) + (the Earth is flat) + (it's OK to run down (group-adj) people) + (Multics is a really (adjective) operating system) + (the CIA killed (person)) + (the sexual revolution is over) + (Lassie was (group-adj)) + (the (group-adj) s have really got it all together) + (I was (person) in a previous life) + (breathing causes cancer) + (it's fun to be really (adjective)) + ((quality) is pretty fun) (you're a (der-term)) + (the (group-adj) culture is fascinating) + (when ya gotta go ya gotta go) + ((person) is (adjective)) + ((person) \'s (quality) is (adjective)) + (it's a wonderful day) + (everything is really a (thing)) + (there's a (thing) in (person) \'s brain) + ((person) is a cool dude) + ((person) is just a figment of your imagination) + (the more (thing) s you have, the better) + (life is a (thing)) (life is (quality)) + ((person) is (adjective)) + ((group-adj) people are all (adjective) (der-term) s) + ((statement) \, and (statement)) + ((statement) \, but (statement)) + (I wish I had a (thing)) + (you should have a (thing)) + (you hope that (statement)) + ((person) is secretly (group-adj)) + (you wish you were (group-adj)) + (you wish you were a (thing)) + (I wish I were a (thing)) + (you think that (statement)) + ((statement) \, because (statement)) + ((group-adj) people don't get married to (group-adj) people because (reason)) + ((group-adj) people are all (adjective) because (reason)) + ((group-adj) people are (adjective) \, and (reason)) + (you must be a (adjective) (der-term) to think that (person) said (statement)) + ((group-adj) people are inherently superior to (group-adj) people) + (God is Dead))) + +(define (paper) (choose papers)) + +(define papers + '((Daily Mail) (Daily Express) + (Centre Bulletin) (Sun) (Daily Mirror) + (Daily Telegraph) (Beano) (Multics Manual))) + +(define (person) (choose persons)) + +(define persons + '((Reagan) (Ken Thompson) (Dennis Ritchie) + (JFK) (the Pope) (Gadaffi) (Napoleon) + (Karl Marx) (Groucho) (Michael Jackson) + (Caesar) (Nietzsche) (Heidegger) + (Henry Kissinger) (Nixon) (Castro) (Thatcher) + (Attilla the Hun) (Alaric the Visigoth) (Hitler))) + +(define (reason) (choose reasons)) + +(define reasons + '((they don't want their children to grow up to be too lazy to steal) + (they can't tell them apart from (group-adj) dudes) + (they're too (adjective)) + ((person) wouldn't have done it) + (they can't spray paint that small) + (they don't have (thing) s) (they don't know how) + (they can't afford (thing) s))) +) + +(flame 15) diff --git a/examples/scheme/hanoi.scm b/examples/scheme/hanoi.scm new file mode 100644 index 0000000..9842eda --- /dev/null +++ b/examples/scheme/hanoi.scm @@ -0,0 +1,20 @@ +;;; -*-Scheme-*- +;;; +;;; Towers of Hanoi + +(define (hanoi n) + (if (zero? n) + (display "Huh?\n") + (transfer 'A 'B 'C n))) + +(define (print-move from to) + (format #t "Move disk from ~s to ~s~%" from to)) + +(define (transfer from to via n) + (if (= n 1) + (print-move from to) + (transfer from via to (1- n)) + (print-move from to) + (transfer via to from (1- n)))) + +(hanoi 3) diff --git a/examples/scheme/kons.scm b/examples/scheme/kons.scm new file mode 100644 index 0000000..a78acad --- /dev/null +++ b/examples/scheme/kons.scm @@ -0,0 +1,13 @@ +;;; -*-Scheme-*- + +(define (kons left right) + (lambda (op) + (case op + (a left) + (d right)))) + +(define (kar cell) (cell 'a)) +(define (kdr cell) (cell 'd)) + +(let ((k (kons 1 2))) + (print (cons (kar k) (kdr k)))) diff --git a/examples/scheme/meissel.scm b/examples/scheme/meissel.scm new file mode 100644 index 0000000..81b12cc --- /dev/null +++ b/examples/scheme/meissel.scm @@ -0,0 +1,31 @@ +;;; -*-Scheme-*- + +(define (partial-sum i n e ee base) + (- (quotient base (* i e)) + (quotient base (* (+ 2 i) ee)))) + +(define (a n base) ; atan(1/n) + (do ((i 1 (+ 4 i)) + (delta 1 (partial-sum i n e (* e n n) base)) + (e n (* e n n n n)) + (sum 0 (+ sum delta))) + ((zero? delta) sum))) + +(define (calc-pi base) + (- (* 32 (a 10 base)) + (* 16 (a 515 base)) + (* 4 (a 239 base)))) + +(define (run) + (format #t "How many digits of pi do you want (0 to exit): ") + (let ((num (read))) + (if (and (not (eof-object? num)) (positive? num)) + (let* ((extra (+ 5 (truncate (log num)))) + (base (expt 10 (+ num extra))) + (pi (calc-pi base))) + (format #t "~a.~a~%" + (quotient pi base) + (quotient (remainder pi base) (expt 10 extra))) + (run))))) + +(run) diff --git a/examples/scheme/mondo.scm b/examples/scheme/mondo.scm new file mode 100644 index 0000000..321410b --- /dev/null +++ b/examples/scheme/mondo.scm @@ -0,0 +1,9 @@ +;;; -*-Scheme-*- + +(let ((k (call-with-current-continuation (lambda (c) c)))) + (display 1) + (call-with-current-continuation (lambda (c) (k c))) + (display 2) + (call-with-current-continuation (lambda (c) (k c))) + (display 3) + (newline)) diff --git a/examples/scheme/perm.scm b/examples/scheme/perm.scm new file mode 100644 index 0000000..3f9ed8a --- /dev/null +++ b/examples/scheme/perm.scm @@ -0,0 +1,21 @@ +;;; -*-Scheme-*- + +(define (perm x) + (if (null? x) + (list x) + (let ((res '())) + (for-each + (lambda (e) + (set! res (append res (map (lambda (p) (cons e p)) + (perm (del e x)))))) + x) res))) + +(define (del e l) + (let loop ((r l)) + (if (pair? r) + (if (eq? e (car r)) + (loop (cdr r)) + (cons (car r) (loop (cdr r)))) + '()))) + +(print (perm '(a b c d))) diff --git a/examples/scheme/prim.scm b/examples/scheme/prim.scm new file mode 100644 index 0000000..83a9a9d --- /dev/null +++ b/examples/scheme/prim.scm @@ -0,0 +1,14 @@ +;;; -*-Scheme-*- + +(define (p n) + (let f ((n n) (i 2)) + (cond + ((> i n) '()) + ((integer? (/ n i)) + (cons i (f (/ n i) i))) + (else + (f n (+ i 1)))))) + +(print (p 12)) +(print (p 3628800)) +(print (p 4194304)) diff --git a/examples/scheme/ramanujan.scm b/examples/scheme/ramanujan.scm new file mode 100644 index 0000000..923f5b8 --- /dev/null +++ b/examples/scheme/ramanujan.scm @@ -0,0 +1,45 @@ +;;; -*-Scheme-*- + +(define (sqrt-of a base) + (do ((old 0) (xn (* a base base)) (an (* a base base))) + ((equal? old xn) xn) + (begin + (set! old xn) + (set! xn (quotient (+ xn (quotient an xn)) 2))))) + +; pi = 9801/(sqrt(8) * sum(...)) +(define (rama base) + (define (step n) + (quotient (* base (* (fact (* 4 n)) (+ 1103 (* 26390 n)))) + (* (expt (fact n) 4) (expt 396 (* 4 n))))) + (do ((i 0 (+ i 1)) + (sum 0 (+ sum delta)) + (delta 1 (step i))) + ((zero? delta) + sum))) + +(define (calc-pi-ramanujan base) + (quotient (* base base base 9801) (* (sqrt-of 8 base) (rama base)))) + +(define (fact n) + (let f ((i n) (a 1)) + (if (zero? i) + a + (f (- i 1) (* a i))))) + +(define (square x) (* x x)) + +(define base + (let ((d (format #t "How many decimals of pi do you want (0 to exit): ")) + (num (read))) + (if (and (not (eof-object? num)) (positive? num)) + (let* ((extra (+ 5 (truncate (log num))))) + (cons (expt 10 (+ num extra)) extra)) + #f))) + +(define (print-pi pi base) + (format #t "~a.~a~%" + (quotient pi (car base)) + (quotient (remainder pi (car base)) (expt 10 (cdr base))))) + +(if base (print-pi (calc-pi-ramanujan (car base)) base)) diff --git a/examples/scheme/rungekutta.scm b/examples/scheme/rungekutta.scm new file mode 100644 index 0000000..0804fe2 --- /dev/null +++ b/examples/scheme/rungekutta.scm @@ -0,0 +1,80 @@ +;;; -*-Scheme-*- + +(define integrate-system + (lambda (system-derivative initial-state h) + (let ((next (runge-kutta-4 system-derivative h))) + (letrec ((states + (cons initial-state + (delay (map-streams next + states))))) + states)))) + +(define runge-kutta-4 + (lambda (f h) + (let ((*h (scale-vector h)) + (*2 (scale-vector 2)) + (*1/2 (scale-vector (/ 1 2))) + (*1/6 (scale-vector (/ 1 6)))) + (lambda (y) + (let* ((k0 (*h (f y))) + (k1 (*h (f (add-vectors y (*1/2 k0))))) + (k2 (*h (f (add-vectors y (*1/2 k1))))) + (k3 (*h (f (add-vectors y k2))))) + (add-vectors y + (*1/6 (add-vectors k0 + (*2 k1) + (*2 k2) + k3)))))))) + +(define element-wise + (lambda (f) + (lambda vectors + (generate-vector + (vector-length (car vectors)) + (lambda (i) + (apply f + (map (lambda (v) (vector-ref v i)) + vectors))))))) + +(define generate-vector + (lambda (size proc) + (let ((ans (make-vector size))) + (letrec ((loop + (lambda (i) + (cond ((= i size) ans) + (else + (vector-set! ans 1 (proc i)) + (loop (+ i 1))))))) + (loop 0))))) + +(define add-vectors (element-wise +)) + +(define scale-vector + (lambda (s) + (element-wise (lambda (x) (* x s))))) + +(define map-streams + (lambda (f s) + (cons (f (head s)) + (delay (map-streams f (tail s)))))) + +(define head car) +(define tail + (lambda (stream) (force (cdr stream)))) + +(define damped-oscillator + (lambda (R L C) + (lambda (state) + (let ((Vc (vector-ref state 0)) + (Il (vector-ref state 1))) + (vector (- 0 (+ (/ Vc (* R C)) (/ Il C))) + (/ Vc L)))))) + +(define the-states + (integrate-system + (damped-oscillator 10000 1000 0.001) + '#(1 0) + 0.01)) + +(print the-states) +; (print (tail the-states)) diff --git a/examples/scheme/sqrt.scm b/examples/scheme/sqrt.scm new file mode 100644 index 0000000..f2421fc --- /dev/null +++ b/examples/scheme/sqrt.scm @@ -0,0 +1,19 @@ +;;; -*-Scheme-*- + +(define (sqrt x) + (define (good-enough? guess) + (< (abs (- (square guess) x)) 0.001)) + (define (improve guess) + (average guess (/ x guess))) + (define (sqrt-iter guess) + (if (good-enough? guess) + guess + (sqrt-iter (improve guess)))) + (sqrt-iter 1)) + +(define (square x) (* x x)) +(define (average x y) (/ (+ x y) 2)) +(define (abs x) (if (negative? x) (- x) x)) + +(print (sqrt 2)) +(print (sqrt 4)) diff --git a/examples/scheme/unify.scm b/examples/scheme/unify.scm new file mode 100644 index 0000000..f6ebe7e --- /dev/null +++ b/examples/scheme/unify.scm @@ -0,0 +1,64 @@ +;;; -*-Scheme-*- +;;; +;;; From Kent Dybvig's book on Chez Scheme + +(define unify) + +(letrec + ((occurs? + (lambda (u v) + (and (pair? v) + (define (f l) + (and (not (null? l)) + (or (eq? u (car l)) + (occurs? u (car l)) + (f (cdr l))))) + (f (cdr v))))) + (sigma + (lambda (u v s) + (lambda (x) + (define (f x) + (if (symbol? x) + (if (eq? x u) v x) + (cons (car x) (map f (cdr x))))) + (f (s x))))) + (try-subst + (lambda (u v s ks kf) + (let ((u (s u))) + (if (not (symbol? u)) + (uni u v s ks kf) + (let ((v (s v))) + (cond + ((eq? u v) (ks s)) + ((occurs? u v) (kf "loop")) + (else (ks (sigma u v s))))))))) + (uni + (lambda (u v s ks kf) + (cond + ((symbol? u) (try-subst u v s ks kf)) + ((symbol? v) (try-subst v u s ks kf)) + ((and (eq? (car u) (car v)) + (= (length u) (length v))) + (define (f u v s) + (if (null? u) + (ks s) + (uni (car u) + (car v) + s + (lambda (s) (f (cdr u) (cdr v) s)) + kf))) + (f (cdr u) (cdr v) s)) + (else (kf "clash")))))) + (set! unify + (lambda (u v) + (uni u + v + (lambda (x) x) + (lambda (s) (s u)) + (lambda (msg) msg))))) + +(print (unify 'x 'y)) +(print (unify '(f x y) '(g x y))) +(print (unify '(f x (h)) '(f (h) y))) +(print (unify '(f (g x) y) '(f y x))) +(print (unify '(f (g x) y) '(f y (g x)))) diff --git a/examples/scheme/work.scm b/examples/scheme/work.scm new file mode 100644 index 0000000..a30500d --- /dev/null +++ b/examples/scheme/work.scm @@ -0,0 +1,43 @@ +;;; -*-Scheme-*- +;;; +;;; Putting Scheme to Work +;;; By Olivier Danvy +;;; Bigre special edition "Putting Scheme to Work" + +(define fix + (let ((z (lambda (P) + (lambda (u) + (lambda (t) + (lambda (t) + (lambda (i) + (lambda (n) + (lambda (g) + (lambda (S) + (lambda (c) + (lambda (h) + (lambda (e) + (lambda (m) + (lambda (e) + (lambda (t) + (lambda (o) + (lambda (W) + (lambda (o) + (lambda (r) + (lambda (k) + (lambda (!) + (! (lambda (break) + (((((((((((((((((((((W o) r) k) + W) o) r) k) + W) o) r) k) + W) o) r) k) + W) o) r) k) !) + break))))))))))))))))))))))))) + (let ((Z z)) + (((((((((((((((((((z z) z) z) z) z) Z) Z) Z) Z) Z) Z) Z) z) z) z) z) z) z) z)))) + +(print +((fix (lambda (f) + (lambda (n) + (if (zero? n) + 1 + (* n (f (- n 1))))))) 9)) diff --git a/examples/unix/calc.scm b/examples/unix/calc.scm new file mode 100644 index 0000000..8c251c9 --- /dev/null +++ b/examples/unix/calc.scm @@ -0,0 +1,60 @@ +;;; -*-Scheme-*- +;;; +;;; Demonstrate pipes, fork, exec. +;;; +;;; (calc-open) -- Open two pipes to/from UNIX dc command +;;; (calc expr) -- Send expression to dc, return result as a string +;;; (calc-close) -- Close pipes, wait for child process +;;; +;;; +;;; This program requires vanilla UNIX dc. It does not work with GNU dc, +;;; because GNU dc uses buffered output even if standard output points to +;;; a pipe. This means that GNU dc does not produce any output until the +;;; pipe is closed; the call to read-string therefore just hangs. + + +(require 'unix) + +(define calc-from-dc) ; input port: standard output of dc command +(define calc-to-dc) ; output port: standard input of dc command +(define calc-dc-pid) ; process-ID of child process running dc + +(define calc-dc-command "/usr/bin/dc") + +(define (calc-open) + (let* ((from (unix-pipe)) + (to (unix-pipe)) + (redirect-fd (lambda (a b) + (unix-dup a b) (unix-close a)))) + (set! calc-dc-pid (unix-fork)) + (if (zero? calc-dc-pid) + (begin + (unix-close (car from)) + (unix-close (cdr to)) + (redirect-fd (car to) 0) + (redirect-fd (cdr from) 1) + (unix-exec calc-dc-command '("dc"))) + (begin + (unix-close (cdr from)) + (unix-close (car to)) + (set! calc-to-dc (unix-filedescriptor->port (cdr to) "w")) + (set! calc-from-dc (unix-filedescriptor->port (car from) "r")))))) + +(define (calc expr) + (format calc-to-dc "~a~%" expr) + (flush-output-port calc-to-dc) + (read-string calc-from-dc)) + +(define (calc-close) + (close-output-port calc-to-dc) + (close-input-port calc-from-dc) + (if (feature? 'unix:wait-process) + (unix-wait-process calc-dc-pid) + (unix-wait))) + + +;;; Test -- print sqrt(2): + +(calc-open) +(display (calc "10k 2v p")) (newline) +(calc-close) diff --git a/examples/unix/copy.scm b/examples/unix/copy.scm new file mode 100644 index 0000000..bb2f325 --- /dev/null +++ b/examples/unix/copy.scm @@ -0,0 +1,59 @@ +;;; -*-Scheme-*- +;;; +;;; Demonstrate open, stat, read, write. + +(require 'unix) + +(define copy-buffer-size 8192) + +(define (copy-file from to) + (let ((from-stat (unix-stat from)) + (to-stat (unix-errval (unix-stat to)))) + + (if (eq? (stat-type from-stat) 'directory) ; complain if "from" + (error 'copy-file "~s is a directory" from)) ; is a directory + + (if (and (not (unix-error? to-stat)) ; destination exists + (eq? (stat-type to-stat) 'directory)) ; and is a directory? + (set! to (format #f "~a/~a" to (pathname-tail from)))) + + (let* ((to-fd (unix-open to '(write create exclusive) + (stat-mode from-stat))) + (from-fd (unix-open from '(read))) + (buf (make-string copy-buffer-size))) + + (let loop ((num-chars (unix-read-string-fill! from-fd buf))) + (if (positive? num-chars) + (begin + (unix-write to-fd buf num-chars) + (loop (unix-read-string-fill! from-fd buf))))) + + (unix-close from-fd) + (unix-close to-fd)))) + +(define (string-rindex s c) + (let loop ((i (string-length s))) + (cond + ((zero? i) #f) + ((char=? (string-ref s (1- i)) c) (1- i)) + (else (loop (1- i)))))) + +(define (pathname-tail s) + (let ((i (string-rindex s #\/))) + (if i + (substring s (1+ i) (string-length s)) + s))) + +;;; Test -- copy /bin/date into a temporary file + +(let ((tmp (unix-tempname))) + (unwind-protect + (begin + (format #t "Copying /bin/date to ~a.~%" tmp) + (copy-file "/bin/date" tmp) + (format #t "Comparing files... ") + (if (zero? (unix-system (format #f "cmp -s /bin/date ~s" tmp))) + (format #t "OK.~%") + (format #t "Oops, files differ.~%"))) + (format #t "Removing ~a.~%" tmp) + (unix-unlink tmp))) diff --git a/examples/unix/lock.scm b/examples/unix/lock.scm new file mode 100644 index 0000000..1a796d5 --- /dev/null +++ b/examples/unix/lock.scm @@ -0,0 +1,26 @@ +;;; -*-Scheme-*- +;;; +;;; Demonstrate locking +;;; +;;; (lock-vi file) -- Starts vi on file, providing exclusive access. + +(require 'unix) + +(define (lock-vi file) + (let* ((fd (unix-open file '(read write))) + (lock ((record-constructor lock-record) #t 'set 0 0))) + + ;; attempt to apply lock to file; print a message and go + ;; to sleep if lock is held by somebody else: + + (let loop () + (if (not (unix-set-lock fd lock #f)) + (begin + (format #t "Someone else is editing ~s...~%" file) + (unix-sleep 10) + (loop)))) + + ;; invoke vi; remove lock when done: + + (unix-system (format #f "vi ~a" file)) + (unix-remove-lock fd lock))) diff --git a/examples/unix/ls.scm b/examples/unix/ls.scm new file mode 100644 index 0000000..b3e2998 --- /dev/null +++ b/examples/unix/ls.scm @@ -0,0 +1,88 @@ +(require 'unix) + +;; Map file type to letter + +(define type-char-map + '((regular . #\-) (directory . #\d) (symlink . #\l) (socket . #\=) + (fifo . #\p) (character-special . #\c) (block-special . #\b) + (unknown . #\?))) + +;; Map file mode to /bin/ls-style mode string without/with taking +;; setuid/setgid bit into account + +(define perm-tab '#("---" "--x" "-w-" "-wx" "r--" "r-x" "rw-" "rwx")) +(define perm-tab1 '#("--S" "--s" "-wS" "-ws" "r-S" "r-s" "rwS" "rws")) + +;; Right justify string within field of `n' spaces + +(define (rjust str n) + (let* ((y (string-append (make-string n #\space) str)) + (l (string-length y))) + (substring y (- l n) l))) + +;; Left justify string within field of `n' spaces + +(define (ljust str n) + (let* ((y (string-append str (make-string n #\space))) + (l (string-length y))) + (substring y 0 n))) + + +(define (print-type type) + (display (cdr (assq type type-char-map)))) + +(define (print-perm perm setid?) + (let ((bits (vector-ref (if setid? perm-tab1 perm-tab) perm))) + (display bits))) + +;; This could probably be made more efficient by using Elk's bitstring +;; extension + +(define (print-mode mode) + (let ((owner 0) (group 0) (world (modulo mode 8))) + (set! mode (quotient mode 8)) (set! group (modulo mode 8)) + (set! mode (quotient mode 8)) (set! owner (modulo mode 8)) + (set! mode (quotient mode 8)) + (print-perm owner (>= mode 4)) + (print-perm group (odd? (quotient mode 2))) + (print-perm world #f))) + +(define (print-nlink nlink) + (display (rjust (number->string nlink) 3)) + (display #\space)) + +(define (print-owner uid) + (display (ljust (passwd-name (unix-get-passwd uid)) 8))) + +(define (print-size size) + (display (rjust (number->string size) 9))) + +(define (print-mtime mtime) + (display (substring (unix-time->string mtime) 3 16)) + (display #\space)) + +(define (print-name name) + (display name)) + +(define (print-link name) + (display " -> ") + (display (unix-readlink name))) + +(define (list-entry name) + (if (not (char=? (string-ref name 0) #\.)) + (let ((s (unix-lstat name))) + (print-type (stat-type s)) + (print-mode (stat-mode s)) + (print-nlink (stat-nlink s)) + (print-owner (stat-uid s)) + (print-size (stat-size s)) + (print-mtime (stat-mtime s)) + (print-name name) + (if (eq? (stat-type s) 'symlink) + (print-link name)) + (newline)))) + +(define (ls) + (for-each list-entry (unix-read-directory "."))) + +(ls) diff --git a/examples/unix/pipsiz.scm b/examples/unix/pipsiz.scm new file mode 100644 index 0000000..3eed140 --- /dev/null +++ b/examples/unix/pipsiz.scm @@ -0,0 +1,31 @@ +;;; -*-Scheme-*- +;;; +;;; Demonstrate non-blocking I/O +;;; +;;; (pipe-size) -- Calculate capacity of pipe. + +(require 'unix) + +(define (pipe-size) + (let* ((pipe (unix-pipe)) + (flags (unix-filedescriptor-flags (cdr pipe))) + (len 32) ; assumes capacity is multiple of len + (noise (make-string len)) + (flag (if (memq 'nonblock (unix-list-filedescriptor-flags)) + 'nonblock + 'ndelay))) + + ;; enable non-blocking I/O for write end of pipe: + (unix-filedescriptor-flags (cdr pipe) (cons flag flags)) + + (unwind-protect + (let loop ((size 0)) + (if (unix-error? (unix-errval (unix-write (cdr pipe) noise))) + (if (memq (unix-errno) '(eagain ewouldblock edeadlk)) + size + (error 'pipe-size "~E")) + (loop (+ size 32)))) + (unix-close (car pipe)) + (unix-close (cdr pipe))))) + +(print (pipe-size)) diff --git a/examples/unix/timeout.scm b/examples/unix/timeout.scm new file mode 100644 index 0000000..482a077 --- /dev/null +++ b/examples/unix/timeout.scm @@ -0,0 +1,34 @@ +;;; -*-Scheme-*- +;;; +;;; Demonstrate signals and alarm +;;; +;;; (timeout-read fdescr seconds) -- read with timeout + +(require 'unix) + +;;; Read a string from file descriptor fd and return it (maximum length +;;; 1000 characters). Return #f on timeout (2nd arg, in seconds). + +(define (timeout-read fd sec) + (let ((str (make-string 1000)) + (old-handler 'default)) + (call/cc + (lambda (tmo) + (dynamic-wind + (lambda () + (set! old-handler (unix-signal 'sigalrm (lambda _ (tmo #f)))) + (unix-alarm sec)) + (lambda () + (substring str 0 (unix-read-string-fill! fd str))) + (lambda () + (unix-alarm 0) + (unix-signal 'sigalrm old-handler))))))) + + +;;; Test + +(display "Enter a line (timeout 5 seconds): ") +(let ((ret (timeout-read 0 5))) + (if ret + (format #t "Got ~s~%" ret) + (format #t "~%Got timeout~%"))) diff --git a/examples/xaw/accel.scm b/examples/xaw/accel.scm new file mode 100644 index 0000000..8e05af4 --- /dev/null +++ b/examples/xaw/accel.scm @@ -0,0 +1,31 @@ +;;; -*-Scheme-*- +;;; +;;; Demonstrate usage of accelerators +;;; +;;; Based on an example program (xtryaccel.c) from the O'Reilly +;;; book `X Toolkit Intrinsics Programming Manual' + +(require 'xwidgets) +(load-widgets command box shell) + +(define top (application-initialize 'accel + "*bye.label: Goodbye" + "*hello.label: Hello" + "*font: *courier-bold-r*18*iso8859-1")) + +(define box (create-managed-widget (find-class 'box) top)) + +(define bye (create-managed-widget 'bye (find-class 'command) box + 'accelerators "q: set() notify()")) +(add-callback bye 'callback (lambda _ (exit))) + +(define hello (create-managed-widget 'hello (find-class 'command) box + 'accelerators "p: set() notify() reset()")) +(add-callback hello 'callback (lambda _ (display "Hello world!\n"))) + +(install-accelerators box bye) +(install-accelerators box hello) + +(realize-widget top) +(display "Press 'p' for Hello, 'q' for Goodbye.\n") +(context-main-loop (widget-context top)) diff --git a/examples/xaw/clickcount.scm b/examples/xaw/clickcount.scm new file mode 100644 index 0000000..bd6e341 --- /dev/null +++ b/examples/xaw/clickcount.scm @@ -0,0 +1,27 @@ +;;; -*-Scheme-*- +;;; +;;; Demonstrate usage of translations and actions. +;;; +;;; Based on an example program (xclickcount.c) from the O'Reilly +;;; collection of Xt example programs. + +(require 'xwidgets) +(load-widgets shell label) + +(define top (application-initialize 'clickcount)) +(define con (widget-context top)) + +(define increment-count + (let ((count 0)) + (lambda (w event . args) + (set! count (1+ count)) + (set-values! w 'label (format #f "# of clicks: ~s" count))))) + +(context-add-action con 'increment-count increment-count) + +(define label (create-managed-widget (find-class 'label) top + 'width 150 'label "Click here")) +(set-values! label 'translations ": increment-count()") + +(realize-widget top) +(context-main-loop con) diff --git a/examples/xaw/dialog.scm b/examples/xaw/dialog.scm new file mode 100644 index 0000000..48a865d --- /dev/null +++ b/examples/xaw/dialog.scm @@ -0,0 +1,59 @@ +;;; -*-Scheme-*- +;;; +;;; Dialog box demo + +(require 'xwidgets) +(load-widgets shell ascii dialog command box label) + +(define top (application-initialize 'dialog)) +(define dpy (widget-display top)) + +(define f (open-font dpy "*courier-bold-r-normal--14*")) + +(define gray-bits "\10\2\10\2") +(define gray + (create-pixmap-from-bitmap-data + (display-root-window dpy) gray-bits 4 4 + (black-pixel dpy) (white-pixel dpy) (display-default-depth dpy))) + +(define bb (create-managed-widget (find-class 'box) top)) +(define quit (create-managed-widget (find-class 'command) bb 'label "Quit")) +(define p (create-managed-widget (find-class 'command) bb 'label "Press me")) +(define pshell (create-popup-shell (find-class 'transient-shell) top)) +(set-values! pshell 'width 150 'height 100) + +(add-callback quit 'callback (lambda _ (exit))) + +(add-callback p 'callback + (lambda _ + (let* ((width (car (get-values top 'width))) + (height (car (get-values top 'height))) + (pos (widget-translate-coordinates top (truncate (/ width 2)) + (truncate (/ height 2))))) + (set-values! pshell 'x (car pos) 'y (cdr pos))) + (set-sensitive! p #f) + (set-sensitive! quit #f) + (popup pshell 'grab-nonexclusive))) + +(define (dialog-popdown . _) + (popdown pshell) + (set-sensitive! p #t) + (set-sensitive! quit #t)) + +(define dialog (create-managed-widget (find-class 'dialog) pshell)) +(set-values! dialog 'background-pixmap gray) +(set-values! dialog 'value "/tmp/test" 'label "Filename:") +(set-values! (name->widget dialog 'value) 'font f) + +(define b (create-managed-widget (find-class 'command) dialog 'label "cancel")) +(add-callback b 'callback dialog-popdown) + +(define b2 (create-managed-widget (find-class 'command) dialog 'label "write")) +(add-callback b2 'callback + (lambda (w) + (format #t "Filename is ~s~%" + (car (get-values (widget-parent w) 'value))) + (dialog-popdown))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/grip.scm b/examples/xaw/grip.scm new file mode 100644 index 0000000..d39986a --- /dev/null +++ b/examples/xaw/grip.scm @@ -0,0 +1,23 @@ +;;; -*-Scheme-*- +;;; +;;; Grip widget demo + +(require 'xwidgets) +(load-widgets shell grip) + +(define top (application-initialize 'grip)) +(set-values! top 'width 50 'height 50) + +(define g (create-managed-widget (find-class 'grip) top)) + +(augment-translations g +" : GripAction(press) + : GripAction(move) + : GripAction(release,done)") + +(add-callback g 'callback + (lambda (w x) + (format #t "Action: ~s Event: ~s~%" (cdr x) (caar x)))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/list.scm b/examples/xaw/list.scm new file mode 100644 index 0000000..c757dea --- /dev/null +++ b/examples/xaw/list.scm @@ -0,0 +1,64 @@ +;;; -*-Scheme-*- +;;; +;;; List widget demo (directory browser) + +(require 'xwidgets) +(load-widgets shell form label command list) +(require 'unix) +(require 'sort 'qsort.scm) + +(define top (application-initialize 'list)) +(set-values! top 'allow-shell-resize #t) + +(define form (create-managed-widget (find-class 'form) top)) + +(define quit (create-managed-widget (find-class 'command) form)) +(set-values! quit 'label "quit") +(add-callback quit 'callback (lambda x (exit))) + +(define back (create-managed-widget (find-class 'command) form)) +(set-values! back 'label "back" 'from-horiz quit) +(add-callback back 'callback (lambda x (goto ".."))) + +(define lab (create-managed-widget (find-class 'label) form)) +(set-values! lab 'border-width 0 'from-horiz back 'resizable #t) + +;; List widget is broken; ``list'' resource *must* be initialized: +(define lst (create-managed-widget (find-class 'list) form 'list '())) +(set-values! lst 'from-vert lab 'resizable #t 'vertical-list #t) + +(add-callback lst 'callback + (lambda (w i) + (let ((type (stat-type (unix-stat (string-append where "/" (car i)))))) + (set-values! lab 'label type) + (if (eq? type 'directory) + (goto (car i)))))) + +(define (goto dir) + (if (string=? dir "..") + (begin + (if (not (string=? where "/")) + (begin + (set! where + (substring where 0 + (do ((i (- (string-length where) 2) (1- i))) + ((char=? (string-ref where i) #\/) i)))) + (if (eqv? where "") + (set! where "/"))))) + (if (not (or (string=? dir "/") (string=? where "/"))) + (set! where (string-append where "/"))) + (set! where (string-append where dir))) + (set-values! lab 'label where) + (define l '()) + (for-each (lambda (d) (if (not (member d '("." ".."))) + (set! l (cons d l)))) + (unix-read-directory where)) + (set-values! lst 'default-columns + (max 2 (ceiling (/ (length l) 40)))) + (list-change! lst (sort l string: XawPositionSimpleMenu(the-menu) MenuPopup(the-menu)") + +;; Due to a bug in the X11R5 SimpleMenu widget the `label' resource +;; can only be set at widget creation time: +;; +(define menu (create-popup-shell 'the-menu (find-class 'simplemenu) l + 'label 'menu)) + +(define (selected _) + (print (widget-name (simplemenu-get-active-entry menu)))) + +(define entries (map + (lambda (e) + (create-managed-widget e (find-class 'smebsb) menu 'vert-space 40 + 'label e 'callback (list selected))) + '("hamburger" "fishburger" "pommes frites" "chicken nuggets" "chicken wings" + "milk shake"))) + +; (set-values! menu 'popup-on-entry (cadr entries) 'label 'menu +; 'menu-on-screen #t) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/porthole.scm b/examples/xaw/porthole.scm new file mode 100644 index 0000000..c9e3b0f --- /dev/null +++ b/examples/xaw/porthole.scm @@ -0,0 +1,34 @@ +;;; -*-Scheme-*- +;;; +;;; Porthole widget demo +;;; This only works with X11R5; there is no clock widget in X11R6-Xaw. + +(require 'xwidgets) +(load-widgets shell clock form panner porthole) + +(define top (application-initialize 'porthole)) + +(define form (create-managed-widget (find-class 'form) top)) + +(define panner (create-managed-widget (find-class 'panner) form)) +(set-values! panner 'background-stipple 'grid2 'default-scale 15) + +(define porthole (create-managed-widget (find-class 'porthole) form)) +(set-values! porthole 'width 150 'height 150 'from-vert panner) + +(define clock (create-managed-widget (find-class 'clock) porthole)) +(set-values! clock 'width 300 'height 300) + +(add-callback panner 'report-callback + (lambda (w xy) + (set-values! clock 'x (- (car xy)) 'y (- (cdr xy))))) + +(add-callback porthole 'report-callback + (lambda (w args) + (multiple-value-bind (what x y sw sh cw ch) args + (set-values! panner 'slider-x x 'slider-y y) + (set-values! panner 'slider-width sw 'slider-height sh + 'canvas-width cw 'canvas-height ch)))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/pulldown.scm b/examples/xaw/pulldown.scm new file mode 100644 index 0000000..d459b53 --- /dev/null +++ b/examples/xaw/pulldown.scm @@ -0,0 +1,46 @@ +;;; -*-Scheme-*- +;;; +;;; Pulldown menu demo + +(require 'xwidgets) +(load-widgets shell menubutton simplemenu smebsb smeline sme) + +(define top (application-initialize 'pulldown)) + +(define mb (create-managed-widget (find-class 'menubutton) top)) +(set-values! mb 'label "Please press left button" 'menu-name 'the-menu) + +;; Due to a bug in the X11R5 SimpleMenu widget the `label' resource +;; can only be set at widget creation time: +;; +(define menu (create-popup-shell 'the-menu (find-class 'simplemenu) mb + 'label 'menu)) + +(define data "\0\0\0\6\0\3\0\3\200\1\206\1\316\0\314\0\170\0\160\0\40\0\0\0") +(define bm (create-bitmap-from-data (display-root-window (widget-display top)) + data 12 12)) + +(define (selected w) + (format #t "~s selected~%" (widget-name w))) + +(for-each + (lambda (e) + (if e + (if (eqv? e "") + (create-managed-widget (find-class 'sme) menu 'height 10) + (create-managed-widget e (find-class 'smebsb) menu + 'vert-space 40 'label e 'callback (list selected))) + (create-managed-widget (find-class 'smeline) menu))) + '("hamburger" "fishburger" "pommes frites" "" "chicken nuggets" + "chicken wings" #f "cola" "milk shake" #f)) + +(define w (create-managed-widget (find-class 'smebsb) menu)) +(set-values! w 'vert-space 50 'left-bitmap bm 'label "eat here" + 'left-margin 16) +(add-callback w 'callback + (lambda (w) + (set-values! w 'left-bitmap + (if (eq? (car (get-values w 'left-bitmap)) 'none) bm 'none)))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/scrollbar.scm b/examples/xaw/scrollbar.scm new file mode 100644 index 0000000..3b70de5 --- /dev/null +++ b/examples/xaw/scrollbar.scm @@ -0,0 +1,22 @@ +;;; -*-Scheme-*- +;;; +;;; Scrollbar widget demo + +(require 'xwidgets) +(load-widgets shell scrollbar) + +(define top (application-initialize 'scrollbar)) + +(define scroll (create-managed-widget (find-class 'scrollbar) top + 'thickness 35 'length 400)) + +(define (sp w x) (format #t "(scroll-proc ~s)~%" x)) +(define (jp w x) (format #t "(jump-proc ~s)~%" x)) + +(add-callback scroll 'scroll-proc sp) +(set-values! scroll 'jump-proc (list jp)) + +(scrollbar-set-thumb! scroll 0.3 0.2) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/scrollbox.scm b/examples/xaw/scrollbox.scm new file mode 100644 index 0000000..307c8af --- /dev/null +++ b/examples/xaw/scrollbox.scm @@ -0,0 +1,33 @@ +;;; -*-Scheme-*- +;;; +;;; Scroll box demo + +(require 'xwidgets) +(load-widgets shell command box label) + +(define items (list 'Helvetica 'Courier 'Times 'Palatino 'Zapf\ Chancery + 'Zapf\ Dingbats)) +(set-cdr! (last-pair items) items) + +(define top (application-initialize 'scrollbox)) +(define dpy (widget-display top)) + +(define dia-bits "\0\0\100\0\340\0\360\1\370\3\374\7\376\17\374\7\370\3\360\1\340\0\100\0\0\0") +(define dia (create-bitmap-from-data (display-root-window dpy) dia-bits 13 13)) + +(define box (create-managed-widget (find-class 'box) top)) +(set-values! box 'width 200) + +(define button (create-managed-widget (find-class 'command) box)) +(set-values! button 'bitmap dia) + +(define label (create-managed-widget (find-class 'label) box)) +(set-values! label 'width 130 'label (car items) 'resize #f 'justify 'left + 'font (open-font dpy "*courier-bold-r-normal--14*")) +(add-callback button 'callback + (lambda (w) + (set! items (cdr items)) + (set-values! label 'label (car items)))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/stripchart.scm b/examples/xaw/stripchart.scm new file mode 100644 index 0000000..2d4d661 --- /dev/null +++ b/examples/xaw/stripchart.scm @@ -0,0 +1,21 @@ +;;; -*-Scheme-*- +;;; +;;; Stripchart widget demo + +(require 'xwidgets) +(load-widgets shell stripchart) + +(define top (application-initialize 'stripchart)) + +(define s (create-managed-widget (find-class 'stripchart) top)) +(set-values! s 'update 1 'jump-scroll 2) + +(define id + (stripchart-set-sampler s + (let ((x -.1)) + (lambda () + (set! x (+ x .1)) + (1+ (sin x)))))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/text.scm b/examples/xaw/text.scm new file mode 100644 index 0000000..741401f --- /dev/null +++ b/examples/xaw/text.scm @@ -0,0 +1,37 @@ +;;; -*-Scheme-*- +;;; +;;; Trivial text widget demo (the text widget isn't fully supported +;;; by Elk) + +(require 'xwidgets) +(load-widgets shell ascii box command label) + +(define top (application-initialize 'text)) + +(define box (create-managed-widget (find-class 'box) top)) + +(define lab (create-managed-widget (find-class 'label) box)) +(set-values! lab 'border-width 0 'label "Enter a number:") + +(define txt (create-managed-widget (find-class 'ascii-text) box)) +(set-values! txt 'edit-type 'edit 'resize 'width) + +(define can (create-managed-widget (find-class 'command) box)) +(set-values! can 'label "CANCEL") +(add-callback can 'callback (lambda foo (exit))) + +(define acc (create-managed-widget (find-class 'command) box)) +(set-values! acc 'label "ACCEPT") +(add-callback acc 'callback + (lambda foo + (let ((s (ascii-text-string txt))) + (if (not (number-string? s)) + (format #t "~s is not a number!~%" s) + (format #t "Result is ~a~%" s) + (exit))))) + +(define (number-string? s) + (not (or (eqv? s "") (memq #f (map char-numeric? (string->list s)))))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/tree.scm b/examples/xaw/tree.scm new file mode 100644 index 0000000..607f0cf --- /dev/null +++ b/examples/xaw/tree.scm @@ -0,0 +1,38 @@ +;;; -*-Scheme-*- +;;; +;;; Tree widget demo + +(define (make-tree tree parent x) + (let ((p (create-managed-widget (find-class 'label) tree 'label (car x)))) + (if parent (set-values! p 'tree-parent parent)) + (do ((l (cdr x) (cdr l))) ((null? l)) + (if (pair? (car l)) + (make-tree tree p (car l)) + (let ((w (create-managed-widget (find-class 'label) tree + 'label (car l)))) + (set-values! w 'tree-parent p)))))) + +(require 'xwidgets) +(load-widgets shell label tree) + +(define top (application-initialize 'tree)) + +(define tree (create-managed-widget (find-class 'tree) top)) + +(make-tree tree #f + '(world + (america + (north + usa canada) + (middle + mexico cuba) + (south + brasilia ecuador chile)) + (europe + france britain germany) + (asia + japan korea) + (antarctica))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xaw/viewport.scm b/examples/xaw/viewport.scm new file mode 100644 index 0000000..14e59ad --- /dev/null +++ b/examples/xaw/viewport.scm @@ -0,0 +1,19 @@ +;;; -*-Scheme-*- +;;; +;;; Viewport widget demo +;;; This only works with X11R5; there is no clock widget in X11R6-Xaw. + +(require 'xwidgets) +(load-widgets shell clock viewport) + +(define top (application-initialize 'viewport)) + +(define v (create-managed-widget (find-class 'viewport) top + 'force-bars #t 'allow-horiz #t 'allow-vert #t)) +(set-values! v 'width 120 'height 120) + +(define c (create-managed-widget (find-class 'clock) v)) +(set-values! c 'width 200 'height 200) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xlib/hello.scm b/examples/xlib/hello.scm new file mode 100644 index 0000000..c03481e --- /dev/null +++ b/examples/xlib/hello.scm @@ -0,0 +1,32 @@ +;;; -*-Scheme-*- + +(require 'xlib) + +(define (hello-world) + (let* ((dpy (open-display)) + (black (black-pixel dpy)) (white (white-pixel dpy)) + (font (open-font dpy "*-new century schoolbook-bold-r*24*")) + (text (translate-text "Hello world!")) + (width (+ 2 (text-width font text '1-byte))) + (height (+ 2 (max-char-ascent font) (max-char-descent font))) + (win (create-window 'parent (display-root-window dpy) + 'width width 'height height + 'background-pixel white + 'event-mask '(exposure button-press))) + (gc (create-gcontext 'window win 'background white + 'foreground black 'font font))) + (map-window win) + (unwind-protect + (handle-events dpy #t #f + (button-press + (lambda ignore #t)) + (expose + (lambda ignore + (let ((x (truncate (/ (- (window-width win) width) 2))) + (y (truncate (/ (- (+ (window-height win) + (max-char-ascent font)) + (max-char-descent font)) 2)))) + (draw-poly-text win gc x y text '1-byte)) #f))) + (close-display dpy)))) + +(hello-world) diff --git a/examples/xlib/lines.scm b/examples/xlib/lines.scm new file mode 100644 index 0000000..ab17b7f --- /dev/null +++ b/examples/xlib/lines.scm @@ -0,0 +1,43 @@ +;;; -*-Scheme-*- + +(require 'xlib) + +(define (lines) + (let* + ((dpy (open-display)) + (black (black-pixel dpy)) (white (white-pixel dpy)) + (win (create-window 'parent (display-root-window dpy) + 'width 400 'height 400 + 'background-pixel white + 'event-mask '(exposure button-press + enter-window leave-window))) + (gc (create-gcontext 'window win 'background white + 'foreground black)) + (draw + (lambda (inc) + (clear-window win) + (with win + (let ((width (window-width win)) + (height (window-height win))) + (do ((x 0 (+ x inc))) ((> x width)) + (draw-line win gc x 0 (- width x) height)) + (do ((y height (- y inc))) ((< y 0)) + (draw-line win gc 0 y width (- height y)))))))) + + (map-window win) + (unwind-protect + (handle-events dpy #t #f + (button-press + (lambda args #t)) + (expose + (lambda args + (draw 2) + #f)) + ((enter-notify leave-notify) + (lambda (e . args) + (set-window-border-pixel! win + (if (eq? e 'enter-notify) white black)) + #f))) + (close-display dpy)))) + +(lines) diff --git a/examples/xlib/map-all.scm b/examples/xlib/map-all.scm new file mode 100644 index 0000000..2e6a4e7 --- /dev/null +++ b/examples/xlib/map-all.scm @@ -0,0 +1,18 @@ +;;; -*-Scheme-*- +;;; +;;; Map all windows. + +(require 'xlib) + +(define (foreach-window root fun) + (let ((l (vector->list (car (query-tree root))))) + (for-each + (lambda (w) + (fun w) + (foreach-window w fun)) + l))) + +(let ((dpy (open-display))) + (unwind-protect + (foreach-window (display-root-window dpy) map-window) + (close-display dpy))) diff --git a/examples/xlib/picture.scm b/examples/xlib/picture.scm new file mode 100644 index 0000000..9b251af --- /dev/null +++ b/examples/xlib/picture.scm @@ -0,0 +1,72 @@ +;;; -*-Scheme-*- + +;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:T -*- + +;;; CLX - Point Graphing demo program + +;;; Copyright (C) 1988 Michael O. Newton (newton@csvax.caltech.edu) + +;;; Permission is granted to any individual or institution to use, copy, +;;; modify, and distribute this software, provided that this complete +;;; copyright and permission notice is maintained, intact, in all copies and +;;; supporting documentation. + +;;; The author provides this software "as is" without express or +;;; implied warranty. + +;;; This routine plots the recurrance +;;; x <- y(1+sin(0.7x)) - 1.2(|x|)^.5 +;;; y <- .21 - x +;;; As described in a ?? 1983 issue of the Mathematical Intelligencer +;;; It has ONLY been tested under X.V11R2 on a Sun3 running KCL + +(require 'xlib) + +(define (picture point-count) + (let* ((dpy (open-display)) + (width 600) + (height 600) + (black (black-pixel dpy)) + (white (white-pixel dpy)) + (root (display-root-window dpy)) + (win (create-window 'parent root 'background-pixel white + 'event-mask '(exposure button-press) + 'width width 'height height)) + (gc (create-gcontext 'window win + 'background white 'foreground black))) + (map-window win) + (unwind-protect + (handle-events dpy #t #f + (expose + (lambda ignore + (clear-window win) + (draw-points win gc point-count 0.0 0.0 (* width 0.5) (* height 0.5)) + (draw-poly-text win gc 10 10 (translate "Click a button to exit") + '1-byte) + #f)) + (else (lambda ignore #t))) + (close-display dpy)))) + +;;; Draw points. These should maybe be put into a an array so that they do +;;; not have to be recomputed on exposure. X assumes points are in the range +;;; of width x height, with 0,0 being upper left and 0,H being lower left. +;;; x <- y(1+sin(0.7x)) - 1.2(|x|)^.5 +;;; y <- .21 - x +;;; hw and hh are half-width and half-height of screen + +(define (draw-points win gc count x y hw hh) + (if (zero? (modulo count 100)) + (display-flush-output (window-display win))) + (if (not (zero? count)) + (let ((xf (floor (* (+ 1.2 x) hw ))) ; These lines center the picture + (yf (floor (* (+ 0.5 y) hh )))) + (draw-point win gc xf yf) + (draw-points win gc (1- count) + (- (* y (1+ (sin (* 0.7 x)))) (* 1.2 (sqrt (abs x)))) + (- 0.21 x) + hw hh)))) + +(define (translate string) + (list->vector (map char->integer (string->list string)))) + +(picture 10000) diff --git a/examples/xlib/poly.scm b/examples/xlib/poly.scm new file mode 100644 index 0000000..7022853 --- /dev/null +++ b/examples/xlib/poly.scm @@ -0,0 +1,35 @@ +;;; -*-Scheme-*- + +(require 'xlib) + +(define (poly) + (let* ((dpy (open-display)) + (black (black-pixel dpy)) (white (white-pixel dpy)) + (width 400) (height 400) + (win (create-window 'parent (display-root-window dpy) + 'width width 'height height + 'background-pixel white 'event-mask '(exposure))) + (gc (create-gcontext 'window win 'function 'xor + 'background white 'foreground black)) + (l '(#f #f #f)) + (rand (lambda (x) (modulo (random) x)))) + (map-window win) + (handle-events dpy #t #f + (else (lambda args + (set! width (window-width win)) + (set! height (window-height win)) #t))) + (unwind-protect + (let loop ((n 0)) + (if (= n 200) + (begin + (clear-window win) + (display-wait-output dpy #f) + (set! n 0))) + (fill-polygon win gc + (list->vector + (map (lambda (x) (cons (rand width) (rand height))) l)) + #f 'convex) + (loop (1+ n))) + (close-display dpy)))) + +(poly) diff --git a/examples/xlib/properties.scm b/examples/xlib/properties.scm new file mode 100644 index 0000000..e2d1a22 --- /dev/null +++ b/examples/xlib/properties.scm @@ -0,0 +1,45 @@ +;;; -*-Scheme-*- +;;; +;;; Display all properties of all windows (with name, type, format, +;;; and data). + +(require 'xlib) + +(define (properties) + + (define (tab obj n) + (let* ((s (format #f "~s" obj)) + (n (- n (string-length s)))) + (display s) + (if (positive? n) + (do ((i 0 (1+ i))) ((= i n)) (display #\space))))) + + (define (do-window w prop) + (format #t "Window ~s:~%" w) + (for-each + (lambda (p) + (tab (atom-name (window-display w) p) 20) + (display "= ") + (let ((p (get-property w p #f 0 20 #f))) + (tab (atom-name (window-display w) (car p)) 18) + (tab (cadr p) 3) + (format #t "~s~%" (caddr p)))) + (vector->list prop)) + (newline)) + + (define (do-children root) + (for-each + (lambda (w) + (do-window w (list-properties w)) + (do-children w)) + (vector->list (car (query-tree root))))) + + (let* ((dpy (open-display)) + (root (display-root-window dpy))) + (unwind-protect + (begin + (do-window root (list-properties root)) + (do-children root)) + (close-display dpy)))) + +(properties) diff --git a/examples/xlib/track.scm b/examples/xlib/track.scm new file mode 100644 index 0000000..34d3661 --- /dev/null +++ b/examples/xlib/track.scm @@ -0,0 +1,38 @@ +;;; -*-Scheme-*- + +(require 'xlib) + +(define (track) + (let* ((dpy (open-display)) + (root (display-root-window dpy)) + (gc (create-gcontext 'window root + 'function 'xor + 'foreground (black-pixel dpy) + 'subwindow-mode 'include-inferiors)) + (where (query-pointer root)) + (lx (car where)) (ly (cadr where)) (lw 300) (lh 300) + (move-outline + (lambda (x y) + (if (not (and (= x lx) (= y ly))) + (begin + (draw-rectangle root gc lx ly lw lh) + (draw-rectangle root gc x y lw lh) + (set! lx x) (set! ly y)))))) + (unwind-protect + (case (grab-pointer root #f '(pointer-motion button-press) + #f #f 'none 'none 'now) + (success + (with-server-grabbed dpy + (draw-rectangle root gc lx ly lw lh) + (display-flush-output dpy) + (handle-events dpy #t #f + (motion-notify + (lambda (event root win subwin time x y . rest) + (move-outline x y) #f)) + (else (lambda args #t))))) + (else + (format #t "Not grabbed!~%"))) + (draw-rectangle root gc lx ly lw lh) + (close-display dpy)))) + +(track) diff --git a/examples/xlib/useful.scm b/examples/xlib/useful.scm new file mode 100644 index 0000000..98cbaa7 --- /dev/null +++ b/examples/xlib/useful.scm @@ -0,0 +1,34 @@ +;;; -*-Scheme-*- + +(require 'xlib) + +(define dpy + (open-display)) + +(define (f) + (display-wait-output dpy #t)) + +(define root + (display-root-window dpy)) + +(define cmap + (display-colormap dpy)) + +(define white (white-pixel dpy)) +(define black (black-pixel dpy)) + +(define rgb-white (query-color cmap white)) +(define rgb-black (query-color cmap black)) + +(define win + (create-window + 'parent root + 'width 300 'height 300 + 'background-pixel white)) + +(define gc + (create-gcontext + 'window win + 'background white 'foreground black)) + +(map-window win) diff --git a/examples/xlib/wm-delete.scm b/examples/xlib/wm-delete.scm new file mode 100644 index 0000000..546ea7c --- /dev/null +++ b/examples/xlib/wm-delete.scm @@ -0,0 +1,23 @@ +;;; -*-Scheme-*- +;;; +;;; Demonstrate use of the WM_DELETE_WINDOW protocol. + +(require 'xlib) + +(let* ((dpy (open-display)) + (del-atom (intern-atom dpy 'WM_DELETE_WINDOW)) + (prot-atom (intern-atom dpy 'WM_PROTOCOLS)) + (win (create-window + 'parent (display-root-window dpy) + 'width 100 'height 100 + 'background-pixel (white-pixel dpy)))) + (set-wm-name! win '(fine)) + (set-wm-protocols! win (vector del-atom)) + (map-window win) + (unwind-protect + (handle-events dpy #t #f + (client-message + (lambda (event w type data) + (and (eq? type prot-atom) (vector? data) + (eq? (make-atom (vector-ref data 0)) del-atom))))) + (close-display dpy))) diff --git a/examples/xm/drawing-area.scm b/examples/xm/drawing-area.scm new file mode 100644 index 0000000..8672d93 --- /dev/null +++ b/examples/xm/drawing-area.scm @@ -0,0 +1,21 @@ +;;; -*-Scheme-*- +;;; +;;; Drawing area demo + +(require 'motif) +(load-widgets shell drawing-area) + +(define top (application-initialize 'drawing-area)) +(set-values! top 'width 300 'height 100) + +(define dr (create-managed-widget (find-class 'drawing-area) top + 'expose-callback (list (lambda r (format #t "expose: ~s~%" r))))) + +(set-values! dr 'resize-callback + (list (lambda r (format #t "resize: ~s~%" r)))) + +(add-callback dr 'input-callback + (lambda r (format #t "input: ~s~%" r))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xm/list.scm b/examples/xm/list.scm new file mode 100644 index 0000000..7ded4dc --- /dev/null +++ b/examples/xm/list.scm @@ -0,0 +1,97 @@ +;;; -*-Scheme-*- +;;; +;;; List widget demo (directory browser) for Motif + +(require 'motif) +(load-widgets shell form label push-button list) +(require 'unix) +(require 'sort 'qsort.scm) + +(define top (application-initialize 'list)) +(set-values! top 'allow-shell-resize #t) + +(define form (create-managed-widget (find-class 'form) top)) + +(define quit (create-managed-widget (find-class 'push-button) form)) +(set-values! quit 'left-attachment "ATTACH_FORM" + 'top-attachment "ATTACH_FORM" + 'width 50 + 'height 30 + 'border-width 1 + 'label-string "quit") + +(add-callback quit 'activate-callback (lambda x (destroy-widget top) + (exit))) + +(define back (create-managed-widget (find-class 'push-button) form)) +(set-values! back 'left-attachment "ATTACH_WIDGET" + 'left-widget quit + 'top-attachment "ATTACH_FORM" + 'width 50 + 'height 30 + 'border-width 1 + 'label-string "back") + +(add-callback back 'activate-callback (lambda x (goto ".."))) + +(define lab (create-managed-widget (find-class 'label) form)) +(set-values! lab 'border-width 0 + 'left-attachment "ATTACH_WIDGET" + 'left-widget back + 'top-attachment "ATTACH_FORM" + 'right-attachment "ATTACH_FORM" + 'right-offset 4 + 'top-offset 4 + 'height 30 + 'recompute-size #t) + +(define lst (create-managed-widget (find-class 'list) form )) +(set-values! lst 'left-attachment "ATTACH_FORM" + 'top-attachment "ATTACH_WIDGET" + 'top-widget quit + 'right-attachment "ATTACH_FORM" + 'bottom-attachment "ATTACH_FORM" + 'list-size-policy "VARIABLE" + 'list-margin-width 5 + 'selection-policy "BROWSE_SELECT") + +(add-callback lst 'browse-selection-callback + (lambda (w i) + (let ((type (stat-type (unix-stat (string-append + where "/" (car (last-pair i))))))) + (set-values! lab 'label-string type) + (if (eq? type 'directory) + (goto (car (last-pair i))))))) + +(define (goto dir) + (if (string=? dir "..") + (begin + (if (not (string=? where "/")) + (begin + (set! where + (substring where 0 + (do ((i (- (string-length where) 2) (1- i))) + ((char=? (string-ref where i) #\/) i)))) + (if (eqv? where "") + (set! where "/"))))) + (if (not (or (string=? dir "/") (string=? where "/"))) + (set! where (string-append where "/"))) + (set! where (string-append where dir))) + (set-values! lab 'label-string where) + (define l '()) + (for-each (lambda (d) (if (not (member d '("." ".."))) + (set! l (cons d l)))) + (unix-read-directory where)) + (if (null? l) + (set-values! lst 'items l 'item-count 0 'visible-item-count 1) + (set-values! lst 'items (sort l stringsymbol (string-append "dialog-" type))))) + (unless (car (get-values ok 'set)) + (unmanage-child (name->widget box 'OK))) + (unless (car (get-values cancel 'set)) + (unmanage-child (name->widget box 'Cancel))) + (unless (car (get-values help 'set)) + (unmanage-child (name->widget box 'Help))) + (manage-child box))) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xm/option-menu.scm b/examples/xm/option-menu.scm new file mode 100644 index 0000000..f32dfe0 --- /dev/null +++ b/examples/xm/option-menu.scm @@ -0,0 +1,34 @@ +;;; -*-Scheme-*- +;;; +;;; Option menu demo + +(require 'motif) +(load-widgets shell row-column cascade-button push-button label separator) +(load 'menu-stuff.scm) + +(define top (application-initialize 'option)) + +(define rc (create-managed-widget (find-class 'row-column) top)) +(set-values! rc 'orientation "horizontal") + +(define menu-1 (create-pulldown-menu rc)) + +(define b1 (menu-add-button! menu-1 'label-string "Option 1")) +(define b2 (menu-add-button! menu-1 'label-string "Option 2")) +(define b3 (menu-add-button! menu-1 'label-string "Option 3")) +(define b4 (menu-add-button! menu-1 'label-string "Option 4")) + +(define menu-2 (create-pulldown-menu rc)) + +(define ba (menu-add-button! menu-2 'label-string "Option A")) +(define bb (menu-add-button! menu-2 'label-string "Option B")) +(define bc (menu-add-button! menu-2 'label-string "Option C")) + +(create-option-menu rc 'sub-menu-id menu-1 'menu-history b3 + 'label-string "first option" 'mnemonic #\f) + +(create-option-menu rc 'sub-menu-id menu-2 'menu-history ba + 'label-string "second option" 'mnemonic #\s) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xm/popup-menu.scm b/examples/xm/popup-menu.scm new file mode 100644 index 0000000..136733a --- /dev/null +++ b/examples/xm/popup-menu.scm @@ -0,0 +1,30 @@ +;;; -*-Scheme-*- +;;; +;;; Popup menu demo + +(require 'motif) +(load-widgets shell row-column cascade-button push-button label separator + drawing-area) +(load 'menu-stuff.scm) + +(define top (application-initialize 'popup)) + +(define w (create-managed-widget (find-class 'drawing-area) top)) +(set-values! w 'width 350 'height 100) + +(define menu (create-popup-menu w 'which-button 1)) + +(menu-add-label! menu 'label-string "Popup menu" 'font-list "9x15") +(menu-add-separator! menu) +(menu-add-button! menu 'label-string "item 1") +(menu-add-button! menu 'label-string "item 2") +(menu-add-button! menu 'label-string "item 3") +(menu-add-separator! menu) +(define quit-button (menu-add-button! menu 'label-string "quit")) + +(add-callback quit-button 'activate-callback (lambda args (exit))) + +(popup-menu-attach-to! menu w) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xm/pulldown-menu.scm b/examples/xm/pulldown-menu.scm new file mode 100644 index 0000000..a74d414 --- /dev/null +++ b/examples/xm/pulldown-menu.scm @@ -0,0 +1,50 @@ +;;; -*-Scheme-*- +;;; +;;; Pulldown menu demo + +(require 'motif) +(load-widgets shell row-column cascade-button push-button label separator) +(load 'menu-stuff.scm) + +(define top (application-initialize 'pulldown)) + +(define menu-bar (create-menu-bar top)) + +;;; Create pulldown menu pane with 3 push buttons and a sub-menu + +(define menu-1 (create-pulldown-menu menu-bar)) + +(menu-add-button! menu-1 'label-string "item 1") +(menu-add-button! menu-1 'label-string "item 2") +(menu-add-button! menu-1 'label-string "item 3") +(menu-add-separator! menu-1) + +(create-cascade-pulldown menu-bar menu-1 'mnemonic #\m 'label-string "menu-1") + +;;; Create the sub-menu: + +(define sub-menu (create-pulldown-menu menu-1)) + +(menu-add-label! sub-menu 'label-string "sub-menu") +(menu-add-separator! sub-menu) +(menu-add-button! sub-menu 'label-string "item 1") +(menu-add-button! sub-menu 'label-string "item 2") +(menu-add-button! sub-menu 'label-string "item 3") + +(create-cascade-pulldown menu-1 sub-menu 'label-string "sub-menu") + +;;; Create second pulldown menu width a quit button) + +(define menu-2 (create-pulldown-menu menu-bar)) + +(menu-add-button! menu-2 'label-string "item 1") +(menu-add-button! menu-2 'label-string "item 2") +(menu-add-button! menu-2 'label-string "item 3" 'sensitive #f) +(menu-add-button! menu-2 'label-string "item 4") +(menu-add-button! menu-2 'label-string "quit" 'mnemonic #\q + 'activate-callback (list (lambda args (print args) (exit)))) + +(create-cascade-pulldown menu-bar menu-2 'label-string "menu-2") + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xm/radio-stuff.scm b/examples/xm/radio-stuff.scm new file mode 100644 index 0000000..636b7ff --- /dev/null +++ b/examples/xm/radio-stuff.scm @@ -0,0 +1,17 @@ +;;; -*-Scheme-*- +;;; +;;; Auxiliary definitions for button boxes + +(define (create-radio-box type parent . args) + (let ((box (create-managed-widget (find-class 'row-column) parent))) + (set-values! box 'packing "pack_column" 'orientation "horizontal" + 'is-homogeneous #t 'entry-class (find-class type) + 'radio-behavior #t 'radio-always-one #t) + (if args (apply set-values! box args)) + box)) + +(define (radio-box-add-button! box . args) + (let* ((type (car (get-values box 'entry-class))) + (button (create-managed-widget type box))) + (if args (apply set-values! button args)) + button)) diff --git a/examples/xm/radio.scm b/examples/xm/radio.scm new file mode 100644 index 0000000..9938309 --- /dev/null +++ b/examples/xm/radio.scm @@ -0,0 +1,73 @@ +;;; -*-Scheme-*- +;;; +;;; Radio box and button demo + +(require 'motif) +(load-widgets shell row-column arrow-button push-button toggle-button) +(load 'radio-stuff.scm) + +(define top (application-initialize 'radio)) + +(define rc (create-managed-widget (find-class 'row-column) top)) + + +;;; Create a button box containing arrow buttons; add callbacks +;;; to each button: + +(define box1 (create-radio-box 'arrow-button rc)) + +(define buttons1 + (map (lambda (dir) + (radio-box-add-button! box1 'width 50 'height 30 + 'arrow-direction dir)) + '(arrow_up arrow_down arrow_left arrow_right))) + +(for-each + (lambda (w) + (for-each + (lambda (cb) + (add-callback w cb + (lambda (w r) + (print (list w (car r)))))) + '(activate-callback arm-callback disarm-callback))) + buttons1) + +;;; Create a button box containing push buttons; define an +;;; entry callback: + +(define box2 (create-radio-box 'push-button rc)) + +(add-callback box2 'entry-callback + (lambda (w args) + (print (car (get-values (caddr args) 'label-string))))) + +(define buttons2 + (map (lambda (label) + (radio-box-add-button! box2 'label-string label + 'alignment "alignment_center")) + '(Play Stop Record Rewind Forward))) + + +;;; Create a button box containing toggle buttons; add a callback +;;; to each button: + +(define box3 (create-radio-box 'toggle-button rc)) + +(define buttons3 + (map (lambda (label) + (radio-box-add-button! box3 'label-string label)) + '(KMQX WMQY WHFX KWIT))) + +(for-each + (lambda (w) + (add-callback w 'value-changed-callback + (lambda r + (let ((station (car (get-values w 'label-string))) + (set? (car (get-values w 'set)))) + (print (list station set?)) + (if (and (string=? station "KWIT") set?) (exit)))))) + buttons3) + + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xm/scroll-bar.scm b/examples/xm/scroll-bar.scm new file mode 100644 index 0000000..515880e --- /dev/null +++ b/examples/xm/scroll-bar.scm @@ -0,0 +1,26 @@ +;;; -*-Scheme-*- +;;; +;;; Scroll bar demo + +(require 'motif) +(load-widgets shell scroll-bar) + +(define top (application-initialize 'scrollbar)) +(set-values! top 'allow-shell-resize #t) + +(define scr (create-managed-widget (find-class 'scroll-bar) top)) +(set-values! scr 'height 500) + +(define (f . r) (print r)) + +(add-callback scr 'decrement-callback f) +(add-callback scr 'increment-callback f) +(add-callback scr 'page-increment-callback f) +(add-callback scr 'page-decrement-callback f) +(add-callback scr 'drag-callback f) +(add-callback scr 'to-top-callback f) +(add-callback scr 'to-bottom-callback f) +(add-callback scr 'value-changed-callback f) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xm/selection-box.scm b/examples/xm/selection-box.scm new file mode 100644 index 0000000..c7e3fec --- /dev/null +++ b/examples/xm/selection-box.scm @@ -0,0 +1,36 @@ +;;; -*-Scheme-*- +;;; +;;; Selection box demo + +(require 'motif) +(load-widgets shell selection-box) + +(define top (application-initialize 'selection)) + +(define sb (create-managed-widget (find-class 'selection-box) top)) + +(define items + '(montana washington florida california texas new\ york alaska maryland + idaho virginia maine oregon illinois new\ jersey missouri louisiana)) + +(set-values! sb 'list-items items 'list-item-count (length items)) +(set-values! sb 'list-visible-item-count 6) + +(set-values! sb 'list-label-string "Available items:" 'must-match #t) +(set-values! sb 'label-font-list "8x13" 'button-font-list "9x15") + +(for-each + (lambda (c) + (add-callback sb c + (lambda r + (case (caadr r) + (no-match + (display #\007)) + (help + (display "No help available!") (newline))) + (print r)))) + '(apply-callback cancel-callback no-match-callback + ok-callback help-callback)) + +(realize-widget top) +(context-main-loop (widget-context top)) diff --git a/examples/xm/vcr.scm b/examples/xm/vcr.scm new file mode 100644 index 0000000..174791c --- /dev/null +++ b/examples/xm/vcr.scm @@ -0,0 +1,131 @@ +;;; -*-Scheme-*- +;;; +;;; VCR simulation + + +;; Initialization + +(require 'motif) +(load-widgets shell bulletin-board row-column label push-button) + +(define top (application-initialize 'vcr)) +(define con (widget-context top)) + + +;; The layout of the VCR's controls + +(define vcr (create-managed-widget (find-class 'row-column) top)) + +(define panel (create-managed-widget (find-class 'bulletin-board) vcr)) + +(define tape (create-managed-widget (find-class 'push-button) panel)) +(set-values! tape 'x 10 'y 10 'width 150 'border-width 2 'label-string 'empty + 'recompute-size #f + 'activate-callback (list (lambda _ (engine 'load)))) + +(define counter (create-managed-widget (find-class 'push-button) panel)) +(set-values! counter 'x 170 'y 10 'width 50 'label-string "0" + 'alignment "alignment_end" 'recompute-size #f) + +(define function (create-managed-widget (find-class 'push-button) panel)) +(set-values! function 'x 230 'y 10 'width 70 'label-string "stop" + 'recompute-size #f) + +(define buttons (create-managed-widget (find-class 'row-column) vcr)) +(set-values! buttons 'orientation 'horizontal) + +(define-macro (define-button label activate arm disarm) + `(let ((b (create-managed-widget (find-class 'push-button) buttons))) + (set-values! b 'label-string ,label) + (add-callback b 'activate-callback (lambda _ ,activate)) + (add-callback b 'arm-callback (lambda _ ,arm)) + (add-callback b 'disarm-callback (lambda _ ,disarm)))) + +(define-button 'eject (begin (engine 'stop) (engine 'empty)) #f #f) +(define-button 'play (engine 'play) #f #f) +(define-button 'stop (engine 'stop) #f #f) +(define-button 'forw (engine 'forw) (engine 'cue #t) (engine 'cue #f)) +(define-button 'rew (engine 'rew) (engine 'review #t) (engine 'review #f)) +(define-button 'pause (engine 'pause) #f #f) + + +;; The `logic' of the VCR + +(define engine + (let ((timer #f) (interval) (loaded #f) (cnt 0) (state 'stop)) + + (define (advance x) + (set! cnt (modulo (+ cnt x) 10000000)) + (set-values! counter 'label-string (format #f "~s" cnt))) + + (define (timeout x) + (advance x) + (set! timer (context-add-timeout con interval (lambda _ (timeout x))))) + + (define (set-timer when x) + (stop-timer) + (set! interval when) + (set! timer (context-add-timeout con when (lambda _ (timeout x))))) + + (define (stop-timer) + (if timer (remove-timeout timer)) + (set! timer #f)) + + (define (cue/review on? x) + (if on? + (if (not (eq? state 'play)) ; do nothing if not playing + state + (set-timer 100 x) ; else + 'cue/review) + (if (not (eq? state 'cue/review)) ; do nothing if not in cue/review + state ; mode + (set-timer 1000 100) ; else switch back to play mode + 'play))) + + (lambda (op . args) + (call-with-current-continuation + (lambda (return) + (case op + (load + (set-values! tape 'label-string 'loaded) + (set! loaded #t)) + (empty + (set-values! tape 'label-string 'empty) + (set! loaded #f)) + (else + (if (not loaded) + (return #f)) + (case op + (stop + (stop-timer)) + (cue (set! op (cue/review (car args) 100))) + (review (set! op (cue/review (car args) -100))) + (pause + (cond ((eq? state 'pause) + (set-timer 1000 100) + (set! op 'play)) + ((eq? state 'play) + (stop-timer)) + (else + (return #f)))) + (forw + (cond ((eq? state 'pause) + (advance 4) + (set! op 'pause)) ; stay in pause mode + ((not (eq? state 'cue/review)) + (set-timer 1000 10000)) + (else (set! op state)))) ; stay in the old mode + (rew + (cond ((eq? state 'pause) + (advance -4) + (set! op 'pause)) + ((not (eq? state 'cue/review)) + (set-timer 1000 -10000)) + (else (set! op state)))) + (play + (set-timer 1000 100))) + (set! state op) + (set-values! function 'label-string op)))))))) + +(realize-widget top) +(context-main-loop con) diff --git a/include/Makefile b/include/Makefile new file mode 100644 index 0000000..e61d7f4 --- /dev/null +++ b/include/Makefile @@ -0,0 +1,23 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../config/system ../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + $(MAKE) -f Makefile.local localize + +lint: + +clean: + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/include/build b/include/build new file mode 100755 index 0000000..9a6727a --- /dev/null +++ b/include/build @@ -0,0 +1,42 @@ +. ../config/system +. ../config/site + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +FILES= compat.h\\ + config.h\\ + cstring.h\\ + exception.h\\ + extern.h\\ + funcproto.h\\ + gc.h\\ + misc.h\\ + object.h\\ + param.h\\ + scheme.h\\ + stkmem.h\\ + type.h + +config.h: ../config/system ../config/site + \$(SHELL) ./build-config + +install: \$(FILES) + -@if [ ! -d $install_dir/include ]; then \\ + echo mkdir $install_dir/include; \\ + mkdir $install_dir/include; \\ + fi + @for i in \$(FILES) ;\\ + do \\ + echo cp \$\$i $install_dir/include; \\ + cp \$\$i $install_dir/include; \\ + done + +localize: config.h + +distclean: + rm -f Makefile.local config.h +EOT diff --git a/include/build-config b/include/build-config new file mode 100755 index 0000000..34dbe47 --- /dev/null +++ b/include/build-config @@ -0,0 +1,344 @@ +. ../config/system +. ../config/site + +case "$system" in +*-*-*) ;; +*) echo Error in config file: + echo Badly formed system identification: "$system"; exit 1;; +esac + +def_vfork=undef +def_vprintf=undef +def_dirent=undef +def_atexit=undef +def_syms_underl=undef +def_random=undef +def_include_unistd_h=undef +def_sysconf_open_max=undef +def_getdtablesize=undef +def_pathconf_path_max=undef +def_getpagesize=undef +def_sysconf_pagesize=undef +def_bsd_signals=undef +def_posix_signals=undef +def_align_8byte=undef +def_can_dump=undef +def_fchmod_broken=undef +def_termio=undef +def_flush_bsd=undef +def_flush_fpurge=undef +def_flush_tiocflush=undef +def_flush_tcflsh=undef +def_use_alloca=undef +def_include_alloca_h=undef +def_pragma_alloca=undef +def_coff=undef +def_ecoff=undef +def_xcoff=undef +def_elf=undef +def_macho=undef +def_convex=undef +def_hp9k=undef +def_hp_shared_libs=undef +def_debug_dump=undef +def_use_ld=undef +def_use_rld=undef +def_use_shl=undef +def_use_dlopen=undef +def_max_stack_size=undef +def_mprotect=undef +def_mprotect_mmap=undef +def_want_proto=undef +def_no_proto=undef +def_generational_gc=undef +def_cachectl_h=undef +def_syms_begin_with=undef +def_ansi_cpp=undef +def_can_load_obj=undef +def_sigsegv_siginfo=undef +def_sigsegv_sigcontext=undef +def_sigsegv_arg4=undef +def_sigsegv_aix=undef +def_sigsegv_hpux=undef +def_gettimeofday=undef +def_ftime=undef +def_gethostname=undef +def_uname=undef +def_mktemp=undef +def_tmpnam=undef +def_tempnam=undef +def_getcwd=undef +def_getwd=undef +def_rename=undef +def_waitpid=undef +def_wait3=undef +def_wait4=undef +def_fionread_h=undef +def_utime_h=undef +def_regcomp=undef + +if [ _$regcomp = _yes ]; then def_regcomp=define; fi +if [ _$utime_h = _yes ]; then def_utime_h=define; fi +if [ _$fionread_include != _ ]; then def_fionread_h=define; fi +if [ _$wait4 = _yes ]; then def_wait4=define; fi +if [ _$wait3 = _yes ]; then def_wait3=define; fi +if [ _$waitpid = _yes ]; then def_waitpid=define; fi +if [ _$rename = _yes ]; then def_rename=define; fi +if [ _$getwd = _yes ]; then def_getwd=define; fi +if [ _$getcwd = _yes ]; then def_getcwd=define; fi +if [ _$tempnam = _yes ]; then def_tempnam=define; fi +if [ _$tmpnam = _yes ]; then def_tmpnam=define; fi +if [ _$mktemp = _yes ]; then def_mktemp=define; fi +if [ _$uname = _yes ]; then def_uname=define; fi +if [ _$gethostname = _yes ]; then def_gethostname=define; fi +if [ _$gettimeofday = _yes ]; then def_gettimeofday=define; fi +if [ _$ftime = _yes ]; then def_ftime=define; fi +if [ _$vfork = _yes ]; then def_vfork=define; fi +if [ _$vprintf = _yes ]; then def_vprintf=define; fi +if [ _$dirent = _yes ]; then def_dirent=define; fi +if [ _$atexit = _yes ]; then def_atexit=define; fi +if [ _$syms_with_underline = _yes ]; + then def_syms_underl=define; fi +if [ _$random = _yes ]; then def_random=define; fi +if [ _$include_unistd_h = _yes ]; then def_include_unistd_h=define; fi +if [ _$sysconf_open_max = _yes ]; then def_sysconf=define; fi +if [ _$getdtablesize = _yes ]; then def_getdtablesize=define; fi +if [ _$pathconf_path_max = _yes ];then def_pathconf_path_max=define;fi +if [ _$getpagesize = _yes ]; then def_getpagesize=define; fi +if [ _$sysconf_pagesize = _yes ]; then def_sysconf_pagesize=define; fi +if [ _$align_8byte = _yes ]; then def_align_8byte=define; fi +if [ _$can_dump = _yes ]; then def_can_dump=define; fi +if [ _$fchmod_broken = _yes ]; then def_fchmod_broken=define; fi +if [ _$termio = _yes ]; then def_termio=define; fi +if [ _$use_alloca = _yes ]; then def_use_alloca=define; fi +if [ _$include_alloca_h = _yes ]; then def_include_alloca_h=define; fi +if [ _$pragma_alloca = _yes ]; then def_pragma_alloca=define; fi +if [ _$max_stack_size != _ ]; then def_max_stack_size=define; fi +if [ _$generational_gc = _yes ]; then def_generational_gc=define; fi +if [ _$cachectl_h != _ ]; then def_cachectl_h=define; fi +if [ _$ansi_cpp = _yes ]; then def_ansi_cpp=define; fi +if [ _$hp_shared_libraries = _yes ]; + then def_hp_shared_libs=define; fi +if [ _$debug_dump = _yes ]; then def_debug_dump=define; fi +if [ _$syms_begin_with != _ ]; then + def_syms_begin_with=define + syms_begin_char=\'$syms_begin_with\' +fi +if [ _$mprotect = _yes ]; then def_mprotect=define; fi +if [ _$mprotect = _mmap ]; then + def_mprotect=define; + def_mprotect_mmap=define; +fi +if [ $def_getpagesize = undef -a $def_sysconf_pagesize = undef ]; then + if [ $def_mprotect = define ]; then + echo Error in config file: + echo mprotect requires getpagesize or sysconf_pagesize; exit 1 + fi +fi +if [ _$index != _yes ]; then + def_index="#define index strchr" +fi +if [ _$bstring != _yes ]; then + def_bcopy="#define bcopy(from,to,len) memcpy(to,from,len)" + def_bzero="#define bzero(p,len) memset(p,0,len)" + def_bcmp="#define bcmp memcmp" +fi + +case _$reliable_signals in +_bsd) def_bsd_signals=define;; +_posix) def_posix_signals=define;; +esac + +case _$prototypes in +_yes) def_want_proto=define;; +_no) def_no_proto=define;; +esac + +case _$aout_format in +_coff) def_coff=define;; +_ecoff) def_ecoff=define;; +_xcoff) def_xcoff=define;; +_elf) def_elf=define;; +_macho) def_macho=define;; +_hp9k) def_hp9k=define;; +_convex) def_convex=define;; +esac + +case _$load_obj in +_ld) def_use_ld=define; def_can_load_obj=define;; +_rld) def_use_rld=define; def_can_load_obj=define;; +_shl) def_use_shl=define; def_can_load_obj=define;; +_dl) def_use_dlopen=define; def_can_load_obj=define;; +_) ;; +*) echo Error in config file: + echo Invalid value for symbol load_obj: $load_obj; exit 1;; +esac + +case _$flush_stdio in +_bsd) def_flush_bsd=define;; +_fpurge) def_flush_fpurge=define;; +_) ;; +*) echo Error in config file: + echo Invalid value for symbol flush_stdio: $flush_stdio; exit 1;; +esac + +case _$flush_tty in +_tiocflush) def_flush_tiocflush=define;; +_tcflsh) def_flush_tcflsh=define;; +_) ;; +*) echo Error in config file: + echo Invalid value for symbol flush_tty: $flush_tty; exit 1;; +esac + +case _$sigsegv_addr in +_siginfo) def_sigsegv_siginfo=define;; +_sigcontext) def_sigsegv_sigcontext=define;; +_arg4) def_sigsegv_arg4=define;; +_aix) def_sigsegv_aix=define;; +_hpux) def_sigsegv_hpux=define;; +_) if [ $def_mprotect = define ]; then + echo Error in config file: + echo Must specify value for sigsegv_addr if mprotect=yes + exit 1 + fi;; +*) echo Error in config file: + echo Invalid value for symbol sigsegv_addr: $sigsegv_addr + exit 1;; +esac + +if [ _$load_obj = _ld -a "_$load_libraries" = _ ]; then + load_libraries=-lc +fi + +if [ _$getgroups_type = _ ]; then + echo Error in config file: + echo Must specify a value for symbol getgroups_type + exit 1 +fi + +if [ -f $install_dir/include/build ]; then + echo Error in config file: + echo You cannot install Elk into the top of the source tree. + echo 'Choose a different directory for $install_dir in config/site' + echo '(e.g. a subdirectory or a directory outside the source tree).' + exit 1 +fi + +if [ _$init_prefix != _elk_init_ -o _$finit_prefix != _elk_finit_ ]; then + echo "****" Warning: + echo "****" Changing init_prefix or finit_prefix in your configuration + echo "****" requires you to modify all standard extensions accordingly + echo "****" and restricts portability of newly written extension. +fi + +rel=`../util/getversion ../README` +IFS=. +set $rel +major=$1 +minor=$2 +IFS= + + +echo Building config.h... +cat <config.h +/* This file was produced by the Makefile in this directory. + * If you want to change the value of a constant, edit ../config/system + * or ../config/site and run make again. + */ + +#$def_regcomp REGCOMP +#$def_waitpid WAITPID +#$def_wait3 WAIT3 +#$def_wait4 WAIT4 +#$def_mktemp MKTEMP +#$def_tmpnam TMPNAM +#$def_tempnam TEMPNAM +#$def_getcwd GETCWD +#$def_getwd GETWD +#$def_rename RENAME +#$def_uname UNAME +#$def_gethostname GETHOSTNAME +#$def_gettimeofday GETTIMEOFDAY +#$def_ftime FTIME +#$def_vfork VFORK +#$def_vprintf VPRINTF +#$def_dirent DIRENT +#$def_random RANDOM +#$def_include_unistd_h INCLUDE_UNISTD_H +#$def_sysconf_open_max SYSCONF_OPEN_MAX +#$def_getdtablesize GETDTABLESIZE +#$def_pathconf_path_max PATHCONF_PATH_MAX +#$def_getpagesize GETPAGESIZE +#$def_sysconf_pagesize SYSCONF_PAGESIZE +#$def_bsd_signals BSD_SIGNALS +#$def_posix_signals POSIX_SIGNALS +#$def_align_8byte ALIGN_8BYTE +#$def_coff COFF +#$def_ecoff ECOFF +#$def_xcoff XCOFF +#$def_elf ELF +#$def_macho MACH_O +#$def_convex CONVEX_AOUT +#$def_hp9k HP9K +#$def_hp_shared_libs HPSHLIB +#$def_debug_dump DEBUG_DUMP +#$def_can_load_obj CAN_LOAD_OBJ +#$def_use_ld USE_LD +#$def_use_rld USE_RLD +#$def_use_shl USE_SHL +#$def_use_dlopen USE_DLOPEN +# define LOAD_LIBRARIES "${load_libraries}" +#$def_cachectl_h CACHECTL_H $cachectl_h +#$def_fionread_h FIONREAD_H $fionread_include +# $def_atexit ATEXIT +#$def_syms_begin_with SYMS_BEGIN_WITH $syms_begin_char +#$def_can_dump CAN_DUMP +# define SEG_SIZ ${segment_size-unused} +# define FILE_TEXT_START ${file_text_start-unused} +# define MEM_TEXT_START ${mem_text_start-unused} +# define TEXT_LENGTH_ADJ ${text_length_adj-unused} +# define COFF_PAGESIZE ${coff_pagesize-unused} +# $def_fchmod_broken FCHMOD_BROKEN +#$def_termio TERMIO +#$def_flush_bsd FLUSH_BSD +#$def_flush_fpurge FLUSH_FPURGE +#$def_flush_tiocflush FLUSH_TIOCFLUSH +#$def_flush_tcflsh FLUSH_TCFLSH +#$def_use_alloca USE_ALLOCA +#$def_include_alloca_h INCLUDE_ALLOCA_H +#$def_pragma_alloca PRAGMA_ALLOCA +#$def_max_stack_size MAX_STACK_SIZE $max_stack_size +#$def_generational_gc GENERATIONAL_GC +#$def_mprotect HAS_MPROTECT +#$def_mprotect_mmap MPROTECT_MMAP +#$def_sigsegv_siginfo SIGSEGV_SIGINFO +#$def_sigsegv_sigcontext SIGSEGV_SIGCONTEXT +#$def_sigsegv_arg4 SIGSEGV_ARG4 +#$def_sigsegv_aix SIGSEGV_AIX +#$def_sigsegv_hpux SIGSEGV_HPUX +$def_index +$def_bcopy +$def_bzero +$def_bcmp +#define AOUT_H $aout_h +#define SCM_DIR "$install_dir/runtime/scm" +#define OBJ_DIR "$install_dir/runtime/obj" +#define HEAP_SIZE $default_heap_size +#define FIND_AOUT defined(USE_LD) || defined(CAN_DUMP)\\ + || defined(INIT_OBJECTS) +#if !defined(WANT_PROTOTYPES) && !defined(NO_PROTOTYPES) +# $def_want_proto WANT_PROTOTYPES +# $def_no_proto NO_PROTOTYPES +#endif +#$def_ansi_cpp ANSI_CPP +#define SYSTEMTYPE "$system" +#define GETGROUPS_TYPE $getgroups_type +#define LD_NAME "$ld" +#define LDFLAGS_SHARED "$ldflags_shared" +#define INC_LDFLAGS "$incremental_ldflags" +#$def_utime_h UTIME_H +#define INIT_PREFIX "$init_prefix" +#define FINIT_PREFIX "$finit_prefix" +#define ELK_MAJOR $major +#define ELK_MINOR $minor +EOT diff --git a/include/compat.h b/include/compat.h new file mode 100644 index 0000000..7946e29 --- /dev/null +++ b/include/compat.h @@ -0,0 +1,56 @@ +/* Definitions that were used in older versions of Elk, but are now + * obsolete and should not be used any longer. + */ + +#define Declare_C_Strings Alloca_Begin +#define Make_C_String Get_Strsym_Stack +#define Dispose_C_Strings Alloca_End + +#define Val(x) Cdr(x) + +#define FIXNUM_FITS_UNSIGNED UFIXNUM_FITS +#define SETFAST(x,y) ((x) = (y)) + +#define Make_Fixnum Make_Integer + +/* The names of a few functions implementing primitives have been changed + * for consistency: + */ +#define P_Setcar P_Set_Car +#define P_Setcdr P_Set_Cdr +#define P_With_Input P_With_Input_From_File +#define P_With_Output P_With_Output_To_File +#define P_Call_With_Input P_Call_With_Input_File +#define P_Call_With_Output P_Call_With_Output_File +#define P_Call_CC P_Call_With_Current_Continuation +#define P_Promise_Env P_Promise_Environment +#define P_Procedure_Env P_Procedure_Environment +#define P_Control_Point_Env P_Control_Point_Environment +#define P_Curr_Input_Port P_Current_Input_Port +#define P_Curr_Output_Port P_Current_Output_Port +#define P_Env_List P_Environment_To_List +#define P_Char_Lower_Case P_Char_Lower_Casep +#define P_Char_Upper_Case P_Char_Upper_Casep +#define P_Char_Alphabetic P_Char_Alphabeticp +#define P_Char_Numeric P_Char_Numericp +#define P_Char_Whitespace P_Char_Whitespacep +#define P_Chr_Eq P_Char_Eq +#define P_Chr_Less P_Char_Less +#define P_Chr_Greater P_Char_Greater +#define P_Chr_Eq_Less P_Char_Eq_Less +#define P_Chr_Eq_Greater P_Char_Eq_Greater +#define P_Chr_CI_Eq P_Char_CI_Eq +#define P_Chr_CI_Less P_Char_CI_Less +#define P_Chr_CI_Greater P_Char_CI_Greater +#define P_Chr_CI_Eq_Less P_Char_CI_Eq_Less +#define P_Chr_CI_Eq_Greater P_Char_CI_Eq_Greater +#define P_Str_Eq P_String_Eq +#define P_Str_Less P_String_Less +#define P_Str_Greater P_String_Greater +#define P_Str_Eq_Less P_String_Eq_Less +#define P_Str_Eq_Greater P_String_Eq_Greater +#define P_Str_CI_Eq P_String_CI_Eq +#define P_Str_CI_Less P_String_CI_Less +#define P_Str_CI_Greater P_String_CI_Greater +#define P_Str_CI_Eq_Less P_String_CI_Eq_Less +#define P_Str_CI_Eq_Greater P_String_CI_Eq_Greater diff --git a/include/cstring.h b/include/cstring.h new file mode 100644 index 0000000..28e1cb1 --- /dev/null +++ b/include/cstring.h @@ -0,0 +1,23 @@ +/* These must be defined as macros, because they use Alloca(). + */ + +#define Get_String_Stack(_from,_to) {\ + int _len;\ + Check_Type(_from, T_String);\ + _len = STRING(_from)->size;\ + Alloca ((_to), char*, _len+1);\ + bcopy (STRING(_from)->data, (_to), _len);\ + (_to)[_len] = '\0';\ +} + +#define Get_Strsym_Stack(_from,_to) {\ + int _len;\ + if (TYPE(_from) == T_Symbol)\ + (_from) = SYMBOL(_from)->name;\ + else if (TYPE(_from) != T_String)\ + Wrong_Type_Combination ((_from), "string or symbol");\ + _len = STRING(_from)->size;\ + Alloca ((_to), char*, _len+1);\ + bcopy (STRING(_from)->data, (_to), _len);\ + (_to)[_len] = '\0';\ +} diff --git a/include/exception.h b/include/exception.h new file mode 100644 index 0000000..82369c1 --- /dev/null +++ b/include/exception.h @@ -0,0 +1,47 @@ +extern int Intr_Was_Ignored; +extern unsigned long Intr_Level; + +#ifdef POSIX_SIGNALS + extern sigset_t Sigset_Old, Sigset_Block; +#else +#ifdef BSD_SIGNALS + extern int Sigmask_Old, Sigmask_Block; +#else + C_LINKAGE_BEGIN + extern void Intr_Handler P_((int)); + C_LINKAGE_END +#endif +#endif + +#ifdef BSD_SIGNALS +# ifndef sigmask +# define sigmask(n) (1 << ((n)-1)) +# endif +#endif + +#define Disable_Interrupts {\ + if (Intr_Level++ == 0) Force_Disable_Interrupts;\ +} + +#define Enable_Interrupts {\ + if (Intr_Level > 0 && --Intr_Level == 0) Force_Enable_Interrupts;\ +} + +#ifdef BSD_SIGNALS +#define Force_Disable_Interrupts (void)sigblock (Sigmask_Block) +#define Force_Enable_Interrupts (void)sigsetmask (Sigmask_Old) +#else +#ifdef POSIX_SIGNALS +#define Force_Disable_Interrupts (void)sigprocmask (SIG_BLOCK, &Sigset_Block,\ + (sigset_t *)0) +#define Force_Enable_Interrupts (void)sigprocmask (SIG_SETMASK, &Sigset_Old,\ + (sigset_t *)0) +#else +#define Force_Disable_Interrupts {\ + if (!Intr_Was_Ignored) (void)signal (SIGINT, SIG_IGN);\ +} +#define Force_Enable_Interrupts {\ + if (!Intr_Was_Ignored) (void)signal (SIGINT, Intr_Handler);\ +} +#endif +#endif diff --git a/include/extern.h b/include/extern.h new file mode 100644 index 0000000..cbf95ab --- /dev/null +++ b/include/extern.h @@ -0,0 +1,466 @@ +/* This include file declares all symbols exported by the interpreter + * kernel that may be used by applications or extensions. + */ + +C_LINKAGE_BEGIN + +/* Autoloading + */ +extern Object P_Autoload P_((Object, Object)); + +/* Bignums + */ +extern Object Make_Uninitialized_Bignum P_((int)); +extern Bignum_Normalize_In_Place P_((struct S_Bignum *)); + +/* Boolean operators + */ +extern Object P_Booleanp P_((Object)); +extern Object P_Not P_((Object)); +extern Object P_Eq P_((Object, Object)); +extern Object P_Eqv P_((Object, Object)); +extern Object P_Equal P_((Object, Object)); +extern Object P_Empty_List_Is_False P_((Object)); +extern int Eqv P_((Object, Object)); +extern int Equal P_((Object, Object)); + +/* Characters + */ +extern Object Make_Char P_((int)); +extern Object P_Charp P_((Object)); +extern Object P_Char_Upcase P_((Object)); +extern Object P_Char_Downcase P_((Object)); +extern Object P_Char_Eq P_((Object, Object)); +extern Object P_Char_Less P_((Object, Object)); +extern Object P_Char_Greater P_((Object, Object)); +extern Object P_Char_Eq_Less P_((Object, Object)); +extern Object P_Char_Eq_Greater P_((Object, Object)); +extern Object P_Char_CI_Eq P_((Object, Object)); +extern Object P_Char_CI_Less P_((Object, Object)); +extern Object P_Char_CI_Greater P_((Object, Object)); +extern Object P_Char_CI_Eq_Less P_((Object, Object)); +extern Object P_Char_CI_Eq_Greater P_((Object, Object)); +extern Object P_Char_Upper_Casep P_((Object)); +extern Object P_Char_Lower_Casep P_((Object)); +extern Object P_Char_Alphabeticp P_((Object)); +extern Object P_Char_Numericp P_((Object)); +extern Object P_Char_Whitespacep P_((Object)); +extern Object P_Char_To_Integer P_((Object)); +extern Object P_Integer_To_Char P_((Object)); + +/* Continuations + */ +extern Object P_Call_With_Current_Continuation P_((Object)); +extern Object P_Dynamic_Wind P_((Object, Object, Object)); +extern Object P_Control_Pointp P_((Object)); +extern Object P_Control_Point_Environment P_((Object)); + +/* Scheme strings --> C Strings + */ +extern char *Get_String P_((Object)); +extern char *Get_Strsym P_((Object)); + +/* Debugging + */ +extern Object P_Backtrace_List P_((int, Object*)); + +/* Dump + */ +extern Object P_Dump P_((Object)); + +/* Lexical bindings, environments + */ +extern Object P_The_Environment P_((void)); +extern Object P_Define P_((Object)); +extern Object P_Set P_((Object)); +extern Object P_Environment_To_List P_((Object)); +extern Object P_Define_Macro P_((Object)); +extern Object P_Boundp P_((Object)); +extern Object P_Global_Environment P_((void)); +extern Object P_Environmentp P_((Object)); +extern Object The_Environment, Global_Environment; + +/* Error handling + */ +extern Primitive_Error P_((ELLIPSIS)); +extern Fatal_Error P_((ELLIPSIS)); +extern Range_Error P_((Object)); +extern Panic P_((const char*)); +extern Object P_Error P_((int, Object*)); +extern Object P_Reset P_((void)); +extern const char *Error_Tag; /* will be removed in the near future */ +extern const char *Get_Error_Tag P_((void)); +extern void Set_Error_Tag P_((const char *)); +extern void Set_App_Name P_((char *)); + +/* Interrupts + */ +extern Object P_Disable_Interrupts P_((void)); +extern Object P_Enable_Interrupts P_((void)); +extern void Signal_Exit P_((int)); + +/* Features + */ +extern Object P_Features P_((void)); +extern Object P_Featurep P_((Object)); +extern Object P_Provide P_((Object)); +extern Object P_Require P_((int, Object*)); + +/* Memory allocation, garbage collection + */ +extern int GC_Debug; +extern Object Alloc_Object P_((int, int, int)); +extern Register_Before_GC P_((void (*)(void))); +extern Register_After_GC P_((void (*)(void))); +extern Object P_Collect P_((void)); +extern Object P_Garbage_Collect_Status P_((int, Object *)); +#ifdef GENERATIONAL_GC + extern Object P_Collect_Incremental P_((void)); +#endif + +/* Files and ports + */ +extern Object Curr_Input_Port, Curr_Output_Port; +extern Object Standard_Input_Port, Standard_Output_Port; +extern Reset_IO P_((int)); +extern Object P_Current_Input_Port P_((void)); +extern Object P_Current_Output_Port P_((void)); +extern Object P_Input_Portp P_((Object)); +extern Object P_Output_Portp P_((Object)); +extern Object P_Open_Input_File P_((Object)); +extern Object P_Open_Output_File P_((Object)); +extern Object P_Open_Input_Output_File P_((Object)); +extern Object P_Eof_Objectp P_((Object)); +extern Object P_With_Input_From_File P_((Object, Object)); +extern Object P_With_Output_To_File P_((Object, Object)); +extern Object P_Call_With_Input_File P_((Object, Object)); +extern Object P_Call_With_Output_File P_((Object, Object)); +extern Object P_Open_Input_String P_((Object)); +extern Object P_Open_Output_String P_((void)); +extern Object P_Port_File_Name P_((Object)); +extern Object P_Tilde_Expand P_((Object)); +extern Object P_File_Existsp P_((Object)); +extern Object P_Close_Input_Port P_((Object)); +extern Object P_Close_Output_Port P_((Object)); +extern Object P_Port_Line_Number P_((Object)); +extern Object Terminate_File P_((Object)); +extern Object Make_Port P_((int, FILE*, Object)); +extern int Path_Max P_((void)); + +/* Loading of files + */ +extern Object P_Load P_((int, Object*)); +extern void Load_Source_Port P_((Object)); +extern void Load_File P_((char *)); + +/* Pairs and lists + */ +extern Object P_Cons P_((Object, Object)); +extern Object P_Car P_((Object)); +extern Object P_Cdr P_((Object)); +extern Object P_Set_Car P_((Object, Object)); +extern Object P_Set_Cdr P_((Object, Object)); +extern Object P_Listp P_((Object)); +extern Object P_List P_((int, Object*)); +extern Object P_Length P_((Object)); +extern Object P_Nullp P_((Object)); +extern Object P_Pairp P_((Object)); +extern Object P_Cxr P_((Object, Object)); +extern Object P_Cddr P_((Object)); +extern Object P_Cdar P_((Object)); +extern Object P_Cadr P_((Object)); +extern Object P_Caar P_((Object)); +extern Object P_Cdddr P_((Object)); +extern Object P_Cddar P_((Object)); +extern Object P_Cdadr P_((Object)); +extern Object P_Cdaar P_((Object)); +extern Object P_Caddr P_((Object)); +extern Object P_Cadar P_((Object)); +extern Object P_Caadr P_((Object)); +extern Object P_Caaar P_((Object)); +extern Object P_Caaaar P_((Object)); +extern Object P_Caaadr P_((Object)); +extern Object P_Caadar P_((Object)); +extern Object P_Caaddr P_((Object)); +extern Object P_Cadaar P_((Object)); +extern Object P_Cadadr P_((Object)); +extern Object P_Caddar P_((Object)); +extern Object P_Cadddr P_((Object)); +extern Object P_Cdaaar P_((Object)); +extern Object P_Cdaadr P_((Object)); +extern Object P_Cdadar P_((Object)); +extern Object P_Cdaddr P_((Object)); +extern Object P_Cddaar P_((Object)); +extern Object P_Cddadr P_((Object)); +extern Object P_Cdddar P_((Object)); +extern Object P_Cddddr P_((Object)); +extern Object P_Append P_((int, Object*)); +extern Object P_Append_Set P_((int, Object*)); +extern Object P_Last_Pair P_((Object)); +extern Object P_Reverse P_((Object)); +extern Object P_Reverse_Set P_((Object)); +extern Object P_List_Tail P_((Object, Object)); +extern Object P_List_Ref P_((Object, Object)); +extern Object P_Assq P_((Object, Object)); +extern Object P_Assv P_((Object, Object)); +extern Object P_Assoc P_((Object, Object)); +extern Object P_Memq P_((Object, Object)); +extern Object P_Memv P_((Object, Object)); +extern Object P_Member P_((Object, Object)); +extern Object P_Make_List P_((Object, Object)); +extern Object Copy_List P_((Object)); +extern int Fast_Length P_((Object)); +extern Object Const_Cons P_((Object, Object)); + +/* Startup and termination + */ +extern Object P_Command_Line_Args P_((void)); +extern Object P_Exit P_((int, Object*)); +extern void Elk_Init P_((int, char **av, int, char *)); + +/* malloc() and realloc() + */ +extern char *Safe_Malloc P_((unsigned)); +extern char *Safe_Realloc P_((char*, unsigned)); + +/* Numbers + */ +extern Object Make_Integer P_((int)); +extern Object Make_Unsigned P_((unsigned)); +extern Object Make_Long P_((long)); +extern Object Make_Unsigned_Long P_((unsigned long)); +extern Object Make_Reduced_Flonum P_((double)); +extern Object Make_Flonum P_((double)); +extern Object P_Numberp P_((Object)); +extern Object P_Complexp P_((Object)); +extern Object P_Realp P_((Object)); +extern Object P_Rationalp P_((Object)); +extern Object P_Integerp P_((Object)); +extern Object P_Abs P_((Object)); +extern Object P_Zerop P_((Object)); +extern Object P_Positivep P_((Object)); +extern Object P_Negativep P_((Object)); +extern Object P_Oddp P_((Object)); +extern Object P_Evenp P_((Object)); +extern Object P_Exactp P_((Object)); +extern Object P_Inexactp P_((Object)); +extern Object P_Exact_To_Inexact P_((Object)); +extern Object P_Inexact_To_Exact P_((Object)); +extern Object P_Inc P_((Object)); +extern Object P_Dec P_((Object)); +extern Object P_Generic_Equal P_((int, Object*)); +extern Object P_Generic_Less P_((int, Object*)); +extern Object P_Generic_Greater P_((int, Object*)); +extern Object P_Generic_Eq_Less P_((int, Object*)); +extern Object P_Generic_Eq_Greater P_((int, Object*)); +extern Object P_Generic_Plus P_((int, Object*)); +extern Object P_Generic_Minus P_((int, Object*)); +extern Object P_Generic_Multiply P_((int, Object*)); +extern Object P_Generic_Divide P_((int, Object*)); +extern Object P_Quotient P_((Object, Object)); +extern Object P_Remainder P_((Object, Object)); +extern Object P_Modulo P_((Object, Object)); +extern Object P_Gcd P_((int, Object*)); +extern Object P_Lcm P_((int, Object*)); +extern Object P_Floor P_((Object)); +extern Object P_Ceiling P_((Object)); +extern Object P_Truncate P_((Object)); +extern Object P_Round P_((Object)); +extern Object P_Sqrt P_((Object)); +extern Object P_Exp P_((Object)); +extern Object P_Log P_((Object)); +extern Object P_Sin P_((Object)); +extern Object P_Cos P_((Object)); +extern Object P_Tan P_((Object)); +extern Object P_Asin P_((Object)); +extern Object P_Acos P_((Object)); +extern Object P_Atan P_((int, Object*)); +extern Object P_Min P_((int, Object*)); +extern Object P_Max P_((int, Object*)); +extern Object P_Random P_((void)); +extern Object P_Srandom P_((Object)); +extern Object P_Number_To_String P_((int, Object*)); +extern double Get_Double P_((Object)); +extern Get_Integer P_((Object)); +extern unsigned Get_Unsigned P_((Object)); +extern long Get_Long P_((Object)); +extern unsigned long Get_Unsigned_Long P_((Object)); +extern Get_Exact_Integer P_((Object)); +extern unsigned Get_Exact_Unsigned P_((Object)); +extern long Get_Exact_Long P_((Object)); +extern unsigned long Get_Exact_Unsigned_Long P_((Object)); + +/* Onfork handlers + */ +extern Register_Onfork P_((void (*)(void))); +extern void Call_Onfork P_((void)); + +/* Define_Primitive() + */ +extern Define_Primitive P_((Object (*)(ELLIPSIS), const char*, int, int, + enum discipline)); + +/* Output + */ +extern Object P_Write P_((int, Object*)); +extern Object P_Display P_((int, Object*)); +extern Object P_Write_Char P_((int, Object*)); +extern Object P_Newline P_((int, Object*)); +extern Object P_Format P_((int, Object*)); +extern Object P_Clear_Output_Port P_((int, Object*)); +extern Object P_Flush_Output_Port P_((int, Object*)); +extern Object P_Print P_((int, Object*)); +extern Object P_Get_Output_String P_((Object)); +extern Check_Output_Port P_((Object)); +extern Discard_Output P_((Object)); +extern Printf P_((ELLIPSIS)); +extern Print_Object P_((Object, Object, int, int, int)); +extern General_Print_Object P_((Object, Object, int)); +extern Format P_((Object, const char*, int, int, Object*)); +extern int Saved_Errno; + +/* Evaluator, procedures, macros + */ +extern Object Eval P_((Object)); +extern Object P_Eval P_((int, Object*)); +extern Object P_Apply P_((int, Object*)); +extern Object Funcall P_((Object, Object, int)); +extern Object P_Lambda P_((Object)); +extern Object P_Map P_((int, Object*)); +extern Object P_Procedure_Environment P_((Object)); +extern Object P_Procedure_Lambda P_((Object)); +extern Object P_For_Each P_((int, Object*)); +extern Object P_Procedurep P_((Object)); +extern Object P_Macro P_((Object)); +extern Object P_Macro_Body P_((Object)); +extern Object P_Macro_Expand P_((Object)); +extern Object P_Primitivep P_((Object)); +extern Object P_Compoundp P_((Object)); +extern Object P_Macrop P_((Object)); +extern Check_Procedure P_((Object)); + +/* Delay and force + */ +extern Object P_Delay P_((Object)); +extern Object P_Force P_((Object)); +extern Object P_Promisep P_((Object)); +extern Object P_Promise_Environment P_((Object)); + +/* Input + */ +extern Object P_Read P_((int, Object*)); +extern Object P_Read_Char P_((int, Object*)); +extern Object P_Peek_Char P_((int, Object*)); +extern Object P_Char_Readyp P_((int, Object*)); +extern Object P_Unread_Char P_((int, Object*)); +extern Object P_Read_String P_((int, Object*)); +extern Object P_Clear_Input_Port P_((int, Object*)); +extern Object General_Read P_((Object, int)); +extern Check_Input_Port P_((Object)); +extern Discard_Input P_((Object)); +extern void Define_Reader P_((int, READFUN)); + +/* Special forms + */ +extern Object P_Quote P_((Object)); +extern Object P_If P_((Object)); +extern Object P_Let P_((Object)); +extern Object P_Letseq P_((Object)); +extern Object P_Letrec P_((Object)); +extern Object P_Case P_((Object)); +extern Object P_Cond P_((Object)); +extern Object P_And P_((Object)); +extern Object P_Or P_((Object)); +extern Object P_Do P_((Object)); +extern Object P_Quasiquote P_((Object)); +extern Object P_Fluid_Let P_((Object)); +extern Object P_Begin P_((Object)); +extern Object P_Begin1 P_((Object)); + +/* Strings + */ +extern Object Make_String P_((const char*, int)); +extern Object Make_Const_String P_((const char*, int)); +extern Object P_Make_String P_((int, Object*)); +extern Object P_Stringp P_((Object)); +extern Object P_String P_((int, Object*)); +extern Object P_String_To_Number P_((int, Object*)); +extern Object P_String_Eq P_((Object, Object)); +extern Object P_String_Less P_((Object, Object)); +extern Object P_String_Greater P_((Object, Object)); +extern Object P_String_Eq_Less P_((Object, Object)); +extern Object P_String_Eq_Greater P_((Object, Object)); +extern Object P_String_CI_Eq P_((Object, Object)); +extern Object P_String_CI_Less P_((Object, Object)); +extern Object P_String_CI_Greater P_((Object, Object)); +extern Object P_String_CI_Eq_Less P_((Object, Object)); +extern Object P_String_CI_Eq_Greater P_((Object, Object)); +extern Object P_String_Length P_((Object)); +extern Object P_String_Ref P_((Object, Object)); +extern Object P_String_Set P_((Object, Object, Object)); +extern Object P_Substring P_((Object, Object, Object)); +extern Object P_String_Copy P_((Object)); +extern Object P_String_Append P_((int, Object*)); +extern Object P_List_To_String P_((Object)); +extern Object P_String_To_List P_((Object)); +extern Object P_Substring_Fill P_((Object, Object, Object, Object)); +extern Object P_String_Fill P_((Object, Object)); +extern Object P_Substringp P_((Object, Object)); +extern Object P_CI_Substringp P_((Object, Object)); + +/* Symbols, variables, frequently used Scheme objects + */ +extern Object Null, True, False, Void, Newline, Eof; +extern Object Intern P_((const char*)); +extern Object CI_Intern P_((const char*)); +extern Object P_Oblist P_((void)); +extern Object P_Symbolp P_((Object)); +extern Object P_Symbol_To_String P_((Object)); +extern Object P_String_To_Symbol P_((Object)); +extern Object P_Put P_((int, Object*)); +extern Object P_Get P_((Object, Object)); +extern Object P_Symbol_Plist P_((Object)); +extern void Define_Variable P_((Object*, const char*, Object)); +extern void Define_Symbol P_((Object *, const char*)); +extern Object Sym_Else; +extern Object Var_Get P_((Object)); +extern void Var_Set P_((Object, Object)); +extern int Var_Is_True P_((Object)); +extern unsigned long Symbols_To_Bits P_((Object, int, SYMDESCR*)); +extern Object Bits_To_Symbols P_((unsigned long, int, SYMDESCR*)); + +/* Termination functions + */ +extern void Register_Object P_((Object, GENERIC, PFO, int)); +extern void Deregister_Object P_((Object)); +extern Object Find_Object P_((ELLIPSIS)); +extern void Terminate_Group P_((GENERIC)); +extern void Terminate_Type P_((int)); + +/* Types, Define_Type() + */ +extern TYPEDESCR *Types; +extern Object P_Type P_((Object)); +extern Wrong_Type P_((Object, int)); +extern Wrong_Type_Combination P_((Object, const char*)); +extern Define_Type P_((int, const char*, int (*)(Object), int, + int (*)(Object, Object), int (*)(Object, Object), + int (*)(Object, Object, int, int, int), + int (*)(Object*, int (*)(Object*)) )); + +/* Vectors + */ +extern Object Make_Vector P_((int, Object)); +extern Object Make_Const_Vector P_((int, Object)); +extern Object P_Make_Vector P_((int, Object*)); +extern Object P_Vectorp P_((Object)); +extern Object P_Vector P_((int, Object*)); +extern Object P_Vector_Length P_((Object)); +extern Object P_Vector_Ref P_((Object, Object)); +extern Object P_Vector_Set P_((Object, Object, Object)); +extern Object P_Vector_To_List P_((Object)); +extern Object P_List_To_Vector P_((Object)); +extern Object P_Vector_Fill P_((Object, Object)); +extern Object P_Vector_Copy P_((Object)); + +C_LINKAGE_END diff --git a/include/funcproto.h b/include/funcproto.h new file mode 100644 index 0000000..39b4e82 --- /dev/null +++ b/include/funcproto.h @@ -0,0 +1,39 @@ +/* These definitions are not tunable. Do not change them. + */ + + +#if __STDC__ || defined(__cplusplus) +# undef WANT_PROTOTYPES +#endif + +#ifdef WANT_PROTOTYPES +# define ELK_USE_PROTOTYPES +# define ELLIPSIS +#endif + +#ifdef __cplusplus +# define ELK_USE_PROTOTYPES +# define ELLIPSIS ... +# define C_LINKAGE_BEGIN extern "C" { +# define C_LINKAGE_END } +#else +# define C_LINKAGE_BEGIN +# define C_LINKAGE_END +#endif + +#if __STDC__ && !defined(__cplusplus) +# define ELK_USE_PROTOTYPES +# define ELLIPSIS +#endif + +#ifdef NO_PROTOTYPES +# undef ELK_USE_PROTOTYPES +#endif + +#ifdef ELK_USE_PROTOTYPES +# define P_(args) args +#else +# define P_(args) () +# define ELLIPSIS +# define const +#endif diff --git a/include/gc.h b/include/gc.h new file mode 100644 index 0000000..dd6ee59 --- /dev/null +++ b/include/gc.h @@ -0,0 +1,94 @@ +extern GCNODE *GC_List; + +#define TAG_FUN -1 +#define TAG_TCFUN -2 +#define TAG_ARGS -3 +#define TAG_ENV -4 + +#define GC_Node GCNODE gc1 +#define GC_Node2 GCNODE gc1, gc2 +#define GC_Node3 GCNODE gc1, gc2, gc3 +#define GC_Node4 GCNODE gc1, gc2, gc3, gc4 +#define GC_Node5 GCNODE gc1, gc2, gc3, gc4, gc5 +#define GC_Node6 GCNODE gc1, gc2, gc3, gc4, gc5, gc6 +#define GC_Node7 GCNODE gc1, gc2, gc3, gc4, gc5, gc6, gc7 + +#define GC_Link(x) {\ + gc1.gclen = 0; gc1.gcobj = &x; gc1.next = GC_List; GC_List = &gc1;\ +} + +#define GC_Link2(x1,x2) {\ + gc1.gclen = 0; gc1.gcobj = &x1; gc1.next = GC_List;\ + gc2.gclen = 0; gc2.gcobj = &x2; gc2.next = &gc1; GC_List = &gc2;\ +} + +#define GC_Link3(x1,x2,x3) {\ + gc1.gclen = 0; gc1.gcobj = &x1; gc1.next = GC_List;\ + gc2.gclen = 0; gc2.gcobj = &x2; gc2.next = &gc1;\ + gc3.gclen = 0; gc3.gcobj = &x3; gc3.next = &gc2; GC_List = &gc3;\ +} + +#define GC_Link4(x1,x2,x3,x4) {\ + gc1.gclen = 0; gc1.gcobj = &x1; gc1.next = GC_List;\ + gc2.gclen = 0; gc2.gcobj = &x2; gc2.next = &gc1;\ + gc3.gclen = 0; gc3.gcobj = &x3; gc3.next = &gc2;\ + gc4.gclen = 0; gc4.gcobj = &x4; gc4.next = &gc3; GC_List = &gc4;\ +} + +/* see src/proc.c */ +#define GC_Link4_Tag_Primitive(args,fun,env,x4) {\ + gc1.gclen = TAG_ARGS; gc1.gcobj = &args; gc1.next = GC_List;\ + gc2.gclen = Tail_Call ? TAG_TCFUN : TAG_FUN;\ + gc2.gcobj = &fun; gc2.next = &gc1;\ + gc3.gclen = TAG_ENV; gc3.gcobj = &env; gc3.next = &gc2;\ + gc4.gclen = 0; gc4.gcobj = &x4; gc4.next = &gc3; GC_List = &gc4;\ +} + +#define GC_Link5(x1,x2,x3,x4,x5) {\ + gc1.gclen = 0; gc1.gcobj = &x1; gc1.next = GC_List;\ + gc2.gclen = 0; gc2.gcobj = &x2; gc2.next = &gc1;\ + gc3.gclen = 0; gc3.gcobj = &x3; gc3.next = &gc2;\ + gc4.gclen = 0; gc4.gcobj = &x4; gc4.next = &gc3;\ + gc5.gclen = 0; gc5.gcobj = &x5; gc5.next = &gc4; GC_List = &gc5;\ +} + +#define GC_Link6(x1,x2,x3,x4,x5,x6) {\ + gc1.gclen = 0; gc1.gcobj = &x1; gc1.next = GC_List;\ + gc2.gclen = 0; gc2.gcobj = &x2; gc2.next = &gc1;\ + gc3.gclen = 0; gc3.gcobj = &x3; gc3.next = &gc2;\ + gc4.gclen = 0; gc4.gcobj = &x4; gc4.next = &gc3;\ + gc5.gclen = 0; gc5.gcobj = &x5; gc5.next = &gc4;\ + gc6.gclen = 0; gc6.gcobj = &x6; gc6.next = &gc5; GC_List = &gc6;\ +} + +#define GC_Link7(x1,x2,x3,x4,x5,x6,x7) {\ + gc1.gclen = 0; gc1.gcobj = &x1; gc1.next = GC_List;\ + gc2.gclen = 0; gc2.gcobj = &x2; gc2.next = &gc1;\ + gc3.gclen = 0; gc3.gcobj = &x3; gc3.next = &gc2;\ + gc4.gclen = 0; gc4.gcobj = &x4; gc4.next = &gc3;\ + gc5.gclen = 0; gc5.gcobj = &x5; gc5.next = &gc4;\ + gc6.gclen = 0; gc6.gcobj = &x6; gc6.next = &gc5;\ + gc7.gclen = 0; gc7.gcobj = &x7; gc7.next = &gc6; GC_List = &gc7;\ +} + +/* see src/proc.c */ +#define GC_Link7_Tag_Compound(args,fun,env,x4,x5,x6,x7) {\ + gc1.gclen = TAG_ARGS;\ + gc1.gcobj = &args; gc1.next = GC_List;\ + gc2.gclen = Tail_Call ? TAG_TCFUN : TAG_FUN;\ + gc2.gcobj = &fun; gc2.next = &gc1;\ + gc3.gclen = TAG_ENV;\ + gc3.gcobj = &env; gc3.next = &gc2;\ + gc4.gclen = 0; gc4.gcobj = &x4; gc4.next = &gc3;\ + gc5.gclen = 0; gc5.gcobj = &x5; gc5.next = &gc4;\ + gc6.gclen = 0; gc6.gcobj = &x6; gc6.next = &gc5;\ + gc7.gclen = 0; gc7.gcobj = &x7; gc7.next = &gc6; GC_List = &gc7;\ +} + +#define GC_Unlink (GC_List = gc1.next) + +C_LINKAGE_BEGIN +extern Func_Global_GC_Link P_((Object*)); +C_LINKAGE_END + +#define Global_GC_Link(x) Func_Global_GC_Link(&x) diff --git a/include/intern.h b/include/intern.h new file mode 100644 index 0000000..9d799f6 --- /dev/null +++ b/include/intern.h @@ -0,0 +1,145 @@ +/* Functions and variables that are used by more than one source file of + * the kernel. Not available to extensions and applications. + */ + +C_LINKAGE_BEGIN + +/* autoload.c + */ +extern Object V_Autoload_Notifyp; +extern Object Do_Autoload P_((Object, Object)); + +/* bignum.c + */ +extern int Bignum_Zero P_((Object)); +extern int Bignum_Positive P_((Object)); +extern int Bignum_Negative P_((Object)); +extern int Bignum_Even P_((Object)); +extern Object Make_Bignum P_((const char*, int, int)); +extern Object Integer_To_Bignum P_((int)); +extern Object Bignum_Divide P_((Object, Object)); +extern Object Bignum_Abs P_((Object)); +extern Object Bignum_Plus P_((Object, Object)); +extern Object Bignum_Minus P_((Object, Object)); +extern Object Bignum_Fixnum_Multiply P_((Object, Object)); +extern Object Bignum_Multiply P_((Object, Object)); +extern Object Bignum_Fixnum_Divide P_((Object, Object)); +extern Object Double_To_Bignum P_((double)); +extern Object Unsigned_To_Bignum P_((unsigned)); +extern Object Long_To_Bignum P_((long)); +extern Object Unsigned_Long_To_Bignum P_((unsigned long)); +extern unsigned Bignum_To_Unsigned P_((Object)); +extern unsigned long Bignum_To_Unsigned_Long P_((Object)); +extern long Bignum_To_Long P_((Object)); +extern Object Bignum_To_String P_((Object, int)); +extern double Bignum_To_Double P_((Object)); +extern Bignum_Equal P_((Object, Object)); +extern Bignum_Greater P_((Object, Object)); +extern Bignum_Less P_((Object, Object)); +extern Bignum_Eq_Less P_((Object, Object)); +extern Bignum_Eq_Greater P_((Object, Object)); + +/* cont.c + */ +extern WIND *First_Wind, *Last_Wind; +extern Object Internal_Call_CC P_((int, Object)); + +/* dump.c + */ +extern Object Dump_Control_Point; + +/* env.c + */ +extern Object Add_Binding P_((Object, Object, Object)); +extern Object Lookup_Symbol P_((Object, int)); + +/* error.c + */ +extern Object Arg_True; +extern char *appname; + +/* exception.c + */ +extern void Install_Intr_Handler P_((void)); + +/* heap.c + */ +#ifndef GENERATIONAL_GC +extern char *Hp, *Heap_Start, *Heap_End, *Free_Start, *Free_End; +#endif +extern int GC_In_Progress; + +/* io.c + */ +extern Object General_Open_File P_((Object, int, Object)); + +/* load.c + */ +extern char *Loader_Input; +extern Object V_Load_Path, V_Load_Noisilyp, V_Load_Libraries; +extern void Check_Loadarg P_((Object)); +extern Object General_Load P_((Object, Object)); + +/* list.c + */ +extern Object General_Assoc P_((Object, Object, int)); + +/* main.c + */ +extern char *stkbase, *A_Out_Name; +extern int Stack_Grows_Down; +extern int Max_Stack, Interpreter_Initialized, Was_Dumped; +extern char *Brk_On_Dump; +extern int Verb_Load, Verb_Init, Case_Insensitive; +extern SYMTAB *The_Symbols; +extern void Exit_Handler P_((void)); +#ifndef ATEXIT +extern void exit P_((int)); +#endif + +/* math.c + */ +extern char *Flonum_To_String P_((Object)); + +/* proc.c + */ +extern Object Sym_Lambda, Sym_Macro; +extern Funcall_Control_Point P_((Object, Object, int)); +extern Object Make_Primitive + P_((Object(*)(ELLIPSIS), const char*, int, int, enum discipline)); + +/* read.c + */ +extern Object Sym_Quote; +extern Object Sym_Quasiquote, Sym_Unquote, Sym_Unquote_Splicing; +extern Object Parse_Number P_((Object, const char*, int)); + +/* stab.c + */ +extern SYMTAB *Snarf_Symbols P_((ELLIPSIS)); /* varying args */ +extern SYMTAB *Open_File_And_Snarf_Symbols P_((char *)); + +/* stkmem.c + */ +#ifndef USE_ALLOCA +extern Object Save_GC_Nodes P_((void)); +#endif + +/* string.c + */ +extern char Char_Map[]; +extern Object General_Make_String P_((const char*, int, int)); + +/* symbol.c + */ +extern Object Unbound, Special, Zero, One; + +/* type.c + */ +extern Num_Types, Max_Type; + +/* vector.c + */ +extern Object List_To_Vector P_((Object, int)); + +C_LINKAGE_END diff --git a/include/kernel.h b/include/kernel.h new file mode 100644 index 0000000..8def633 --- /dev/null +++ b/include/kernel.h @@ -0,0 +1,24 @@ +/* The `wrapper' include file used by the interpreter. + */ + +#ifndef KERNEL_H +#define KERNEL_H + +#include +#include + +#include "config.h" +#include "funcproto.h" +#include "param.h" +#include "object.h" +#include "intern.h" +#include "extern.h" +#include "misc.h" +#include "exception.h" +#include "gc.h" +#include "type.h" +#include "stkmem.h" +#include "cstring.h" +#include "compat.h" + +#endif diff --git a/include/misc.h b/include/misc.h new file mode 100644 index 0000000..ab10c3e --- /dev/null +++ b/include/misc.h @@ -0,0 +1,78 @@ +#ifndef __GNUC__ +# define __asm__ asm +#endif + +#ifndef HUGE +# define HUGE HUGE_VAL +#endif + + +/* Arithmetic shift right for compilers that don't sign extend: + */ +#if (-1 >> 1) < 0 +# define ASR(n,s) ((n) >>= (s)) +#else +# define NBITS(v) ((sizeof v) * 8) +# define HIBIT(v,n) (NBITS(v) - (n)) +# define ASR(n,s) ((n) >>= (s),\ + ((n) & (1 << (HIBIT((n),(s)) - 1)) ?\ + ((n) |= ~(((unsigned)1 << HIBIT((n),(s))) - 1)) :\ + (n))) +#endif + +extern Object False2; + +#define Nullp(x) (TYPE(x) == T_Null) +#define Truep(x) (!EQ(x,False) && !EQ(x,False2)) +#define Car(x) PAIR(x)->car +#define Cdr(x) PAIR(x)->cdr +#define Cons P_Cons +#define Begin P_Begin +#define Assq(x,y) General_Assoc(x,y,0) +#define Print(x) General_Print_Object (x, Curr_Output_Port, 0) +#define Numeric(t) (t == T_Fixnum || t == T_Flonum || t == T_Bignum) + +#define Whitespace(c) (c == ' ' || c == '\t' || c == '\014' || c == '\n') +#define Delimiter(c) (c == ';' || c == ')' || c == '(' || c == '"') + + +/* Align heap addresses */ +#ifdef ALIGN_8BYTE +# define ALIGN(ptr) ((ptr) = (char *)(((long)(ptr) + 7) & ~7)) +#else +# define ALIGN(ptr) ((ptr) = (char *)(((long)(ptr) + 3) & ~3)) +#endif + +/* Normalize stack addresses */ +#define NORM(addr) ((long)(addr) + delta) + + +/* Used in special forms: */ +extern int Tail_Call; + +#define TC_Prolog register _t = Tail_Call +#define TC_Disable Tail_Call = 0 +#define TC_Enable Tail_Call = _t + + +/* Macros to be used by readers registered with Define_Reader(). + * They operate on variables c, port, f, and str. + */ +#define Reader_Getc {\ + c = str ? String_Getc (port) : getc (f);\ + if (c == '\n') PORT(port)->lno++;\ +} + +#define Reader_Ungetc {\ + if (str) String_Ungetc (port,c); else (void)ungetc (c,f);\ + if (c == '\n') if (PORT(port)->lno > 1) PORT(port)->lno--;\ +} + +#define Reader_Tweak_Stream {\ + if (!str && (feof (f) || ferror (f))) clearerr (f);\ +} + +#define Reader_Sharp_Eof {\ + Reader_Tweak_Stream;\ + Reader_Error (port, "end of file after `#'");\ +} diff --git a/include/object.h b/include/object.h new file mode 100644 index 0000000..a74062b --- /dev/null +++ b/include/object.h @@ -0,0 +1,328 @@ +/* The Scheme object representation, and a few other important + * data types. + */ + +typedef struct { + unsigned long data; + int tag; +} Object; + +#define FIXBITS (8 * sizeof(int)) +#define SIGNBIT ((unsigned)1 << (FIXBITS-1)) +#define CONSTBIT 1 +#define TYPEBITS (8 * sizeof(int) - 1) +#define MAX_TYPE ((1 << TYPEBITS) - 1) + +#define UFIXNUM_FITS(i) (((i) & SIGNBIT) == 0) +#define FIXNUM_FITS(i) 1 + +#define TYPE(x) ((x).tag >> 1) + +#define FIXNUM(x) ((int)(x).data) +#define CHAR(x) ((int)(x).data) + +#define POINTER(x) ((x).data) +#define SETPOINTER(x,p) ((x).data = (unsigned long)(p)) +#define SET(x,t,p) ((x).tag = (int)t << 1, (x).data = (unsigned long)(p)) + +#define ISCONST(x) ((x).tag & CONSTBIT) +#define SETCONST(x) ((x).tag |= CONSTBIT) + +#define EQ(x,y) ((x).data == (y).data && (x).tag == (y).tag) + +/* GC related macros: + */ +#define WAS_FORWARDED(obj) (TYPE(*(Object *)POINTER(obj)) == T_Broken_Heart) +#define UPDATE_OBJ(obj) SETPOINTER(obj, POINTER(*(Object *)POINTER(obj))) + +#ifdef GENERATIONAL_GC + + typedef int gcspace_t; /* type used for space and type arrays */ + typedef unsigned long gcptr_t; /* type used for pointers */ + typedef unsigned long pageno_t; /* type used for page numbers */ + typedef unsigned long addrarith_t; /* type used for address arithmetic */ + + extern gcspace_t *space; + extern gcspace_t current_space; + C_LINKAGE_BEGIN + extern Visit P_((Object*)); /* required for REVIVE_OBJ below */ + C_LINKAGE_END + +# ifdef ARRAY_BROKEN + extern pageno_t pagebase; +# else +# define pagebase ((pageno_t)0) +# endif + +# define PAGEBYTES 512 +# define PAGE_TO_OBJ(p) ((Object *) (((p) + pagebase) * PAGEBYTES)) +# define OBJ_TO_PAGE(p) ((((gcptr_t)POINTER(p)) / PAGEBYTES) - pagebase) +# define STABLE(x) ((~space[(x)]) & 1) +# define MAKEOBJ(o,t,p) (SET(o, t, p)) +# define IS_ALIVE(obj) ((WAS_FORWARDED(obj)) || \ + (STABLE(OBJ_TO_PAGE(obj))) || \ + (space[OBJ_TO_PAGE(obj)] == current_space)) +# define REVIVE_OBJ(obj) Visit (&obj); +#else +# define IS_ALIVE(obj) WAS_FORWARDED(obj) +# define REVIVE_OBJ(obj) +#endif + +/* Fixed types. Cannot use enum, because the set of types is extensible: + */ +#define T_Fixnum 0 /* Must be 0 */ +#define T_Bignum 1 +#define T_Flonum 2 +#define T_Null 3 /* empty list */ +#define T_Boolean 4 /* #t (1) and #f (0) */ +#define T_Unbound 5 /* only used internally */ +#define T_Special 6 /* only used internally */ +#define T_Character 7 +#define T_Symbol 8 +#define T_Pair 9 +#define T_Environment 10 /* A pair */ +#define T_String 11 +#define T_Vector 12 +#define T_Primitive 13 /* Primitive procedure */ +#define T_Compound 14 /* Compound procedure */ +#define T_Control_Point 15 +#define T_Promise 16 /* Result of (delay expression) */ +#define T_Port 17 +#define T_End_Of_File 18 +#define T_Autoload 19 +#define T_Macro 20 +#define T_Broken_Heart 21 /* only used internally */ +#ifdef GENERATIONAL_GC +# define T_Align_8Byte 22 /* only used internally */ +# define T_Freespace 23 /* only used internally */ +#endif + +#define BIGNUM(x) ((struct S_Bignum *)POINTER(x)) +#define FLONUM(x) ((struct S_Flonum *)POINTER(x)) +#define STRING(x) ((struct S_String *)POINTER(x)) +#define VECTOR(x) ((struct S_Vector *)POINTER(x)) +#define SYMBOL(x) ((struct S_Symbol *)POINTER(x)) +#define PAIR(x) ((struct S_Pair *)POINTER(x)) +#define PRIM(x) ((struct S_Primitive *)POINTER(x)) +#define COMPOUND(x) ((struct S_Compound *)POINTER(x)) +#define CONTROL(x) ((struct S_Control *)POINTER(x)) +#define PROMISE(x) ((struct S_Promise *)POINTER(x)) +#define PORT(x) ((struct S_Port *)POINTER(x)) +#define AUTOLOAD(x) ((struct S_Autoload *)POINTER(x)) +#define MACRO(x) ((struct S_Macro *)POINTER(x)) + +typedef unsigned short gran_t; /* Granularity of bignums */ + +struct S_Bignum { + Object minusp; + unsigned size; /* Number of ushorts allocated */ + unsigned usize; /* Number of ushorts actually used */ + gran_t data[1]; /* Data, lsw first */ +}; + +struct S_Flonum { + Object tag; /* Each S_Foo must start with an Object */ + double val; +}; + +struct S_Symbol { + Object value; + Object next; + Object name; /* A string */ + Object plist; +}; + +struct S_Pair { + Object car, cdr; +}; + +struct S_String { + Object tag; + int size; + char data[1]; +}; + +struct S_Vector { + Object tag; + int size; + Object data[1]; +}; + +enum discipline { EVAL, NOEVAL, VARARGS }; +struct S_Primitive { + Object tag; + Object (*fun) P_((ELLIPSIS)); + const char *name; + int minargs; + int maxargs; /* Or MANY */ + enum discipline disc; +}; +#define MANY 100 + +struct S_Compound { + Object closure; /* (lambda (args) form ...) */ + Object env; /* Procedure's environment */ + int min_args, max_args; + int numforms; + Object name; +}; + +typedef struct wind { + struct wind *next, *prev; + Object inout; /* Pair of thunks */ +} WIND; + +typedef struct funct { + struct funct *next; + char *name; + void (*func) P_((void)); +} FUNCT; + +typedef struct gcnode { + struct gcnode *next; + int gclen; + Object *gcobj; +} GCNODE; + +typedef struct mem_node { + struct mem_node *next; + unsigned len; + unsigned long refcnt; +} MEM_NODE; + +#if defined(vax) || defined(__vax__) + typedef int jmp_buf[17]; +#else +# include +#endif + +struct S_Control { + Object env; + GCNODE *gclist; + MEM_NODE *memlist; + Object memsave; /* string */ + Object gcsave; /* vector */ + WIND *firstwind, *lastwind; + int tailcall; + unsigned delta; +#ifdef GENERATIONAL_GC + int reloc; +#endif + jmp_buf j; + int size; + unsigned long intrlevel; + char stack[1]; /* must be word aligned */ +}; + +struct S_Promise { + Object env; + Object thunk; + int done; +}; + +struct S_Port { + Object name; /* string */ + short flags; + char unread; + int ptr; + FILE *file; + unsigned lno; + int (*closefun) P_((FILE*)); +}; +#define P_OPEN 1 /* flags */ +#define P_INPUT 2 +#define P_STRING 4 +#define P_UNREAD 8 +#define P_BIDIR 16 + +#define IS_INPUT(port) (PORT(port)->flags & (P_INPUT|P_BIDIR)) +#define IS_OUTPUT(port) ((PORT(port)->flags & (P_INPUT|P_BIDIR)) != P_INPUT) + +struct S_Autoload { + Object files; + Object env; +}; + +struct S_Macro { + Object body; + int min_args, max_args; + Object name; +}; + + +/* "size" is called with one object and returns the size of the object. + * If "size" is NOFUNC, then "const_size" is taken instead. + * "eqv" and "equal" are called with two objects and return 0 or 1. + * NOFUNC may be passed instead (then eqv and equal always return #f). + * "print" is called with an object, a port, a flag indicating whether + * the object is to be printed "raw" (a la display), the print-depth, + * and the print-length. + * "visit" is called with a pointer to an object and a function. + * For each component of the object, the function must be called with + * a pointer to the component. NOFUNC may be supplied. + */ +typedef struct { + int haspointer; + const char *name; + int (*size) P_((Object)); + int const_size; + int (*eqv) P_((Object, Object)); + int (*equal) P_((Object, Object)); + int (*print) P_((Object, Object, int, int, int)); + int (*visit) P_((Object*, int (*)(Object*))); +} TYPEDESCR; + +#ifdef ELK_USE_PROTOTYPES +# define NOFUNC 0 +#else +# define NOFUNC ((int (*)())0) +#endif + + +typedef struct sym { + struct sym *next; + char *name; + unsigned long value; +} SYM; + +typedef struct { + SYM *first; + char *strings; +} SYMTAB; + +typedef struct { + char *name; + int type; +} SYMPREFIX; + +#define PR_EXTENSION 0 /* Elk extension initializers/finalizers */ +#define PR_CONSTRUCTOR 1 /* C++ static constructors/destructors */ + + +/* PFO, GENERIC, and MATCHFUN exist for backwards compatibility + */ +typedef Object (*PFO) P_((Object)); +typedef int (*MATCHFUN) P_((ELLIPSIS)); +#define GENERIC char* + +typedef struct weak_node { + struct weak_node *next; + Object obj; + PFO term; + GENERIC group; + char flags; +} WEAK_NODE; + +/* flags */ +#define WK_LEADER 1 + + +typedef struct { + char *name; + unsigned long val; +} SYMDESCR; + + +/* Function that can be registered as a reader by Define_Reader(): + */ +typedef Object (*READFUN) P_((Object, int, int)); diff --git a/include/param.h b/include/param.h new file mode 100644 index 0000000..da47603 --- /dev/null +++ b/include/param.h @@ -0,0 +1,56 @@ +/* These definitions are not intended to be tunable. Do not change + * them unless you _must_. + */ + + +/* Name of Scheme file which is always loaded on startup: + */ +#define INITFILE "initscheme.scm" + + +/* Name of environment variable holding initial load-path: + */ +#define LOADPATH_ENV "ELK_LOADPATH" + + +/* Size of `obarray' (symbol hash table): + */ +#define OBARRAY_SIZE 1009 + + +/* Approximate size of gap between beginning of stack and `stkbase' + * (subtracted from stack limit on startup): + */ +#define STACK_MARGIN (64*1024) + + +/* Minimum number of bytes that must be reclaimed by a run of the + * stop-and-copy garbage collector: + */ +#define HEAP_MARGIN (HEAP_SIZE/10*1024) + + +/* The buffers maintained by output string ports grow in increments + * of STRING_GROW_SIZE when written: + */ +#define STRING_GROW_SIZE 64 + + +/* Initial print depth and print length: + */ +#define DEF_PRINT_DEPTH 20 +#define DEF_PRINT_LEN 1000 + + +/* Offset to compensate for differences in argv/environment between base + * a.out and dumped a.out on startup (see src/main.c): + */ +#ifdef CAN_DUMP +# define INITIAL_STK_OFFSET (20*1024) /* 2*NCARGS */ +#endif + + +/* Number of static string buffers cyclically reused by Get_String() + * and Get_Strsym(): + */ +#define NUMSTRBUFS 3 diff --git a/include/scheme.h b/include/scheme.h new file mode 100644 index 0000000..9e8ad05 --- /dev/null +++ b/include/scheme.h @@ -0,0 +1,23 @@ +/* The `wrapper' include file used by extensions and applications. + */ + +#ifndef SCHEME_H +#define SCHEME_H + +#include +#include + +#include "config.h" +#include "funcproto.h" +#include "param.h" +#include "object.h" +#include "extern.h" +#include "misc.h" +#include "exception.h" +#include "gc.h" +#include "type.h" +#include "stkmem.h" +#include "cstring.h" +#include "compat.h" + +#endif diff --git a/include/stkmem.h b/include/stkmem.h new file mode 100644 index 0000000..dccf426 --- /dev/null +++ b/include/stkmem.h @@ -0,0 +1,62 @@ +#ifdef USE_ALLOCA + +#ifdef INCLUDE_ALLOCA_H +# include +#endif + +/* #pragma must be indented to prevent some C-compilers from complaining + * about "undefined control". + */ +#ifdef PRAGMA_ALLOCA + #pragma alloca +#endif + +#if !defined(alloca) && !defined(__GNUC__) +C_LINKAGE_BEGIN +extern char *alloca P_((int)); +C_LINKAGE_END +#endif + +/* MIPS cc under Ultrix 4.2 requires argument to alloca() to be + * parenthesized if it's a compound expression. + * + * Declare variable in Alloca_Begin and reference it in Alloca to make + * sure users won't forget Alloca_Begin when using macros like + * Get_String_Stack(). + */ +#define Alloca_Begin int _Check_Alloca_Begin +#define Alloca(ret,type,size) (_Check_Alloca_Begin = 0,\ + (ret) = (type)alloca((size))) +#define Alloca_End + +#else /* USE_ALLOCA */ + +extern MEM_NODE *Mem_List; +extern char *Mem_Alloc P_((unsigned)); + +#define Alloca_Begin MEM_NODE *_mem_first = 0 +#define Alloca(ret,type,size) {\ + register MEM_NODE *_p;\ + _p = (MEM_NODE*)Mem_Alloc ((unsigned)(size) + sizeof(MEM_NODE));\ + _p->next = Mem_List;\ + _p->len = (size);\ + _p->refcnt = 1;\ + Mem_List = _p;\ + if (_mem_first == 0) _mem_first = _p;\ + (ret) = (type)(_p+1);\ +} +#define Alloca_End {\ + register MEM_NODE *_p, *_q;\ + if (_mem_first != 0) {\ + _p = Mem_List;\ + do {\ + _q = _p;\ + _p = _p->next;\ + if (--_q->refcnt == 0)\ + free ((char *)_q);\ + } while (_q != _mem_first);\ + Mem_List = _p;\ + }\ +} + +#endif diff --git a/include/type.h b/include/type.h new file mode 100644 index 0000000..bfddd19 --- /dev/null +++ b/include/type.h @@ -0,0 +1,27 @@ +/* Miscellaneous macros for type-checking Scheme objects. + */ + +#define Check_Type(x,t) {\ + if (TYPE(x) != t) Wrong_Type (x, t);\ +} + +#define Check_List(x) {\ + if (TYPE(x) != T_Pair && !Nullp (x)) Wrong_Type_Combination (x, "list");\ +} + +#define Check_Number(x) {\ + register t = TYPE(x);\ + if (!Numeric (t)) Wrong_Type_Combination (x, "number");\ +} + +/* This should be renamed; it checks whether x is an *exact* integer. + */ +#define Check_Integer(x) {\ + register t = TYPE(x);\ + if (t != T_Fixnum && t != T_Bignum) Wrong_Type (x, T_Fixnum);\ +} + +#define Check_Mutable(x) {\ + if (ISCONST(x))\ + Primitive_Error ("attempt to modify constant");\ +} diff --git a/lib/misc/Makefile b/lib/misc/Makefile new file mode 100644 index 0000000..cd1a7d3 --- /dev/null +++ b/lib/misc/Makefile @@ -0,0 +1,24 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../../config/system ../../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + +lint: Makefile.local + $(MAKE) -f Makefile.local lint + +clean: Makefile.local + $(MAKE) -f Makefile.local clean + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/lib/misc/bitstring.c b/lib/misc/bitstring.c new file mode 100644 index 0000000..4444755 --- /dev/null +++ b/lib/misc/bitstring.c @@ -0,0 +1,526 @@ +#include "scheme.h" + +#define BITSTRING(x) ((struct S_Bitstring *)POINTER(x)) + +struct S_Bitstring { + Object tag; + unsigned len; /* # of used bits; unused bits in MSB always 0 */ + unsigned char data[1]; /* data[0] == LSB */ +}; + +#define bits_to_bytes(b) (((b)+7)/8) + +static int masks[] = { 0, 0x1, 0x2, 0x4, 0x8, 0x10, 0x20, 0x40, 0x80 }; +static int masks2[] = { 0, 0x1, 0x3, 0x7, 0xF, 0x1F, 0x3F, 0x7F, 0xFF }; + +int T_Bitstring; + +static Object P_Bitstringp(x) Object x; { + return TYPE(x) == T_Bitstring ? True : False; +} + +static int Bitstring_Size(b) Object b; { + return sizeof(struct S_Bitstring) + bits_to_bytes(BITSTRING(b)->len) - 1; +} + +static Bitstring_Equal(b1, b2) Object b1, b2; { + struct S_Bitstring *a = BITSTRING(b1), *b = BITSTRING(b2); + + if (a->len != b->len) + return 0; + return !bcmp(a->data, b->data, bits_to_bytes(a->len)); +} + +static Object P_Bitstring_Equalp(a, b) Object a, b; { + return Bitstring_Equal(a, b) ? True : False; +} + +static char *Digits(c, n) unsigned char c; int n; { + static char buf[9]; + int i = 0; + + for (; n > 0; n--) + buf[i++] = c & masks[n] ? '1' : '0'; + buf[i] = '\0'; + return buf; +} + +/* Print starting with MSB + */ +static Bitstring_Print(x, port, raw, depth, length) Object x, port; { + int i, rem; + struct S_Bitstring *b = BITSTRING(x); + GC_Node2; + + GC_Link2(x, port); + Printf(port, "#*"); + i = bits_to_bytes(b->len) - 1; + if (rem = b->len % 8) + Printf(port, Digits(b->data[i--], rem)); + for ( ; i >= 0; i--) + Printf(port, Digits(b->data[i], 8)); + GC_Unlink; +} + +static Object Make_Bitstring(len) unsigned len; { + Object b; + int nbytes = bits_to_bytes(len); + + b = Alloc_Object(sizeof(struct S_Bitstring) + nbytes-1, T_Bitstring, 0); + bzero((char *)BITSTRING(b)->data, nbytes); + BITSTRING(b)->tag = Null; + BITSTRING(b)->len = len; + return b; +} + +static void Fill_Bitstring(bs, fill) Object bs; int fill; { + struct S_Bitstring *b = BITSTRING(bs); + int i, rem; + unsigned char val = fill ? ~0 : 0; + + i = bits_to_bytes(b->len) - 1; + if (val && (rem = b->len % 8)) + b->data[i--] |= masks2[rem]; + for ( ; i >= 0; i--) + b->data[i] = val; +} + +static Object P_Make_Bitstring(len, init) Object len, init; { + Object ret; + int n, fill; + + if ((n = Get_Integer(len)) < 0) + Range_Error(len); + Check_Type(init, T_Boolean); + fill = Truep(init); + ret = Make_Bitstring((unsigned)n); + if (fill) + Fill_Bitstring(ret, 1); + return ret; +} + +static Object P_Bitstring_Length(bs) Object bs; { + Check_Type(bs, T_Bitstring); + return Make_Unsigned(BITSTRING(bs)->len); +} + +static int Ulong_Size(ul) unsigned long ul; { + int n; + + for (n = 0; ul; ul >>= 1, n++) + ; + return n; +} + +static Object Ulong_To_Bitstring(ul, len) unsigned long ul; unsigned len; { + Object ret; + struct S_Bitstring *b; + int i, siz = Ulong_Size(ul); + char buf[50]; + + ret = Make_Bitstring(len); + b = BITSTRING(ret); + if (siz > len) { + sprintf(buf, "length %u too small for integer %lu", len, ul); + Primitive_Error(buf); + } + for (i = 0; ul; ul >>= 8, i++) + b->data[i] = ul & 0xFF; + return ret; +} + +static int Bigbits(b) struct S_Bignum *b; { + return b->usize ? (Ulong_Size((unsigned long)b->data[b->usize-1]) + + (b->usize-1) * sizeof(gran_t) * 8) : 0; +} + +static Object Bignum_To_Bitstring(big, len) Object big; unsigned len; { + char buf[50]; + Object ret; + struct S_Bitstring *b; + struct S_Bignum *bn; + int k, i, n; + GC_Node; + + if (Bigbits(BIGNUM(big)) > len) { + sprintf(buf, "length %u too small for integer ~s", len); + Primitive_Error(buf, big); + } + GC_Link(big); + ret = Make_Bitstring(len); + GC_Unlink; + b = BITSTRING(ret); + bn = BIGNUM(big); + n = bits_to_bytes(len); + for (i = k = 0; k < bn->usize; k++, i++) { + b->data[i] = bn->data[k] & 0xFF; + if (i < n) + b->data[++i] = bn->data[k] >> 8 & 0xFF; + } + return ret; +} + +static Object P_Int_To_Bitstring(len, i) Object len, i; { + Object isneg; + int ilen; + + if ((ilen = Get_Integer(len)) < 0) + Range_Error(len); + Check_Integer(i); + isneg = P_Negativep(i); + if (Truep(isneg)) + Range_Error(i); + if (TYPE(i) == T_Fixnum) + return Ulong_To_Bitstring((unsigned long)FIXNUM(i), (unsigned)ilen); + return Bignum_To_Bitstring(i, (unsigned)ilen); +} + +static Object Bitstring_To_Bignum (bs) Object bs; { + struct S_Bitstring *b; + Object big; + int i, n, k; + gran_t digit; + GC_Node; + + n = bits_to_bytes(BITSTRING(bs)->len); + GC_Link(bs); + big = Make_Uninitialized_Bignum((n+1)/2); /* assume sizeof(gran_t)==2 */ + GC_Unlink; + b = BITSTRING(bs); + for (i = k = 0; i < n; k++, i++) { + digit = b->data[i]; + if (!(i & 1)) + digit |= (unsigned)b->data[++i] << 8; + BIGNUM(big)->data[k] = digit; + } + BIGNUM(big)->usize = k; + Bignum_Normalize_In_Place (BIGNUM(big)); + return big; +} + +static Object P_Bitstring_To_Int(bs) Object bs; { + struct S_Bitstring *b; + unsigned u = 0; + int i; + + Check_Type(bs, T_Bitstring); + b = BITSTRING(bs); + + for (i = bits_to_bytes(b->len) - 1; i >= 0; i--) { + u = u << 8 | b->data[i]; + if (!UFIXNUM_FITS(u)) + return Bitstring_To_Bignum(bs); + } + return Make_Integer(u); +} + +static Object P_Bitstring_Ref(bs, inx) Object bs, inx; { + struct S_Bitstring *b; + int i; + + Check_Type(bs, T_Bitstring); + b = BITSTRING(bs); + if ((i = Get_Integer(inx)) < 0 || i >= b->len) + Range_Error(inx); + return b->data[i/8] & 1 << i % 8 ? True : False; +} + +static Object P_Bitstring_Set(bs, inx, val) Object bs, inx, val; { + int old, i, j, mask; + struct S_Bitstring *b; + + Check_Type(bs, T_Bitstring); + Check_Type(val, T_Boolean); + b = BITSTRING(bs); + if ((i = Get_Integer(inx)) < 0 || i >= b->len) + Range_Error(inx); + j = i/8; + mask = 1 << i%8; + old = b->data[j] & mask; + if (Truep(val)) + b->data[j] |= mask; + else + b->data[j] &= ~mask; + return old ? True : False; +} + +static Object P_Bitstring_Zerop(bs) Object bs; { + struct S_Bitstring *b; + int i; + + Check_Type(bs, T_Bitstring); + b = BITSTRING(bs); + for (i = bits_to_bytes(b->len); --i >= 0 && b->data[i] == 0 ;) + ; + return i < 0 ? True : False; +} + +static Object P_Bitstring_Fill(bs, fill) Object bs, fill; { + Check_Type(bs, T_Bitstring); + Check_Type(fill, T_Boolean); + Fill_Bitstring(bs, Truep(fill)); + return Void; +} + +#define bitop(name, op) static void name(a, b) struct S_Bitstring *a, *b; {\ + int i, rem;\ +\ + if (a->len != b->len) {\ + printf("bitstrings must be of same length\n"); exit(1);\ + }\ + i = bits_to_bytes(a->len) - 1;\ + if (rem = a->len % 8) {\ + a->data[i] op b->data[i];\ + a->data[i--] &= masks2[rem];\ + }\ + for ( ; i >= 0; i--)\ + a->data[i] op b->data[i];\ +} + +bitop(bmove, =) +bitop(bnot, = ~) +bitop(band, &=) +bitop(bor, |=) +bitop(bandnot, &= ~) +bitop(bxor, ^=) + +static Object Bit_Operation(b1, b2, fun) Object b1, b2; void (*fun)(); { + struct S_Bitstring *a, *b; + + Check_Type(b1, T_Bitstring); + Check_Type(b2, T_Bitstring); + a = BITSTRING(b1); + b = BITSTRING(b2); + if (a->len != b->len) + Primitive_Error("bitstrings must have identical length"); + fun(a, b); + return Void; +} + +static Object P_Bitstring_Move(a, b) Object a, b; { + return Bit_Operation(a, b, bmove); +} + +static Object P_Bitstring_Not(a, b) Object a, b; { + return Bit_Operation(a, b, bnot); +} + +static Object P_Bitstring_And(a, b) Object a, b; { + return Bit_Operation(a, b, band); +} + +static Object P_Bitstring_Or(a, b) Object a, b; { + return Bit_Operation(a, b, bor); +} + +static Object P_Bitstring_Andnot(a, b) Object a, b; { + return Bit_Operation(a, b, bandnot); +} + +static Object P_Bitstring_Xor(a, b) Object a, b; { + return Bit_Operation(a, b, bxor); +} + +static Object P_Substring_Move(b1, from, to, b2, dst) + Object b1, from, to, b2, dst; { + struct S_Bitstring *a, *b; + int start1, end1, start2, end2, len, off1, off2, i, j; + unsigned char mask; + + Check_Type(b1, T_Bitstring); + Check_Type(b2, T_Bitstring); + a = BITSTRING(b1); + b = BITSTRING(b2); + start1 = Get_Integer(from); + end1 = Get_Integer(to); + start2 = Get_Integer(dst); + len = end1 - start1; + end2 = start2 + len; + + if (start1 < 0 || start1 > end1) + Range_Error(from); + if (end1 > a->len) + Range_Error(to); + if (start2 < 0 || end2 > b->len) + Range_Error(dst); + + if (a == b && start2 < start1) { /* copy forward (LSB to MSB) */ + off1 = start1 % 8; + off2 = start2 % 8; + i = start1 / 8; + j = start2 / 8; + if (off1 == off2) { + if (off1) { + mask = 0xFF & ~masks2[off1]; + if (off1 + len < 8) + mask &= masks2[off1+len]; + b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); + len -= 8 - off1; i++; j++; + } + for (; len >= 8; len -= 8) + b->data[j++] = a->data[i++]; + if (len > 0) { + mask = masks2[len]; + b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); + } + } else { + unsigned char dmask; + int n, delta, shift; + + while (len > 0) { + shift = delta = off2 - off1; + if (shift < 0) + shift = -shift; + n = 8 - off1; + mask = 0xFF & ~masks2[off1]; + if (len < n) { + n = len; + mask &= masks2[off1+len]; + } + if (8 - off2 >= n) { /* rest of src byte fits into dst byte */ + + if (delta > 0) { + dmask = mask << shift; + b->data[j] = (b->data[j] & ~dmask) | + (a->data[i] & mask) << shift; + } else { + dmask = mask >> shift; + b->data[j] = (b->data[j] & ~dmask) | + (unsigned int)(a->data[i] & mask) >> shift; + } + } else { /* nope, copy as many bits as fit into dst bye */ + + n = 8 - off2; + mask &= masks2[off1+n]; + dmask = mask << shift; + b->data[j] = (b->data[j] & ~dmask) | + (a->data[i] & mask) << shift; + } + + if (off1 + n >= 8) i++; + if (off2 + n >= 8) j++; + off1 = (off1 + n) % 8; + off2 = (off2 + n) % 8; + len -= n; + } + } + } else { /* copy backwards (MSB to LSB) */ + + if ((off1 = end1 % 8 - 1) < 0) off1 = 7; + if ((off2 = end2 % 8 - 1) < 0) off2 = 7; + i = (end1 - 1) / 8; + j = (end2 - 1) / 8; + if (off1 == off2) { + if (off1 < 7) { + if (len <= off1) + mask = masks2[len] << off1-len+1; + else + mask = masks2[off1+1]; + b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); + len -= off1+1; i--; j--; + } + for (; len >= 8; len -= 8) + b->data[j--] = a->data[i--]; + if (len > 0) { + mask = masks2[len] << 8 - len; + b->data[j] = (b->data[j] & ~mask) | (a->data[i] & mask); + } + } else { + unsigned char dmask; + int n, delta, shift; + + while (len > 0) { + shift = delta = off2 - off1; + if (shift < 0) + shift = -shift; + n = off1 + 1; + mask = masks2[n]; + if (len < n) { + mask = masks2[len] << n-len; + n = len; + } + if (off2 + 1 >= n) { /* rest of src byte fits into dst byte */ + + if (delta > 0) { + dmask = mask << shift; + b->data[j] = (b->data[j] & ~dmask) | + (a->data[i] & mask) << shift; + } else { + dmask = mask >> shift; + b->data[j] = (b->data[j] & ~dmask) | + (unsigned int)(a->data[i] & mask) >> shift; + } + } else { /* nope, copy as many bits as fit into dst bye */ + + n = off2 + 1; + mask = masks2[n] << off1-n+1; + dmask = mask >> shift; + b->data[j] = (b->data[j] & ~dmask) | + (unsigned int)(a->data[i] & mask) >> shift; + } + + if (off1 - n < 0) i--; + if (off2 - n < 0) j--; + if ((off1 -= n) < 0) off1 += 8; + if ((off2 -= n) < 0) off2 += 8; + len -= n; + } + } + } + return Void; +} + +/*ARGSUSED*/ +static Object Bitstring_Read(port, chr, konst) Object port; int chr, konst; { + int c, str, i; + FILE *f; + char buf[1024], *p = buf; + Object ret; + + f = PORT(port)->file; + str = PORT(port)->flags & P_STRING; + while (1) { + Reader_Getc; + if (c == EOF) + Reader_Sharp_Eof; + if (Whitespace (c) || Delimiter (c)) + break; + if (p == buf+1024) + Reader_Error(port, "bitstring constant too long for reader"); + if (c != '0' && c != '1') + Reader_Error(port, "bad digit in bitstring constant"); + *p++ = c; + } + Reader_Ungetc; + ret = Make_Bitstring(p-buf); + for (i = 0; p > buf; i++) + if (*--p == '1') + BITSTRING(ret)->data[i/8] |= 1 << i%8; + return ret; +} + +#define Def_Prim Define_Primitive + +elk_init_lib_bitstring() { + T_Bitstring = Define_Type(0, "bitstring", Bitstring_Size, 0, + Bitstring_Equal, Bitstring_Equal, Bitstring_Print, NOFUNC); + Define_Reader('*', Bitstring_Read); + Def_Prim(P_Bitstringp, "bitstring?", 1, 1, EVAL); + Def_Prim(P_Bitstring_Equalp, "bitstring=?", 2, 2, EVAL); + Def_Prim(P_Make_Bitstring, "make-bitstring", 2, 2, EVAL); + Def_Prim(P_Bitstring_Length, "bitstring-length", 1, 1, EVAL); + Def_Prim(P_Int_To_Bitstring, "unsigned-integer->bitstring", 2, 2, EVAL); + Def_Prim(P_Bitstring_To_Int, "bitstring->unsigned-integer", 1, 1, EVAL); + Def_Prim(P_Bitstring_Ref, "bitstring-ref", 2, 2, EVAL); + Def_Prim(P_Bitstring_Set, "bitstring-set!", 3, 3, EVAL); + Def_Prim(P_Bitstring_Zerop, "bitstring-zero?", 1, 1, EVAL); + Def_Prim(P_Bitstring_Fill, "bitstring-fill!", 2, 2, EVAL); + Def_Prim(P_Bitstring_Move, "bitstring-move!", 2, 2, EVAL); + Def_Prim(P_Bitstring_Not, "bitstring-not!", 2, 2, EVAL); + Def_Prim(P_Bitstring_And, "bitstring-and!", 2, 2, EVAL); + Def_Prim(P_Bitstring_Or, "bitstring-or!", 2, 2, EVAL); + Def_Prim(P_Bitstring_Andnot, "bitstring-andnot!", 2, 2, EVAL); + Def_Prim(P_Bitstring_Xor, "bitstring-xor!", 2, 2, EVAL); + Def_Prim(P_Substring_Move, "bitstring-substring-move!", 5, 5, EVAL); + P_Provide (Intern ("bitstring.o")); +} diff --git a/lib/misc/build b/lib/misc/build new file mode 100755 index 0000000..cff35ec --- /dev/null +++ b/lib/misc/build @@ -0,0 +1,97 @@ +. ../../config/system +. ../../config/site + +if [ _$gdbm = _yes ]; then + gdbm_c="gdbm.c" + gdbm_o="gdbm.o" + gdbm_rule="gdbm.o: \$(H) gdbm.c" +else + gdbm_incl= +fi + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +CC= ${cc-cc} +CFLAGS= $cflags $obj_cflags +LINTFLAGS= $lintflags + +INC= ../../include + +H= \$(INC)/compat.h\\ + \$(INC)/config.h\\ + \$(INC)/cstring.h\\ + \$(INC)/exception.h\\ + \$(INC)/extern.h\\ + \$(INC)/funcproto.h\\ + \$(INC)/gc.h\\ + \$(INC)/misc.h\\ + \$(INC)/object.h\\ + \$(INC)/param.h\\ + \$(INC)/stkmem.h\\ + \$(INC)/type.h + +C= bitstring.c\\ + debug.c\\ + elk-eval.c\\ + hack.c\\ + monitor.c\\ + newhandler.c\\ + record.c\\ + regexp.c\\ + struct.c $gdbm_c + +O= bitstring.o\\ + debug.o\\ + elk-eval.o\\ + hack.o\\ + monitor.o\\ + newhandler.o\\ + record.o\\ + regexp.o\\ + struct.o $gdbm_o + +.c.o: + \$(CC) \$(CFLAGS) -I\$(INC) $gdbm_incl -c \$< + ../../scripts/makedl \$@ \$@ + +all: \$(O) + +bitstring.o: \$(H) bitstring.c +debug.o: \$(H) debug.c +elk-eval.o: \$(H) elk-eval.c +hack.o: \$(H) hack.c +monitor.o: \$(H) monitor.c +newhandler.o: \$(H) newhandler.c +record.o: \$(H) record.c +regexp.o: \$(H) regexp.c +struct.o: \$(H) struct.c +$gdbm_rule + +install: \$(O) + -@if [ ! -d $install_dir/runtime ]; then \\ + echo mkdir $install_dir/runtime; \\ + mkdir $install_dir/runtime; \\ + fi + -@if [ ! -d $install_dir/runtime/obj ]; then \\ + echo mkdir $install_dir/runtime/obj; \\ + mkdir $install_dir/runtime/obj; \\ + fi + @for i in \$(O) ;\\ + do \\ + echo cp \$\$i $install_dir/runtime/obj; \\ + cp \$\$i $install_dir/runtime/obj; \\ + done + +lint: + lint \$(LINTFLAGS) -I\$(INC) $gdbm_incl \$(C) + +clean: + rm -f *.o core + +distclean: + rm -f *.o core lint.out Makefile.local +EOT diff --git a/lib/misc/debug.c b/lib/misc/debug.c new file mode 100644 index 0000000..19d308c --- /dev/null +++ b/lib/misc/debug.c @@ -0,0 +1,11 @@ +#include "scheme.h" + +static Object P_Debug (on) Object on; { + Check_Type (on, T_Boolean); + GC_Debug = EQ(on, True); + return Void; +} + +elk_init_lib_debug () { + Define_Primitive (P_Debug, "debug", 1, 1, EVAL); +} diff --git a/lib/misc/elk-eval.c b/lib/misc/elk-eval.c new file mode 100644 index 0000000..33772d2 --- /dev/null +++ b/lib/misc/elk-eval.c @@ -0,0 +1,58 @@ +/* The function + * + * char *Elk_Eval(char *expr); + * + * is similar to Tcl_Eval() in Tcl. It is called with a Scheme expression + * encoded as a C string and returns the result of evaluating the expression + * (as another C string), or a null pointer if an error has occured + * during evaluation. + * + * Elk_Eval() stores its result in a static buffer of fixed size; this + * can be improved easily by passing a buffer and a length as additional + * arguments. + */ + +#include "scheme.h" + +static Object in, out; + +static char *String_Eval(expr) char *expr; { + Object str, res; + char *p; + GC_Node; + static char buf[1024]; + + str = Make_String(expr, strlen(expr)); + PORT(in)->name = str; + PORT(in)->ptr = 0; + res = General_Read(in, 0); + GC_Link(res); + res = Eval(res); + (void)General_Print_Object(res, out, 1); + str = P_Get_Output_String(out); + p = Get_String(str); + if (strlen(p) > sizeof buf - 1) + p = "too long"; + strcpy(buf, p); + GC_Unlink; + return buf; +} + +char *Elk_Eval(expr) char *expr; { + char *s; + + s = String_Eval("\ + (call-with-current-continuation (lambda (c)\ + (set! error-handler (lambda a (print a) (c #f))) #t))\ + "); + if (strcmp(s, "#f") == 0) + return 0; + return String_Eval(expr); +} + +elk_init_eval() { + in = P_Open_Input_String(Make_String("", 0)); + Global_GC_Link(in); + out = P_Open_Output_String(); + Global_GC_Link(out); +} diff --git a/lib/misc/gdbm.c b/lib/misc/gdbm.c new file mode 100644 index 0000000..13c4b80 --- /dev/null +++ b/lib/misc/gdbm.c @@ -0,0 +1,262 @@ +/* Elk/GDBM-interface. + * + * Original version by Martin Stut . + * + * Functions exported: + * + * (gdbm-file? obj) + * + * Type predicate for the newly defined type gdbm-file. + * + * (gdbm-open filename block-size type [filemode]) + * + * Opens a gdbm file and returns an object of type gdbm-file. + * Returns #f if file cannot be opened. + * filename is a string or a symbol, block-size is an integer, + * type is one of the symbols 'reader, 'writer, 'create, and 'new, + * the optional file mode is an integer (default: #o644). + * + * (gdbm-close gf) + * + * Closes a gdbm file. Attempts to use a closed gdbm file as + * an argument to any gdbm-function causes the error message + * "invalid gdbm-file" to be displayed. + * + * (gdbm-store gf key data mode) + * + * Stores an item in the gdbm file pointed to by gf. + * key and data are strings, mode is a symbol (either 'insert + * or 'replace). + * Returns -1 if called by a reader, 1 if called with 'insert and + * the key is already stored, 0 otherwise. + * + * (gdbm-fetch gf key) + * + * Searches the gdbm file pointed to by gf for data stored under + * the given key and returns the data as a string. + * Returns #f if nothing is stored under that key. + * + * (gdbm-delete gf key) + * + * Removes data stored under the specified key from the gdbm file gf. + * Returns #f if the key is not present in the gdbm file, #t otherwise. + * + * (gdbm-firstkey gf) + * (gdbm-nextkey gf key) + * + * These functions are used to access all items in a gdbm file. + * Both return a key. gdbm-firstkey returns #f if the gdbm file + * is empty; gdbm-nextkey returns #f if there is no next key. + * + * (gdbm-reorganize gf) + * + * Shortens the specified gdbm file (reclaims deleted space). + * + * (gdbm-error) + * + * Returns a cons cell; the car is the last error number set by + * the gdbm library, the cdr is the current UNIX errno. + * + * (gdbm-error-text) + * + * Returns the last error message passed to the fatal error + * function by the gdbm library (a string). + * + * Loading gdbm.o provides the symbol 'gdbm.o. + */ + + +#include "scheme.h" +#include +#include + +extern gdbm_error gdbm_errno; +extern int errno; +static char *gdbm_error_message = ""; + +static SYMDESCR RW_Syms[] = { + { "reader", GDBM_READER }, + { "writer", GDBM_WRITER }, + { "create", GDBM_WRCREAT }, + { "new", GDBM_NEWDB }, + { 0, 0 } +}; + +static SYMDESCR Flag_Syms[] = { + { "insert", GDBM_INSERT }, + { "replace", GDBM_REPLACE }, + { 0, 0 } +}; + +int T_Gdbm_fh; + +struct S_gdbm_fh{ + Object tag; + GDBM_FILE fptr; + char free; +}; + +#define GDBM_FH(obj) ((struct S_gdbm_fh *)POINTER(obj)) + +int Gdbm_fh_Equal (a, b) Object a, b; { + return !GDBM_FH(a)->free && !GDBM_FH(b)->free && + GDBM_FH(a)->fptr == GDBM_FH(b)->fptr; +} + +/*ARGSUSED*/ +Gdbm_fh_Print (fh, port, raw, depth, len) Object fh, port; + int /*Bool*/ raw; int depth, len; { + Printf (port, "#[gdbm-file %lu]", GDBM_FH(fh)->fptr); +} + +Object P_Gdbm_filep (x) Object x; { + return TYPE(x) == T_Gdbm_fh ? True : False; +} + +static void Fatal_Func (s) char *s; { + gdbm_error_message = s; + fprintf (stderr, "gdbm error: %s\n", s); +} + +Object P_Gdbm_Open (argc, argv) Object *argv; { + Object Gdbm_fh; + GDBM_FILE dbf; + + Disable_Interrupts; + dbf = gdbm_open (Get_Strsym (argv[0]), Get_Integer (argv[1]), + Symbols_To_Bits (argv[2], 0, RW_Syms), + argc == 4 ? Get_Integer (argv[3]) : 0644, Fatal_Func); + if (dbf == 0) { + Enable_Interrupts; + return False; + } + Gdbm_fh = Alloc_Object (sizeof (struct S_gdbm_fh), T_Gdbm_fh, 0); + GDBM_FH (Gdbm_fh)->tag = Null; + GDBM_FH (Gdbm_fh)->fptr = dbf; + GDBM_FH (Gdbm_fh)->free = 0; + Enable_Interrupts; + return Gdbm_fh; +} + +GDBM_FILE Check_Fh (fh) Object fh; { + Check_Type (fh, T_Gdbm_fh); + if (GDBM_FH(fh)->free) + Primitive_Error ("invalid gdbm-file: ~s", fh); +} + +Object P_Gdbm_Close (fh) Object fh; { + Check_Fh (fh); + GDBM_FH(fh)->free = 1; + Disable_Interrupts; + gdbm_close (GDBM_FH(fh)->fptr); + Enable_Interrupts; + return Void; +} + +Object P_Gdbm_Store (fh, key, content, flag) + Object fh, key, content, flag; { + int res; + datum k, c; + + Check_Fh (fh); + Check_Type (key, T_String); + Check_Type (content, T_String); + k.dptr = STRING(key)->data; + k.dsize = STRING(key)->size; + c.dptr = STRING(content)->data; + c.dsize = STRING(content)->size; + Disable_Interrupts; + res = gdbm_store (GDBM_FH(fh)->fptr, k, c, + Symbols_To_Bits (flag, 0, Flag_Syms)); + Enable_Interrupts; + return Make_Integer (res); +} + +static Object Gdbm_Get (fh, key, func) Object fh, key; datum (*func)(); { + Object res; + datum k, c; + + Check_Fh (fh); + Check_Type (key, T_String); + k.dptr = STRING(key)->data; + k.dsize = STRING(key)->size; + Disable_Interrupts; + c = (*func) (GDBM_FH(fh)->fptr, k); + Enable_Interrupts; + if (c.dptr == 0) + return False; + res = Make_String (c.dptr, c.dsize); + free (c.dptr); + return res; +} + +Object P_Gdbm_Fetch (fh, key) Object fh, key; { + return Gdbm_Get (fh, key, gdbm_fetch); +} + +Object P_Gdbm_Nextkey (fh, key) Object fh, key; { + return Gdbm_Get (fh, key, gdbm_nextkey); +} + +Object P_Gdbm_Delete (fh, key) Object fh, key; { + int res; + datum k; + + Check_Fh (fh); + Check_Type (key, T_String); + k.dptr = STRING(key)->data; + k.dsize = STRING(key)->size; + Disable_Interrupts; + res = gdbm_delete (GDBM_FH(fh)->fptr, k); + Enable_Interrupts; + return res == 0 ? True : False; +} + +Object P_Gdbm_Firstkey (fh) Object fh; { + Object res; + datum k; + + Check_Fh (fh); + Disable_Interrupts; + k = gdbm_firstkey (GDBM_FH(fh)->fptr); + Enable_Interrupts; + if (k.dptr == 0) + return False; + res = Make_String (k.dptr, k.dsize); + free (k.dptr); + return res; +} + +Object P_Gdbm_Reorganize (fh) Object fh; { + Check_Fh (fh); + Disable_Interrupts; + gdbm_reorganize (GDBM_FH(fh)->fptr); + Enable_Interrupts; + return Void; +} + +Object P_Gdbm_Error () { + return Cons (Make_Integer ((int)gdbm_errno), Make_Integer (errno)); +} + +Object P_Gdbm_Error_Text () { + return Make_String (gdbm_error_message, strlen (gdbm_error_message)); +} + +elk_init_lib_gdbm () { + Define_Primitive (P_Gdbm_Open, "gdbm-open", 3, 4, VARARGS); + Define_Primitive (P_Gdbm_filep, "gdbm-file?", 1, 1, EVAL); + Define_Primitive (P_Gdbm_Close, "gdbm-close", 1, 1, EVAL); + Define_Primitive (P_Gdbm_Store, "gdbm-store", 4, 4, EVAL); + Define_Primitive (P_Gdbm_Fetch, "gdbm-fetch", 2, 2, EVAL); + Define_Primitive (P_Gdbm_Delete, "gdbm-delete", 2, 2, EVAL); + Define_Primitive (P_Gdbm_Firstkey, "gdbm-firstkey", 1, 1, EVAL); + Define_Primitive (P_Gdbm_Nextkey, "gdbm-nextkey", 2, 2, EVAL); + Define_Primitive (P_Gdbm_Reorganize, "gdbm-reorganize", 1, 1, EVAL); + Define_Primitive (P_Gdbm_Error, "gdbm-error", 0, 0, EVAL); + Define_Primitive (P_Gdbm_Error_Text, "gdbm-error-text", 0, 0, EVAL); + T_Gdbm_fh = Define_Type (0, "gdbm-file", NOFUNC, + sizeof (struct S_gdbm_fh), Gdbm_fh_Equal, Gdbm_fh_Equal, + Gdbm_fh_Print, NOFUNC); + P_Provide (Intern ("gdbm.o")); +} diff --git a/lib/misc/hack.c b/lib/misc/hack.c new file mode 100644 index 0000000..4d761eb --- /dev/null +++ b/lib/misc/hack.c @@ -0,0 +1,14 @@ +#include "scheme.h" + +static Object P_Hack_Procedure_Environment (p, e) Object p, e; { + Check_Type (p, T_Compound); + Check_Type (e, T_Environment); + COMPOUND(p)->env = e; + return p; +} + +elk_init_lib_hack () { + Define_Primitive (P_Hack_Procedure_Environment, + "hack-procedure-environment!", 2, 2, EVAL); + P_Provide (Intern ("hack.o")); +} diff --git a/lib/misc/monitor.c b/lib/misc/monitor.c new file mode 100644 index 0000000..747f81b --- /dev/null +++ b/lib/misc/monitor.c @@ -0,0 +1,65 @@ +/* A trivial function to enable and disable execution profiling. + * + * Evaluate "(monitor #t)" to enable profiling; "(monitor #f)" to + * disable profiling and create a mon.out (this is done automatically + * on exit by means of an extension finalization function). + * + * + * This extension may not work on some platforms. + * + * On DECstations running Ultrix, you may have to evaluate + * (set! load-libraries "/usr/lib/cmplrs/cc/libprof1_G0.a -lc_G0") + * before loading monitor.o. + * + * On older versions of BSD and SunOS you might have to + * ar x /lib/libc.a mon.o + * and replace in the symbol table of mon.o the symbols mcount and + * _moncontrol by something else (e.g. Mcount and _Mcontrol); then + * ld -r mon.o monitor.o; mv a.out monitor.o; rm mon.o + * Or you might have to + * cp /lib/mcrt0.o mon.o, + * then, in mon.o, replace start by Start and _environ by _Environ + * and call the linker as shown above. You can do the symbol table + * hacking by editing mon.o with emacs. + */ + + +#include "scheme.h" + +#include + +#define MONSTART 2 + +static monitoring; + +static Object P_Monitor (on) Object on; { + char *brk; + extern char *sbrk(); + + Check_Type (on, T_Boolean); + Disable_Interrupts; + if (Truep (on)) { + if (!monitoring) { + brk = sbrk (0); + monstartup ((int (*)())MONSTART, (int (*)())brk); + monitoring = 1; + } + } else { + monitor (0); + monitoring = 0; + } + Enable_Interrupts; + return Void; +} + +elk_init_lib_monitor () { + Define_Primitive (P_Monitor, "monitor", 1, 1, EVAL); +} + +elk_finit_lib_monitor () { + if (monitoring) { + monitoring = 0; + printf ("[writing mon.out]\n"); + monitor (0); + } +} diff --git a/lib/misc/newhandler.c b/lib/misc/newhandler.c new file mode 100644 index 0000000..025ab69 --- /dev/null +++ b/lib/misc/newhandler.c @@ -0,0 +1,27 @@ +#include "scheme.h" + +#ifdef USE_ATTC_PLUS_PLUS +# define set_new_handler set_new_handler__FPFv_v +#endif + +static Object New_Handler; + +static void New_Handler_Proc () { + (void)Funcall (New_Handler, Null, 0); +} + +static Object P_Set_New_Handler (p) Object p; { + Object old; + + Check_Procedure (p); + old = New_Handler; + New_Handler = p; + return old; +} + +elk_init_lib_cplusplus () { + New_Handler = Null; + Global_GC_Link (New_Handler); + set_new_handler (New_Handler_Proc); + Define_Primitive (P_Set_New_Handler, "set-c++-new-handler!", 1, 1, EVAL); +} diff --git a/lib/misc/record.c b/lib/misc/record.c new file mode 100644 index 0000000..2990d8d --- /dev/null +++ b/lib/misc/record.c @@ -0,0 +1,135 @@ +#include "scheme.h" + +#define RTD(x) ((struct S_Rtd *)POINTER(x)) +#define RECORD(x) ((struct S_Record *)POINTER(x)) + +struct S_Rtd { + Object name; + Object fields; +}; + +struct S_Record { + Object rtd; + Object values; +}; + +int T_Rtd, T_Record; + +static Object P_Rtdp (x) Object x; { + return TYPE(x) == T_Rtd ? True : False; +} + +static Object P_Recordp (x) Object x; { + return TYPE(x) == T_Record ? True : False; +} + +static Object P_Rtd_Name (x) Object x; { + Check_Type (x, T_Rtd); + return RTD(x)->name; +} + +static Object P_Rtd_Field_Names (x) Object x; { + Check_Type (x, T_Rtd); + return RTD(x)->fields; +} + +static Object P_Make_Record_Type (name, fields) Object name, fields; { + Object s, ismem; + GC_Node2; + + if (TYPE(name) == T_Symbol) + name = SYMBOL(name)->name; + else if (TYPE(name) != T_String) + Wrong_Type_Combination (name, "string or symbol"); + Check_List (fields); + for (s = fields; !Nullp (s); s = Cdr (s)) { + Check_Type (Car (s), T_Symbol); + ismem = P_Memq (Car (s), Cdr (s)); + if (Truep (ismem)) + Primitive_Error ("duplicate field name"); + } + GC_Link2 (name, fields); + s = Alloc_Object (sizeof (struct S_Rtd), T_Rtd, 0); + RTD(s)->name = name; + RTD(s)->fields = fields; + GC_Unlink; + return s; +} + +static Object P_Record_Type (x) Object x; { + Check_Type (x, T_Record); + return RECORD(x)->rtd; +} + +static Object P_Record_Values (x) Object x; { + Check_Type (x, T_Record); + return RECORD(x)->values; +} + +static Object P_Make_Record (rtd, values) Object rtd, values; { + Object s; + GC_Node2; + + Check_Type (rtd, T_Rtd); + Check_Type (values, T_Vector); + if (VECTOR(values)->size != Fast_Length (RTD(rtd)->fields)) + Primitive_Error ("wrong number of fields for record type"); + GC_Link2 (rtd, values); + s = Alloc_Object (sizeof (struct S_Record), T_Record, 0); + RECORD(s)->rtd = rtd; + RECORD(s)->values = values; + GC_Unlink; + return s; +} + +static Rtd_Eqv (a, b) Object a, b; { return EQ(a,b); } +#define Record_Eqv Rtd_Eqv + +static Rtd_Equal (a, b) Object a, b; { + return EQ(RTD(a)->name, RTD(b)->name) && + Equal (RTD(a)->fields, RTD(b)->fields); +} + +static Record_Equal (a, b) Object a, b; { + return EQ(RECORD(a)->rtd, RECORD(b)->rtd) && + Equal (RECORD(a)->values, RECORD(b)->values); +} + +static Rtd_Print (x, port, raw, depth, length) Object x, port; { + struct S_String *s = STRING(RTD(x)->name); + Printf (port, "#[%.*s-record-type %lu]", s->size, s->data, POINTER(x)); +} + +static Record_Print (x, port, raw, depth, length) Object x, port; { + struct S_String *s = STRING(RTD(RECORD(x)->rtd)->name); + Printf (port, "#[%.*s-record-type %lu]", s->size, s->data, POINTER(x)); +} + +static Rtd_Visit (sp, f) register Object *sp; register (*f)(); { + (*f)(&RTD(*sp)->name); + (*f)(&RTD(*sp)->fields); +} + +static Record_Visit (sp, f) register Object *sp; register (*f)(); { + (*f)(&RECORD(*sp)->rtd); + (*f)(&RECORD(*sp)->values); +} + +#define Def_Prim Define_Primitive + +elk_init_lib_record () { + T_Rtd = Define_Type (0, "record-type", NOFUNC, sizeof (struct S_Rtd), + Rtd_Eqv, Rtd_Equal, Rtd_Print, Rtd_Visit); + Def_Prim (P_Rtdp, "record-type?", 1, 1, EVAL); + Def_Prim (P_Rtd_Name, "record-type-name", 1, 1, EVAL); + Def_Prim (P_Rtd_Field_Names, "record-type-field-names", 1, 1, EVAL); + Def_Prim (P_Make_Record_Type, "make-record-type", 2, 2, EVAL); + + T_Record = Define_Type (0, "record", NOFUNC, sizeof (struct S_Record), + Record_Eqv, Record_Equal, Record_Print, Record_Visit); + Def_Prim (P_Recordp, "record?", 1, 1, EVAL); + Def_Prim (P_Record_Type, "record-type-descriptor", 1, 1, EVAL); + Def_Prim (P_Record_Values, "record-values", 1, 1, EVAL); + Def_Prim (P_Make_Record, "make-record", 2, 2, EVAL); + P_Provide (Intern ("record.o")); +} diff --git a/lib/misc/regexp.c b/lib/misc/regexp.c new file mode 100644 index 0000000..384f05e --- /dev/null +++ b/lib/misc/regexp.c @@ -0,0 +1,222 @@ +/* The regular expression extension. It provides Scheme language + * bindings to the POSIX regcomp/regexec functions. + * + * Inspired by a GNU regular expression extension contributed by + * Stephen J. Bevan to an earlier version of Elk. + */ + +#include "scheme.h" + +#ifdef REGCOMP + +#include +#include + +#define REGEXP(x) ((struct S_Regexp *)POINTER(x)) +#define MATCH(x) ((struct S_Match *)POINTER(x)) + +struct S_Regexp { + Object pattern; + regex_t r; + int flags; +}; + +struct S_Match { + Object tag; + size_t num; + regmatch_t matches[1]; +}; + +int T_Regexp, T_Match; + +static SYMDESCR Compile_Syms[] = { + { "extended", REG_EXTENDED }, + { "ignore-case", REG_ICASE }, + { "no-subexpr", REG_NOSUB }, + { "newline", REG_NEWLINE }, + { 0, 0 } +}; + +static SYMDESCR Exec_Syms[] = { + { "not-bol", REG_NOTBOL }, + { "not-eol", REG_NOTEOL }, + { 0, 0 } +}; + +static Object P_Regexpp(x) Object x; { + return TYPE(x) == T_Regexp ? True : False; +} + +static Object P_Matchp(x) Object x; { + return TYPE(x) == T_Match ? True : False; +} + +static Regexp_Eqv(a, b) Object a, b; { + return EQ(REGEXP(a)->pattern, REGEXP(b)->pattern) + && REGEXP(a)->flags == REGEXP(b)->flags; +} + +static Regexp_Equal(a, b) Object a, b; { + return Equal(REGEXP(a)->pattern, REGEXP(b)->pattern) + && REGEXP(a)->flags == REGEXP(b)->flags; +} + +static Match_Equal(a, b) Object a, b; { + size_t i; + struct S_Match *ap = MATCH(a), *bp = MATCH(b); + + if (ap->num != bp->num) + return 0; + for (i = 0; i < ap->num; i++) { + if (ap->matches[i].rm_so != bp->matches[i].rm_so || + ap->matches[i].rm_eo != bp->matches[i].rm_eo) + return 0; + } + return 1; +} + +static int Match_Size(m) Object m; { + return sizeof(struct S_Match) + (MATCH(m)->num - 1) * sizeof(regmatch_t); +} + +static Regexp_Visit(p, f) Object *p; int (*f)(); { + f(®EXP(*p)->pattern); +} + +static Regexp_Print(x, port, raw, depth, length) Object x, port; { + Format(port, "#[regexp ~s]", 12, 1, ®EXP(x)->pattern); +} + +static Match_Print(x, port, raw, depth, length) Object x, port; { + Printf(port, "#[regexp-match %lu]", POINTER(x)); +} + +static Object Terminate_Regexp(r) Object r; { + regfree(®EXP(r)->r); + return Void; +} + +static Object P_Make_Regexp(argc, argv) Object *argv; { + Object r; + char *s; + char msg[256]; + int flags = 0, ret; + + Check_Type(argv[0], T_String); + if (argc == 2) + flags = Symbols_To_Bits(argv[1], 1, Compile_Syms); + r = Alloc_Object(sizeof(struct S_Regexp), T_Regexp, 0); + REGEXP(r)->pattern = argv[0]; + REGEXP(r)->flags = flags; + ret = regcomp(®EXP(r)->r, Get_String(argv[0]), flags); + if (ret != 0) { +#ifdef REG_ENOSYS + if (ret == REG_ENOSYS) + Primitive_Error("function not supported by operating system"); +#endif + (void)regerror(ret, ®EXP(r)->r, msg, sizeof(msg)); + Primitive_Error("~a", Make_String(msg, strlen(msg))); + } + Register_Object(r, (GENERIC)0, Terminate_Regexp, 0); + return r; +} + +static Object P_Regexp_Pattern(r) Object r; { + Check_Type(r, T_Regexp); + return REGEXP(r)->pattern; +} + +static Object P_Regexp_Flags(r) Object r; { + Check_Type(r, T_Regexp); + return Bits_To_Symbols((unsigned long)REGEXP(r)->flags, 1, Compile_Syms); +} + +static Object P_Regexp_Exec(argc, argv) Object *argv; { + char *str, msg[256]; + Object r, m; + size_t num; + int from, flags, ret; + GC_Node; + + r = argv[0]; + Check_Type(r, T_Regexp); + Check_Type(argv[1], T_String); + str = Get_String(argv[1]); + from = Get_Unsigned(argv[2]); + if (from > STRING(argv[1])->size) + Range_Error(argv[2]); + if (argc == 4) + flags = (int)Symbols_To_Bits(argv[3], 1, Exec_Syms); + else + flags = 0; + if (REGEXP(r)->flags & REG_NOSUB) + num = 1; + else + num = REGEXP(r)->r.re_nsub + 1; + GC_Link(r); + m = Alloc_Object(sizeof(struct S_Match) + (num-1) * sizeof(regmatch_t), + T_Match, 0); + GC_Unlink; + MATCH(m)->tag = Null; + if (REGEXP(r)->flags & REG_NOSUB) + num = 0; + MATCH(m)->num = num; + ret = regexec(®EXP(r)->r, str+from, num, MATCH(m)->matches, flags); + if (ret == 0) + return m; + if (ret == REG_NOMATCH) + return False; + (void)regerror(ret, ®EXP(r)->r, msg, sizeof(msg)); + Primitive_Error("~a", Make_String(msg, strlen(msg))); + /*NOTREACHED*/ +} + +static Object P_Match_Number(m) Object m; { + Check_Type(m, T_Match); + return Make_Unsigned_Long((unsigned long)MATCH(m)->num); +} + +static Object P_Match_Start(m, n) Object m, n; { + size_t i; + + Check_Type(m, T_Match); + i = (size_t)Get_Unsigned_Long(n); + if (i >= MATCH(m)->num) + Range_Error(n); + return Make_Unsigned_Long((unsigned long)MATCH(m)->matches[i].rm_so); +} + +static Object P_Match_End(m, n) Object m, n; { + size_t i; + + Check_Type(m, T_Match); + i = (size_t)Get_Unsigned_Long(n); + if (i >= MATCH(m)->num) + Range_Error(n); + return Make_Unsigned_Long((unsigned long)MATCH(m)->matches[i].rm_eo); +} + + +#define Def_Prim Define_Primitive + +#endif /* REGCOMP */ + +elk_init_lib_regexp() { +#ifdef REGCOMP + T_Regexp = Define_Type(0, "regexp", 0, sizeof(struct S_Regexp), + Regexp_Eqv, Regexp_Equal, Regexp_Print, Regexp_Visit); + T_Match = Define_Type(0, "regexp-match", Match_Size, 0, + Match_Equal, Match_Equal, Match_Print, 0); + Def_Prim(P_Regexpp, "regexp?", 1, 1, EVAL); + Def_Prim(P_Matchp, "regexp-match?", 1, 1, EVAL); + Def_Prim(P_Make_Regexp, "make-regexp", 1, 2, VARARGS); + Def_Prim(P_Regexp_Pattern,"regexp-pattern", 1, 1, EVAL); + Def_Prim(P_Regexp_Flags, "regexp-flags", 1, 1, EVAL); + Def_Prim(P_Regexp_Exec, "regexp-exec", 3, 4, VARARGS); + Def_Prim(P_Match_Number, "regexp-match-number", 1, 1, EVAL); + Def_Prim(P_Match_Start, "regexp-match-start", 2, 2, EVAL); + Def_Prim(P_Match_End, "regexp-match-end", 2, 2, EVAL); + P_Provide(Intern(":regular-expressions")); +#endif + P_Provide(Intern ("regexp.o")); +} diff --git a/lib/misc/struct.c b/lib/misc/struct.c new file mode 100644 index 0000000..22a6a87 --- /dev/null +++ b/lib/misc/struct.c @@ -0,0 +1,110 @@ +/* The `structure' extension is obsolete and should not be used in + * applications any longer; it has been replaced by the more powerful + * `record' extension. + */ + +#include "scheme.h" + +#define STRUCT(x) ((struct S_Struct *)POINTER(x)) + +struct S_Struct { + Object name; + Object slots; + Object values; +}; + +int T_Struct; + +static Object P_Structurep (x) Object x; { + return TYPE(x) == T_Struct ? True : False; +} + +static Object P_Structure_Name (x) Object x; { + Check_Type (x, T_Struct); + return STRUCT(x)->name; +} + +static Object P_Structure_Slots (x) Object x; { + Check_Type (x, T_Struct); + return P_Vector_To_List (STRUCT(x)->slots); +} + +static Object P_Structure_Values (x) Object x; { + Check_Type (x, T_Struct); + return P_Vector_To_List (STRUCT(x)->values); +} + +static Check_Structure_Type (x, t) Object x, t; { + Check_Type (x, T_Struct); + Check_Type (t, T_Symbol); + if (!EQ(STRUCT(x)->name, t)) + Primitive_Error ("wrong structure type ~s (expected ~s)", + STRUCT(x)->name, t); +} + +static Object P_Structure_Ref (x, t, n) Object x, t, n; { + Check_Structure_Type (x, t); + return P_Vector_Ref (STRUCT(x)->values, n); +} + +static Object P_Structure_Set (x, t, n, obj) Object x, t, n, obj; { + Check_Structure_Type (x, t); + return P_Vector_Set (STRUCT(x)->values, n, obj); +} + +static Object P_Make_Structure (name, slots) Object name, slots; { + register n; + Object s, vec, *vp; + GC_Node3; + + Check_Type (name, T_Symbol); + Check_List (slots); + s = Null; + GC_Link3 (s, name, slots); + s = Alloc_Object (sizeof (struct S_Struct), T_Struct, 0); + STRUCT(s)->name = name; + STRUCT(s)->values = STRUCT(s)->slots = Null; + n = Fast_Length (slots); + vec = Make_Vector (n, Null); + STRUCT(s)->values = vec; + vec = Make_Vector (n, Null); + STRUCT(s)->slots = vec; + GC_Unlink; + for (vp = VECTOR(vec)->data; n--; slots = Cdr (slots)) { + Check_Type (Car (slots), T_Symbol); + *vp++ = Car (slots); + } + return s; +} + +static Structure_Eqv (a, b) Object a, b; { return EQ(a,b); } + +static Structure_Equal (a, b) Object a, b; { + return EQ(STRUCT(a)->name,STRUCT(b)->name) && + Equal (STRUCT(a)->slots, STRUCT(b)->slots) && + Equal (STRUCT(a)->values, STRUCT(b)->values); +} + +static Structure_Print (x, port, raw, depth, length) Object x, port; { + struct S_String *s = STRING(SYMBOL(STRUCT(x)->name)->name); + Printf (port, "#[%.*s-structure %lu]", s->size, s->data, POINTER(x)); +} + +static Structure_Visit (sp, f) register Object *sp; register (*f)(); { + (*f)(&STRUCT(*sp)->name); + (*f)(&STRUCT(*sp)->slots); + (*f)(&STRUCT(*sp)->values); +} + +elk_init_lib_struct () { + T_Struct = Define_Type (0, "structure", NOFUNC, sizeof (struct S_Struct), + Structure_Eqv, Structure_Equal, Structure_Print, Structure_Visit); + Define_Primitive (P_Structurep, "structure?", 1, 1, EVAL); + Define_Primitive (P_Structure_Name, "structure-name", 1, 1, EVAL); + Define_Primitive (P_Structure_Slots, "structure-slots", 1, 1, EVAL); + Define_Primitive (P_Structure_Values, "structure-values", 1, 1, EVAL); + Define_Primitive (P_Structure_Ref, "structure-ref", 3, 3, EVAL); + Define_Primitive (P_Structure_Set, "structure-set!", 4, 4, EVAL); + Define_Primitive (P_Make_Structure, "make-structure", 2, 2, EVAL); + P_Provide (Intern ("struct.o")); +} diff --git a/lib/unix/Makefile b/lib/unix/Makefile new file mode 100644 index 0000000..cd1a7d3 --- /dev/null +++ b/lib/unix/Makefile @@ -0,0 +1,24 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../../config/system ../../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + +lint: Makefile.local + $(MAKE) -f Makefile.local lint + +clean: Makefile.local + $(MAKE) -f Makefile.local clean + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/lib/unix/TODO b/lib/unix/TODO new file mode 100644 index 0000000..3dcb58d --- /dev/null +++ b/lib/unix/TODO @@ -0,0 +1,5 @@ +termio +stdio (setbuf, fseek, ...) +signals: handlers that may return (to be invoked in Funcall?) +support for systems with "union wait" (vanilla BSD, Mach, ...) +sysconf: NGROUP_MAX, etc. diff --git a/lib/unix/build b/lib/unix/build new file mode 100755 index 0000000..456ff93 --- /dev/null +++ b/lib/unix/build @@ -0,0 +1,108 @@ +. ../../config/system +. ../../config/site + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +CC= ${cc-cc} +CFLAGS= $cflags $obj_cflags +LINTFLAGS= $lintflags + +INC= ../../include + +H= \$(INC)/compat.h\\ + \$(INC)/config.h\\ + \$(INC)/cstring.h\\ + \$(INC)/exception.h\\ + \$(INC)/extern.h\\ + \$(INC)/funcproto.h\\ + \$(INC)/gc.h\\ + \$(INC)/misc.h\\ + \$(INC)/object.h\\ + \$(INC)/param.h\\ + \$(INC)/stkmem.h\\ + \$(INC)/type.h\\ + unix.h + +C= error.c\\ + fdescr.c\\ + file.c\\ + lock.c\\ + misc.c\\ + passwd.c\\ + process.c\\ + signal.c\\ + system.c\\ + temp.c\\ + time.c\\ + unix.c\\ + wait.c + +O= error.o\\ + fdescr.o\\ + file.o\\ + lock.o\\ + misc.o\\ + passwd.o\\ + process.o\\ + signal.o\\ + system.o\\ + temp.o\\ + time.o\\ + unix.o\\ + wait.o + +all: \$(O) unix.pre + +.c.o: + \$(CC) \$(CFLAGS) -I\$(INC) -c \$< + +error.o: \$(H) error.c +fdescr.o: \$(H) fdescr.c +file.o: \$(H) file.c +lock.o: \$(H) lock.c +misc.o: \$(H) misc.c +passwd.o: \$(H) passwd.c +process.o: \$(H) process.c +signal.o: \$(H) signal.c +system.o: \$(H) system.c +temp.o: \$(H) temp.c +time.o: \$(H) time.c +unix.o: \$(H) unix.c +wait.o: \$(H) wait.c + +unix.pre: \$(O) + ../../scripts/makedl \$@ \$(O) + +install: unix.pre + -@if [ ! -d $install_dir/runtime ]; then \\ + echo mkdir $install_dir/runtime; \\ + mkdir $install_dir/runtime; \\ + fi + -@if [ ! -d $install_dir/runtime/obj ]; then \\ + echo mkdir $install_dir/runtime/obj; \\ + mkdir $install_dir/runtime/obj; \\ + fi + cp unix.pre $install_dir/runtime/obj/unix.o + -@if [ ! -d $install_dir/include ]; then \\ + echo mkdir $install_dir/include; \\ + mkdir $install_dir/include; \\ + fi + -@if [ ! -d $install_dir/include/extensions ]; then \\ + echo mkdir $install_dir/include/extensions; \\ + mkdir $install_dir/include/extensions; \\ + fi + cp unix.h $install_dir/include/extensions + +lint: + lint \$(LINTFLAGS) -I\$(INC) \$(C) + +clean: + rm -f *.o unix.pre core + +distclean: + rm -f *.o unix.pre core lint.out Makefile.local +EOT diff --git a/lib/unix/error.c b/lib/unix/error.c new file mode 100644 index 0000000..0da79b0 --- /dev/null +++ b/lib/unix/error.c @@ -0,0 +1,88 @@ +#include "unix.h" + +/* We can't know which error codes exist on a given platform. The + * following are the POSIX codes plus a few more that are available + * almost everywhere. + * Unfortunately, "(unix-errno)" has to return other error codes as + * plain integers; they have to be dealt with in Scheme. + */ +static SYMDESCR Errno_Syms[] = { + { "e2big", E2BIG}, + { "eacces", EACCES}, + { "eagain", EAGAIN}, + { "ebadf", EBADF}, + { "ebusy", EBUSY}, + { "echild", ECHILD}, +#ifdef EDEADLK + { "edeadlk", EDEADLK}, +#endif + { "edom", EDOM}, + { "eexist", EEXIST}, + { "efault", EFAULT}, + { "efbig", EFBIG}, + { "eintr", EINTR}, + { "einval", EINVAL}, + { "eio", EIO}, + { "eisdir", EISDIR}, + { "emfile", EMFILE}, + { "emlink", EMLINK}, + { "enametoolong", ENAMETOOLONG}, + { "enfile", ENFILE}, + { "enodev", ENODEV}, + { "enoent", ENOENT}, + { "enoexec", ENOEXEC}, +#ifdef ENOLCK + { "enolck", ENOLCK}, +#endif + { "enomem", ENOMEM}, + { "enospc", ENOSPC}, +#ifdef ENOSYS + { "enosys", ENOSYS}, +#endif + { "enotdir", ENOTDIR}, + { "enotempty", ENOTEMPTY}, + { "enotty", ENOTTY}, + { "enxio", ENXIO}, + { "eperm", EPERM}, + { "epipe", EPIPE}, + { "erange", ERANGE}, + { "erofs", EROFS}, + { "espipe", ESPIPE}, + { "esrch", ESRCH}, + { "exdev", EXDEV}, +#ifdef EWOULDBLOCK + { "ewouldblock", EWOULDBLOCK }, +#endif +#ifdef ELOOP + { "eloop", ELOOP }, +#endif +#ifdef EDQUOT + { "edquot", EDQUOT }, +#endif + { 0, 0 } +}; + +Object Unix_Errobj, V_Call_Errhandler; + +static Object P_Errorp(x) Object x; { + return EQ(x, Unix_Errobj) ? True : False; +} + +static Object P_Errno() { + Object sym; + + sym = Bits_To_Symbols(Saved_Errno, 0, Errno_Syms); + return Nullp(sym) ? Make_Integer(Saved_Errno) : sym; +} + +elk_init_unix_error() { + Unix_Errobj = Intern("*unix-error-object*"); + Unix_Errobj = Const_Cons(Unix_Errobj, Null); + Global_GC_Link(Unix_Errobj); + + Define_Variable(&V_Call_Errhandler, "unix-call-standard-error-handler?", + True); + + Def_Prim(P_Errorp, "unix-error?", 1, 1, EVAL); + Def_Prim(P_Errno, "unix-errno", 0, 0, EVAL); +} diff --git a/lib/unix/fdescr.c b/lib/unix/fdescr.c new file mode 100644 index 0000000..d72f29f --- /dev/null +++ b/lib/unix/fdescr.c @@ -0,0 +1,270 @@ +#include "unix.h" + +static SYMDESCR Open_Syms[] = { + { "read", 1 }, + { "write", 2 }, + { "append", O_APPEND }, + { "create", O_CREAT }, + { "truncate", O_TRUNC }, + { "exclusive", O_EXCL }, +#ifdef O_SYNC + { "sync", O_SYNC }, +#endif +#ifdef O_NOCTTY + { "noctty", O_NOCTTY }, +#endif +#ifdef O_NDELAY + { "ndelay", O_NDELAY }, +#endif +#ifdef O_NONBLOCK + { "nonblock", O_NONBLOCK }, +#endif + { 0, 0 } +}; + +static SYMDESCR Fcntl_Flags[] = { + { "append", O_APPEND }, +#ifdef O_SYNC + { "sync", O_SYNC }, +#endif +#ifdef O_SYNCIO + { "syncio", O_SYNCIO }, +#endif + { "ndelay", O_NDELAY }, +#ifdef O_NONBLOCK + { "nonblock", O_NONBLOCK }, +#endif +#ifdef O_LARGEFILE + { "largefile", O_LARGEFILE }, +#endif +#ifdef FASYNC + { "async", FASYNC }, +#endif + { 0, 0 } +}; + +SYMDESCR Lseek_Syms[] = { + { "set", 0 }, /* Should use symbolic constants, but */ + { "current", 1 }, /* how do we know whether it's SEEK_ */ + { "end", 2 }, /* or L_ (BSD), and what include files */ + { 0, 0 } /* are to be used? */ +}; + +/* Dangerous: may be used to close the filedescriptor of a port. + */ +static Object P_Close(fd) Object fd; { + if (close(Get_Integer(fd)) == -1) + Raise_System_Error("~E"); + return Void; +} + +static Object P_Close_On_Exec(argc, argv) int argc; Object *argv; { + int flags, fd; + + fd = Get_Integer(argv[0]); + if ((flags = fcntl(fd, F_GETFD, 0)) == -1) + Raise_System_Error("fcntl(F_GETFD): ~E"); + if (argc == 2) { + Check_Type(argv[1], T_Boolean); + if (fcntl(fd, F_SETFD, Truep(argv[1])) == -1) + Raise_System_Error("fcntl(F_SETFD): ~E"); + } + return flags & 1 ? True : False; +} + +static Object P_Dup(argc, argv) int argc; Object *argv; { + int fd = Get_Integer(argv[0]), ret; + + if ((ret = (argc == 1 ? dup(fd) : dup2(fd, Get_Integer(argv[1])))) == -1) + Raise_System_Error("~E"); + return Make_Integer(ret); +} + +static Object P_Filedescriptor_Flags(argc, argv) int argc; Object *argv; { + int flags, fd; + + fd = Get_Integer(argv[0]); + if ((flags = fcntl(fd, F_GETFL, 0)) == -1) + Raise_System_Error("fcntl(F_GETFL): ~E"); + if (argc == 2) { + if (fcntl(fd, F_SETFL, Symbols_To_Bits(argv[1], 1, Fcntl_Flags)) == -1) + Raise_System_Error("fcntl(F_SETFL): ~E"); + } + return Bits_To_Symbols((unsigned long)flags, 1, Fcntl_Flags); +} + +static Object P_Fildescriptor_Port(fd, mode) Object fd, mode; { + int n, flags; + FILE *fp; + Object ret; + char *m, buf[32]; + + m = Get_String(mode); + switch (m[0]) { + case 'r': + flags = P_INPUT; break; + case 'w': case 'a': + flags = 0; break; + default: + Primitive_Error("invalid mode: ~s", mode); + } + if (m[1] == '+') + flags = P_BIDIR; + Disable_Interrupts; + if ((fp = fdopen(n = Get_Integer(fd), m)) == 0) { + Saved_Errno = errno; + Enable_Interrupts; + Raise_System_Error("~E"); + } + sprintf(buf, "unix-fildescriptor[%d]", n); + ret = Make_Port(flags, fp, Make_String(buf, strlen(buf))); + Register_Object(ret, (GENERIC)0, Terminate_File, 0); + Enable_Interrupts; + return ret; +} + +static Object P_Isatty(fd) Object fd; { + return isatty(Get_Integer(fd)) ? True : False; +} + +static Object P_List_Filedescriptor_Flags() { + return Syms_To_List(Fcntl_Flags); +} + +static Object P_List_Open_Modes() { + return Syms_To_List(Open_Syms); +} + +/* Bad assumption: off_t fits into an unsigned int. + */ +static Object P_Lseek(fd, off, whence) Object fd, off, whence; { + off_t ret; + + if ((ret = lseek(Get_Integer(fd), (off_t)Get_Long(off), + (int)Symbols_To_Bits(whence, 0, Lseek_Syms))) == (off_t)-1) + Raise_System_Error("~E"); + return Make_Unsigned_Long((unsigned long)ret); +} + +int Num_Filedescriptors() { + int ret; +#ifdef OPEN_MAX + ret = OPEN_MAX; +#else +#ifdef GETDTABLESIZE + ret = getdtablesize(); +#else +#ifdef SYSCONF_OPEN_MAX + static r; + if (r == 0) { + if ((r = sysconf(_SC_OPEN_MAX)) == -1) + r = 256; + } + ret = r; +#else +#ifdef NOFILE + ret = NOFILE; +#else + ret = 256; +#endif +#endif +#endif +#endif + return ret; +} + +static Object P_Num_Filedescriptors() { + return Make_Integer(Num_Filedescriptors()); +} + +static Object P_Open(argc, argv) int argc; Object *argv; { + Object fn; + int mode, n; + + fn = argv[0]; + mode = (int)Symbols_To_Bits(argv[1], 1, Open_Syms); + if (!(n = mode & 3)) + Primitive_Error("mode must include 'read or 'write"); + mode &= ~3; mode |= n-1; + if (mode & O_CREAT && argc == 2) + Primitive_Error("third argument required for 'create"); + if ((n = open(Get_Strsym(fn), mode, argc == 3 ? Get_Integer(argv[2]) : 0)) + == -1) + Raise_System_Error1("~s: ~E", fn); + return Make_Integer(n); +} + +static Object P_Pipe() { + int fd[2]; + + if (pipe(fd) == -1) + Raise_System_Error("~E"); + return Integer_Pair(fd[0], fd[1]); +} + +static Object P_Port_Filedescriptor(port) Object port; { + Check_Type(port, T_Port); + if ((PORT(port)->flags & (P_STRING|P_OPEN)) != P_OPEN) + Primitive_Error("~s: invalid port", port); + return Make_Integer(fileno(PORT(port)->file)); +} + +static Object Read_Write(argc, argv, readflg) int argc; Object *argv; { + struct S_String *sp; + int len, fd; + + fd = Get_Integer(argv[0]); + Check_Type(argv[1], T_String); + sp = STRING(argv[1]); + if (argc == 3) { + if ((len = Get_Integer(argv[2])) < 0 || len > sp->size) + Range_Error(argv[2]); + } else len = sp->size; + if (readflg) + len = read(fd, sp->data, len); + else + len = write(fd, sp->data, len); + if (len == -1) + Raise_System_Error("~E"); + return Make_Integer(len); +} + +/* Avoid name clash with P_Read/P_Write of interpreter kernel + */ +static Object P_Readx(argc, argv) int argc; Object *argv; { + return Read_Write(argc, argv, 1); +} + +static Object P_Writex(argc, argv) int argc; Object *argv; { + return Read_Write(argc, argv, 0); +} + +static Object P_Ttyname(fd) Object fd; { + char *ret; + extern char *ttyname(); + + Disable_Interrupts; + ret = ttyname(Get_Integer(fd)); + Enable_Interrupts; + return ret ? Make_String(ret, strlen(ret)) : False; +} + +elk_init_unix_fdescr() { + Def_Prim(P_Close, "unix-close", 1, 1, EVAL); + Def_Prim(P_Close_On_Exec, "unix-close-on-exec", 1, 2, VARARGS); + Def_Prim(P_Dup, "unix-dup", 1, 2, VARARGS); + Def_Prim(P_Filedescriptor_Flags,"unix-filedescriptor-flags",1, 2, VARARGS); + Def_Prim(P_Fildescriptor_Port, "unix-filedescriptor->port",2, 2, EVAL); + Def_Prim(P_Isatty, "unix-isatty?", 1, 1, EVAL); + Def_Prim(P_List_Filedescriptor_Flags, + "unix-list-filedescriptor-flags", 0, 0, EVAL); + Def_Prim(P_List_Open_Modes, "unix-list-open-modes", 0, 0, EVAL); + Def_Prim(P_Lseek, "unix-lseek", 3, 3, EVAL); + Def_Prim(P_Num_Filedescriptors, "unix-num-filedescriptors", 0, 0, EVAL); + Def_Prim(P_Open, "unix-open", 2, 3, VARARGS); + Def_Prim(P_Pipe, "unix-pipe", 0, 0, EVAL); + Def_Prim(P_Port_Filedescriptor, "unix-port-filedescriptor", 1, 1, EVAL); + Def_Prim(P_Readx, "unix-read-string-fill!", 2, 3, VARARGS); + Def_Prim(P_Ttyname, "unix-ttyname", 1, 1, EVAL); + Def_Prim(P_Writex, "unix-write", 2, 3, VARARGS); +} diff --git a/lib/unix/file.c b/lib/unix/file.c new file mode 100644 index 0000000..ab811fb --- /dev/null +++ b/lib/unix/file.c @@ -0,0 +1,264 @@ +#include "unix.h" + +#ifdef UTIME_H +# include +#else +struct utimbuf { + time_t actime, modtime; +}; +#endif + +#ifdef DIRENT +# include +#else +# include +#endif + +#if defined(ELOOP) +# define SYMLINKS +#endif + +static SYMDESCR Access_Syms[] = { + { "read", R_OK }, /* Nothing == F_OK */ + { "write", W_OK }, + { "execute", X_OK }, + { 0, 0 } +}; + +static Object P_Accessp(fn, mode) Object fn, mode; { + if (access(Get_Strsym(fn), (int)Symbols_To_Bits(mode, 1, Access_Syms)) + == 0) + return True; + Saved_Errno = errno; + return False; +} + +static Object P_Chdir(fn) Object fn; { + if (chdir(Get_Strsym(fn)) == -1) + Raise_System_Error1("~s: ~E", fn); + return Void; +} + +static Object P_Chmod(fn, mode) Object fn, mode; { + if (chmod(Get_Strsym(fn), Get_Integer(mode)) == -1) + Raise_System_Error1("~s: ~E", fn); + return Void; +} + +static Object P_Chown(fn, uid, gid) Object fn, uid, gid; { + if (chown(Get_Strsym(fn), Get_Integer(uid), Get_Integer(gid)) == -1) + Raise_System_Error1("~s: ~E", fn); + return Void; +} + +static Object P_Link(fn1, fn2) Object fn1, fn2; { + if (link(Get_Strsym(fn1), Get_Strsym(fn2)) == -1) + Raise_System_Error2("(~s ~s): ~E", fn1, fn2); + return Void; +} + +static Object P_Mkdir(fn, mode) Object fn, mode; { + if (mkdir(Get_Strsym(fn), Get_Integer(mode)) == -1) + Raise_System_Error1("~s: ~E", fn); + return Void; +} + +static Object P_Read_Directory(fn) Object fn; { + DIR *d; +#ifdef DIRENT + struct dirent *dp; +#else + struct direct *dp; +#endif + Object ret; + GC_Node; + + ret = Null; + GC_Link(ret); + Disable_Interrupts; + if ((d = opendir(Get_Strsym(fn))) == NULL) { + Saved_Errno = errno; + Enable_Interrupts; + Raise_System_Error1("~s: cannot open", fn); + } + while ((dp = readdir(d)) != NULL) { + Object x; + + x = Make_String(dp->d_name, strlen(dp->d_name)); + ret = Cons(x, ret); + } + /* closedir() is void under 4.3BSD, should check result elsewhere. + */ + (void)closedir(d); + Enable_Interrupts; + GC_Unlink; + return ret; +} + +static Object P_Rename(fromfn, tofn) Object fromfn, tofn; { +#ifdef RENAME + if (rename(Get_Strsym(fromfn), Get_Strsym(tofn)) == -1) + Raise_System_Error2("(~s ~s): ~E", fromfn, tofn); +#else + char *from = Get_Strsym(fromfn), *to = Get_Strsym(tofn); + + Disable_Interrupts; + if (link(from, to) == -1) { + Saved_Errno = errno; + Enable_Interrupts; + Raise_System_Error2("(~s ~s): ~E", fromfn, tofn); + } + if (unlink(from) == -1) { + Saved_Errno = errno; + (void)unlink(to); + Enable_Interrupts; + Raise_Error1("~s: ~E", fromfn); + } + Enable_Interrupts; +#endif + return Void; +} + +static Object General_Stat(obj, ret, l) Object obj, ret; int l; { + Object x; + struct stat st; + char *s, *fn = 0; + int fd, result; + GC_Node; + + Check_Result_Vector(ret, 11); + if (l) { +#ifdef SYMLINKS + result = lstat(Get_Strsym(obj), &st); +#endif + } else { + Get_Filename_Or_Filedescr(obj, fd, fn); + result = fn ? stat(fn, &st) : fstat(fd, &st); + } + if (result == -1) + Raise_System_Error1("~s: ~E", obj); + switch (st.st_mode & S_IFMT) { + case S_IFDIR: s = "directory"; break; + case S_IFCHR: s = "character-special"; break; + case S_IFBLK: s = "block-special"; break; + case S_IFREG: s = "regular"; break; +#ifdef S_IFLNK + case S_IFLNK: s = "symlink"; break; +#endif +#ifdef S_IFSOCK + case S_IFSOCK: s = "socket"; break; +#endif +#ifdef S_IFFIFO + case S_IFFIFO: s = "fifo"; break; +#endif + default: s = "unknown"; break; + } + /* Bad assumption: any of the st_ fields fits into an unsigned int. + */ + GC_Link(ret); + x = Intern(s); + VECTOR(ret)->data[0] = x; + x = Make_Unsigned((unsigned)st.st_mode & ~S_IFMT); + VECTOR(ret)->data[1] = x; + x = Make_Unsigned_Long((unsigned long)st.st_ino); + VECTOR(ret)->data[2] = x; + x = Make_Unsigned((unsigned)st.st_dev); + VECTOR(ret)->data[3] = x; + x = Make_Unsigned((unsigned)st.st_nlink); + VECTOR(ret)->data[4] = x; + x = Make_Unsigned((unsigned)st.st_uid); + VECTOR(ret)->data[5] = x; + x = Make_Unsigned((unsigned)st.st_gid); + VECTOR(ret)->data[6] = x; + x = Make_Long((long)st.st_size); + VECTOR(ret)->data[7] = x; + x = Make_Unsigned_Long((unsigned long)st.st_atime); + VECTOR(ret)->data[8] = x; + x = Make_Unsigned_Long((unsigned long)st.st_mtime); + VECTOR(ret)->data[9] = x; + x = Make_Unsigned_Long((unsigned long)st.st_ctime); + VECTOR(ret)->data[10] = x; + GC_Unlink; + return Void; +} + +static Object P_Stat(obj, ret) Object obj, ret; { + return General_Stat(obj, ret, 0); +} + +#ifdef SYMLINKS +static Object P_Lstat(obj, ret) Object obj, ret; { + return General_Stat(obj, ret, 1); +} + +static Object P_Readlink(fn) Object fn; { + char *buf; + int len; + Object ret; + Alloca_Begin; + + len = Path_Max(); + Alloca(buf, char*, len); + if ((len = readlink(Get_Strsym(fn), buf, len)) == -1) { + Alloca_End; + Raise_System_Error1("~s: ~E", fn); + } + ret = Make_String(buf, len); + Alloca_End; + return ret; +} + +static Object P_Rmdir(fn) Object fn; { + if (rmdir(Get_Strsym(fn)) == -1) + Raise_System_Error1("~s: ~E", fn); + return Void; +} + +static Object P_Symlink(fn1, fn2) Object fn1, fn2; { + if (symlink(Get_Strsym(fn1), Get_Strsym(fn2)) == -1) + Raise_System_Error2("(~s ~s): ~E", fn1, fn2); + return Void; +} +#endif + +static Object P_Unlink(fn) Object fn; { + if (unlink(Get_Strsym(fn)) == -1) + Raise_System_Error1("~s: ~E", fn); + return Void; +} + +static Object P_Utime(argc, argv) int argc; Object *argv; { + struct utimbuf ut; + + if (argc == 2) + Primitive_Error("wrong number of arguments"); + if (argc == 3) { + ut.actime = (time_t)Get_Unsigned_Long(argv[1]); + ut.modtime = (time_t)Get_Unsigned_Long(argv[2]); + } + if (utime(Get_Strsym(argv[0]), argc == 1 ? (struct utimbuf *)0 : &ut) + == -1) + Raise_System_Error1("~s: ~E", argv[0]); + return Void; +} + +elk_init_unix_file() { + Def_Prim(P_Accessp, "unix-access?", 2, 2, EVAL); + Def_Prim(P_Chdir, "unix-chdir", 1, 1, EVAL); + Def_Prim(P_Chmod, "unix-chmod", 2, 2, EVAL); + Def_Prim(P_Chown, "unix-chown", 3, 3, EVAL); + Def_Prim(P_Link, "unix-link", 2, 2, EVAL); + Def_Prim(P_Mkdir, "unix-mkdir", 2, 2, EVAL); + Def_Prim(P_Read_Directory, "unix-read-directory", 1, 1, EVAL); + Def_Prim(P_Rename, "unix-rename", 2, 2, EVAL); + Def_Prim(P_Stat, "unix-stat-vector-fill!", 2, 2, EVAL); +#ifdef SYMLINKS + Def_Prim(P_Lstat, "unix-lstat-vector-fill!", 2, 2, EVAL); + Def_Prim(P_Readlink, "unix-readlink", 1, 1, EVAL); + Def_Prim(P_Rmdir, "unix-rmdir", 1, 1, EVAL); + Def_Prim(P_Symlink, "unix-symlink", 2, 2, EVAL); + P_Provide(Intern("unix:symlinks")); +#endif + Def_Prim(P_Unlink, "unix-unlink", 1, 1, EVAL); + Def_Prim(P_Utime, "unix-utime", 1, 3, VARARGS); +} diff --git a/lib/unix/lock.c b/lib/unix/lock.c new file mode 100644 index 0000000..c19f01b --- /dev/null +++ b/lib/unix/lock.c @@ -0,0 +1,90 @@ +#include "unix.h" + +#include + +#ifdef F_SETLK +# define LOCKS +# define RECORD_LOCKS +#else +#ifdef LOCK_SH +# define LOCKS +#endif +#endif + +#ifdef LOCKS + +static Object P_Internal_Lock_Operation(fd, lck, block, what, ret) + Object fd, lck, block, what, ret; { +#ifdef RECORD_LOCKS + struct flock fl; +#else + int mode; +#endif + int op; + Object *vp; + + Check_Result_Vector(lck, 4); + Check_Type(what, T_Character); + op = CHAR(what); + if (op == 'q') + Check_Result_Vector(ret, 4); + +#ifdef RECORD_LOCKS + Check_Type(block, T_Boolean); + vp = VECTOR(lck)->data; + Check_Type(*vp, T_Boolean); + fl.l_type = op == 'r' ? F_UNLCK : (Truep(*vp) ? F_WRLCK : F_RDLCK); + fl.l_whence = (short)Symbols_To_Bits(*++vp, 0, Lseek_Syms); + fl.l_start = Get_Long(*++vp); + fl.l_len = Get_Long(*++vp); + if (fcntl(Get_Integer(fd), op == 'q' ? F_GETLK : + (Truep(block) ? F_SETLKW : F_SETLK), &fl) == -1) { + if (op == 's' && !Truep(block) && (errno == EAGAIN || errno == EACCES)) + return False; + Raise_System_Error("fcntl: ~E"); + } + if (op == 'q') { + Object x; + GC_Node; + + if (fl.l_type == F_UNLCK) + return False; + GC_Link(ret); + VECTOR(ret)->data[0] = fl.l_type == F_WRLCK ? True : False; + x = Bits_To_Symbols((unsigned long)fl.l_whence, 0, Lseek_Syms); + VECTOR(ret)->data[1] = x; + x = Make_Long(fl.l_start); VECTOR(ret)->data[2] = x; + x = Make_Long(fl.l_len); VECTOR(ret)->data[3] = x; + GC_Unlink; + return Make_Integer(fl.l_pid); + } +#else + Check_Type(block, T_Boolean); + if (op == 'q') + return False; + vp = VECTOR(lck)->data; + Check_Type(*vp, T_Boolean); + mode = op == 'r' ? LOCK_UN : (Truep(*vp) ? LOCK_EX : LOCK_SH); + if (op != 'r' && !Truep(block)) + mode |= LOCK_NB; + if (flock(Get_Integer(fd), mode) == -1) { + if (op == 's' && !Truep(block) && errno == EWOULDBLOCK) + return False; + Raise_System_Error("flock: ~E"); + } +#endif + return op == 's' ? True : Void; +} + +#endif + +elk_init_unix_lock() { +#ifdef LOCKS + Def_Prim(P_Internal_Lock_Operation, "unix-internal-lock-operation", + 5, 5, EVAL); + P_Provide(Intern("unix:file-locking")); +#ifdef RECORD_LOCKS + P_Provide(Intern("unix:record-locks")); +#endif +#endif +} diff --git a/lib/unix/misc.c b/lib/unix/misc.c new file mode 100644 index 0000000..2b34b5e --- /dev/null +++ b/lib/unix/misc.c @@ -0,0 +1,17 @@ +#include "unix.h" + +static Object P_Getpass(prompt) Object prompt; { + char *ret; + extern char *getpass(); + + Disable_Interrupts; + ret = getpass(Get_String(prompt)); + Enable_Interrupts; + if (ret == 0) + Raise_Error("cannot read password from /dev/tty"); + return Make_String(ret, strlen(ret)); +} + +elk_init_unix_misc() { + Def_Prim(P_Getpass, "unix-getpass", 1, 1, EVAL); +} diff --git a/lib/unix/passwd.c b/lib/unix/passwd.c new file mode 100644 index 0000000..2e9374c --- /dev/null +++ b/lib/unix/passwd.c @@ -0,0 +1,136 @@ +#include "unix.h" + +#include +#include + +static Object P_Get_Passwd(argc, argv) int argc; Object *argv; { + struct passwd *p; + Object arg, x; + + Check_Result_Vector(argv[0], 7); + Disable_Interrupts; + if (argc == 1) { + if ((p = getpwent()) == 0) { + Enable_Interrupts; + Raise_Error("no more passwd entries"); + } + } else { + arg = argv[1]; + switch (TYPE(arg)) { + case T_Fixnum: case T_Bignum: + p = getpwuid(Get_Integer(arg)); + break; + case T_String: case T_Symbol: + p = getpwnam(Get_String(arg)); + break; + default: + Wrong_Type_Combination(arg, "integer, string, or symbol"); + } + if (p == 0) { + Enable_Interrupts; + Raise_Error1("no passwd entry for ~s", arg); + } + } + Enable_Interrupts; + x = Make_String(p->pw_name, strlen(p->pw_name)); + VECTOR(argv[0])->data[0] = x; + x = Make_String(p->pw_passwd, strlen(p->pw_passwd)); + VECTOR(argv[0])->data[1] = x; + x = Make_Integer(p->pw_uid); + VECTOR(argv[0])->data[2] = x; + x = Make_Integer(p->pw_gid); + VECTOR(argv[0])->data[3] = x; + x = Make_String(p->pw_gecos, strlen(p->pw_gecos)); + VECTOR(argv[0])->data[4] = x; + x = Make_String(p->pw_dir, strlen(p->pw_dir)); + VECTOR(argv[0])->data[5] = x; + x = Make_String(p->pw_shell, strlen(p->pw_shell)); + VECTOR(argv[0])->data[6] = x; + return Void; +} + +static Object P_Rewind_Passwd() { + Disable_Interrupts; + setpwent(); + Enable_Interrupts; + return Void; +} + +static Object P_End_Passwd() { + Disable_Interrupts; + endpwent(); + Enable_Interrupts; + return Void; +} + +static Object P_Get_Group(argc, argv) int argc; Object *argv; { + char **pp; + struct group *p; + Object arg, member, x; + GC_Node; + + Check_Result_Vector(argv[0], 4); + Disable_Interrupts; + if (argc == 1) { + if ((p = getgrent()) == 0) { + Enable_Interrupts; + Raise_Error("no more group entries"); + } + } else { + arg = argv[1]; + switch (TYPE(arg)) { + case T_Fixnum: case T_Bignum: + p = getgrgid(Get_Integer(arg)); + break; + case T_String: case T_Symbol: + p = getgrnam(Get_String(arg)); + break; + default: + Wrong_Type_Combination(arg, "integer, string, or symbol"); + } + if (p == 0) { + Enable_Interrupts; + Raise_Error1("no group entry for ~s", arg); + } + } + Enable_Interrupts; + x = Make_String(p->gr_name, strlen(p->gr_name)); + VECTOR(argv[0])->data[0] = x; + x = Make_String(p->gr_passwd, strlen(p->gr_passwd)); + VECTOR(argv[0])->data[1] = x; + x = Make_Integer(p->gr_gid); + VECTOR(argv[0])->data[2] = x; + x = Null; + GC_Link(x); + for (pp = p->gr_mem; *pp; pp++) { + member = Intern(*pp); + x = Cons(member, x); + } + x = P_Reverse(x); + GC_Unlink; + VECTOR(argv[0])->data[3] = x; + return Void; +} + +static Object P_Rewind_Group() { + Disable_Interrupts; + setgrent(); + Enable_Interrupts; + return Void; +} + +static Object P_End_Group() { + Disable_Interrupts; + endgrent(); + Enable_Interrupts; + return Void; +} + +elk_init_unix_passwd() { + Def_Prim(P_Get_Passwd, "unix-get-passwd-vector-fill!", 1, 2, VARARGS); + Def_Prim(P_Rewind_Passwd, "unix-rewind-passwd", 0, 0, EVAL); + Def_Prim(P_End_Passwd, "unix-end-passwd", 0, 0, EVAL); + Def_Prim(P_Get_Group, "unix-get-group-vector-fill!", 1, 2, VARARGS); + Def_Prim(P_Rewind_Group, "unix-rewind-group", 0, 0, EVAL); + Def_Prim(P_End_Group, "unix-end-group", 0, 0, EVAL); +} diff --git a/lib/unix/process.c b/lib/unix/process.c new file mode 100644 index 0000000..31ab39f --- /dev/null +++ b/lib/unix/process.c @@ -0,0 +1,344 @@ +#include "unix.h" + +#include + +/* "extern" in front of the next declaration causes the Ultrix 4.2 linker + * to fail when dynamically loading unix.o (but omitting it does no longer + * work with modern C compilers): + */ +extern char **environ; + +static Object P_Environ() { + Object ret, cell, str; + char *p, **ep; + static char c[2]; + GC_Node2; + + cell = ret = Null; + GC_Link2(ret, cell); + for (ep = environ; *ep; ep++) { + cell = Cons(Null, Null); + if (p = index(*ep, '=')) + *p++ = 0; + else p = c+1; + str = Make_String(p, strlen(p)); + Cdr(cell) = str; + str = Make_String(*ep, strlen(*ep)); + Car(cell) = str; + ret = Cons(cell, ret); + *--p = '='; + } + GC_Unlink; + return P_Reverse(ret); +} + +static Object General_Exec(argc, argv, path) int argc; Object *argv; + int path; { + Object fn, args, p, e; + char *fnp, **argp, **envp; + int i, len; + Alloca_Begin; + + fn = argv[0], args = argv[1]; + fnp = Get_Strsym(fn); + Check_List(args); + len = Fast_Length(args); + Alloca(argp, char**, (len+1) * sizeof(char*)); + for (i = 0, p = args; i < len; i++, p = Cdr(p)) { + e = Car(p); + Get_String_Stack(e, argp[i]); + } + argp[i] = 0; + if (argc == 3) { + args = argv[2]; + Check_List(args); + len = Fast_Length(args); + Alloca(envp, char**, (len+1) * sizeof(char*)); + for (i = 0, p = args; i < len; i++, p = Cdr(p)) { + struct S_String *s1, *s2; + + e = Car(p); + Check_Type(e, T_Pair); + Check_Type(Car(e), T_String); + Check_Type(Cdr(e), T_String); + s1 = STRING(Car(e)); + s2 = STRING(Cdr(e)); + Alloca(envp[i], char*, s1->size + 1 + s2->size + 1); + sprintf(envp[i], "%.*s=%.*s", s1->size, s1->data, + s2->size, s2->data); + } + envp[i] = 0; + Exit_Handler(); +#if 0 + if (path) + (void)execvpe(fnp, argp, envp); /* ... doesn't exist */ + else +#endif + (void)execve(fnp, argp, envp); + } else { + Exit_Handler(); + if (path) + (void)execvp(fnp, argp); + else + (void)execv(fnp, argp); + } + Alloca_End; + Raise_System_Error1("~s: ~E", fn); +} + +static Object P_Exec(argc, argv) int argc; Object *argv; { + return General_Exec(argc, argv, 0); +} + +static Object P_Exec_Path(argc, argv) int argc; Object *argv; { + if (argc == 3) /* There is no execvpe (yet?). */ + Primitive_Error("environment argument not supported"); + return General_Exec(argc, argv, 1); +} + +static Object P_Fork() { + int pid; + + switch (pid = fork()) { + case -1: + Raise_System_Error("~E"); + case 0: + Call_Onfork(); + } + return Make_Integer(pid); +} + +static Object P_Getenv(e) Object e; { + extern char *getenv(); + char *s; + + return (s = getenv(Get_String(e))) ? Make_String(s, strlen(s)) : False; +} + +static Object P_Getlogin() { + extern char *getlogin(); + char *s; + + Disable_Interrupts; + s = getlogin(); + Enable_Interrupts; + if (s == 0) + Raise_Error("cannot get login name"); + return Make_String(s, strlen(s)); +} + +static Object P_Getgids() { return Integer_Pair(getgid(), getegid()); } + +static Object P_Getpids() { return Integer_Pair(getpid(), getppid()); } + +static Object P_Getuids() { return Integer_Pair(getuid(), geteuid()); } + +static Object P_Getgroups() { + int i, n; + GETGROUPS_TYPE *p; + Object ret, next; + Alloca_Begin; + GC_Node2; + + /* gcc may complain under SunOS 4.x, because the prototype says + * that the type of the 2nd argument is unsigned short*, not int. + * But int is right. + */ + if ((n = getgroups(0, (GETGROUPS_TYPE *)0)) == -1) +#ifdef NGROUPS + n = NGROUPS; /* 4.3BSD */ +#else + Raise_System_Error("~E"); +#endif + Alloca(p, GETGROUPS_TYPE*, n*sizeof(GETGROUPS_TYPE)); + (void)getgroups(n, p); + next = ret = P_Make_List(Make_Integer(n), Null); + GC_Link2(ret, next); + for (i = 0; i < n; i++, next = Cdr(next)) { + Object x; + + x = Make_Unsigned((unsigned)p[i]); + Car(next) = x; + } + GC_Unlink; + Alloca_End; + return ret; +} + +static Object P_Nice(incr) Object incr; { + int ret; + + errno = 0; + if ((ret = nice(Get_Integer(incr))) == -1 && errno != 0) + Raise_System_Error("~E"); + return Make_Integer(ret); +} + +static Object Open_Pipe(cmd, flags) Object cmd; int flags; { + FILE *fp; + Object ret; + extern pclose(); + + Disable_Interrupts; + if ((fp = popen(Get_String(cmd), flags == P_INPUT ? "r" : "w")) == 0) { + Enable_Interrupts; + Raise_Error("cannot open pipe to process"); + } + ret = Make_Port(flags, fp, Make_String("pipe-port", 9)); + PORT(ret)->closefun = pclose; + Register_Object(ret, (GENERIC)0, Terminate_File, 0); + Enable_Interrupts; + return ret; +} + +static Object P_Open_Input_Pipe(cmd) Object cmd; { + return Open_Pipe(cmd, P_INPUT); +} + +static Object P_Open_Output_Pipe(cmd) Object cmd; { + return Open_Pipe(cmd, 0); +} + +static Object P_Process_Resources(ret1, ret2) Object ret1, ret2; { + static hzval; + struct tms tms; + Object x; + GC_Node2; + + if (hzval == 0) { +#ifdef HZ + hzval = HZ; +#else +#ifdef CLK_TCK + hzval = CLK_TCK; +#else +#ifdef _SC_CLK_TCK + hzval = (int)sysconf(_SC_CLK_TCK); +#else + hzval = 60; /* Fallback for 4.3BSD. I don't have a better idea. */ +#endif +#endif +#endif + } + Check_Result_Vector(ret1, 2); + Check_Result_Vector(ret2, 2); + (void)times(&tms); + GC_Link2(ret1, ret2); + x = Make_Unsigned_Long((unsigned long)tms.tms_utime); + VECTOR(ret1)->data[0] = x; + x = Make_Unsigned_Long((unsigned long)tms.tms_stime); + VECTOR(ret1)->data[1] = x; + x = Make_Unsigned_Long((unsigned long)tms.tms_cutime); + VECTOR(ret2)->data[0] = x; + x = Make_Unsigned_Long((unsigned long)tms.tms_cstime); + VECTOR(ret2)->data[1] = x; + GC_Unlink; + return Make_Integer(hzval); +} + +static Object P_Sleep(s) Object s; { + (void)sleep(Get_Unsigned(s)); + return Void; +} + +static Object P_System(cmd) Object cmd; { + int n, pid, status; + char *s = Get_String(cmd); + +#ifdef VFORK + switch (pid = vfork()) { +#else + switch (pid = fork()) { +#endif + case -1: + Raise_System_Error("fork: ~E"); + case 0: + for (n = Num_Filedescriptors(); n >= 3; n--) + (void)close(n); + execl("/bin/sh", "sh", "-c", s, (char *)0); + _exit(127); + default: + Disable_Interrupts; + while ((n = wait(&status)) != pid && n != -1) + ; + Enable_Interrupts; + } + /* Can this happen? + if (n == -1) + return False; + */ + if (n = (status & 0377)) + return Cons(Make_Integer(n), Null); + return Make_Integer((status >> 8) & 0377); +} + +static Object P_Umask(mask) Object mask; { + return Make_Integer(umask(Get_Integer(mask))); +} + +static Object P_Working_Directory() { + char *buf; + int max = Path_Max()+2; /* getcwd() needs two extra bytes */ + Object ret; +#if !defined(GETCWD) && !defined(GETWD) + FILE *fp; + char *p; +#endif + Alloca_Begin; + + Alloca(buf, char*, max); + Disable_Interrupts; +#ifdef GETCWD + if (getcwd(buf, max) == 0) { + Saved_Errno = errno; + Alloca_End; + Enable_Interrupts; + Raise_System_Error("~E"); + } +#else +#ifdef GETWD + if (getwd(buf) == 0) { + Alloca_End; + Enable_Interrupts; + Raise_Error(buf); + } +#else + if ((fp = popen("pwd", "r")) == 0) { +err: + Alloca_End; + Enable_Interrupts; + Raise_Error("cannot get output from pwd"); + } + if (fgets(buf, max, fp) == 0) + goto err; + if (p = index(buf, '\n')) *p = '\0'; + (void)pclose(fp); +#endif +#endif + Enable_Interrupts; + ret = Make_String(buf, strlen(buf)); + Alloca_End; + return ret; +} + +elk_init_unix_process() { + Def_Prim(P_Environ, "unix-environ", 0, 0, EVAL); + Def_Prim(P_Exec, "unix-exec", 2, 3, VARARGS); + Def_Prim(P_Exec_Path, "unix-exec-path", 2, 3, VARARGS); + Def_Prim(P_Fork, "unix-fork", 0, 0, EVAL); + Def_Prim(P_Getenv, "unix-getenv", 1, 1, EVAL); + Def_Prim(P_Getlogin, "unix-getlogin", 0, 0, EVAL); + Def_Prim(P_Getgids, "unix-getgids", 0, 0, EVAL); + Def_Prim(P_Getpids, "unix-getpids", 0, 0, EVAL); + Def_Prim(P_Getuids, "unix-getuids", 0, 0, EVAL); + Def_Prim(P_Getgroups, "unix-getgroups", 0, 0, EVAL); + Def_Prim(P_Nice, "unix-nice", 1, 1, EVAL); + Def_Prim(P_Open_Input_Pipe, "unix-open-input-pipe", 1, 1, EVAL); + Def_Prim(P_Open_Output_Pipe, "unix-open-output-pipe", 1, 1, EVAL); + Def_Prim(P_Process_Resources, "unix-process-resources-vector-fill!", + 2, 2, EVAL); + Def_Prim(P_Sleep, "unix-sleep", 1, 1, EVAL); + Def_Prim(P_System, "unix-system", 1, 1, EVAL); + Def_Prim(P_Umask, "unix-umask", 1, 1, EVAL); + Def_Prim(P_Working_Directory, "unix-working-directory", 0, 0, EVAL); +} diff --git a/lib/unix/signal.c b/lib/unix/signal.c new file mode 100644 index 0000000..3269244 --- /dev/null +++ b/lib/unix/signal.c @@ -0,0 +1,308 @@ +#include "unix.h" + +static Object Sym_Exit, Sym_Default, Sym_Ignore; + +static SYMDESCR Signal_Syms[] = { + { "sigalrm", SIGALRM }, +#ifdef SIGBUS + { "sigbus", SIGBUS }, +#endif + { "sigfpe", SIGFPE }, + { "sighup", SIGHUP }, + { "sigill", SIGILL }, + { "sigint", SIGINT }, + { "sigkill", SIGKILL }, + { "sigpipe", SIGPIPE }, + { "sigquit", SIGQUIT }, + { "sigsegv", SIGSEGV }, + { "sigterm", SIGTERM }, +#ifdef SIGABRT + { "sigabrt", SIGABRT }, +#endif +#ifdef SIGAIO + { "sigaio", SIGAIO }, +#endif +#ifdef SIGARRAYSIZE + { "sigarraysize", SIGARRAYSIZE }, +#endif +#ifdef SIGCHLD + { "sigchld", SIGCHLD }, +#endif +#ifdef SIGCLD + { "sigcld", SIGCLD }, +#endif +#ifdef SIGCONT + { "sigcont", SIGCONT }, +#endif +#ifdef SIGDANGER + { "sigdanger", SIGDANGER }, +#endif +#ifdef SIGDIL + { "sigdil", SIGDIL }, +#endif +#ifdef SIGEMT + { "sigemt", SIGEMT }, +#endif +#ifdef SIGGRANT + { "siggrant", SIGGRANT }, +#endif +#ifdef SIGINFO + { "siginfo", SIGINFO }, +#endif +#ifdef SIGIO + { "sigio", SIGIO }, +#endif +#ifdef SIGIOINT + { "sigioint", SIGIOINT }, +#endif +#ifdef SIGIOT + { "sigiot", SIGIOT }, +#endif +#ifdef SIGLOST + { "siglost", SIGLOST }, +#endif +#ifdef SIGLWP + { "siglwp", SIGLWP }, +#endif +#ifdef SIGMIGRATE + { "sigmigrate", SIGMIGRATE }, +#endif +#ifdef SIGMSG + { "sigmsg", SIGMSG }, +#endif +#ifdef SIGPOLL + { "sigpoll", SIGPOLL }, +#endif +#ifdef SIGPRE + { "sigpre", SIGPRE }, +#endif +#ifdef SIGPROF + { "sigprof", SIGPROF }, +#endif +#ifdef SIGPTY + { "sigpty", SIGPTY }, +#endif +#ifdef SIGPWR + { "sigpwr", SIGPWR }, +#endif +#ifdef SIGRESERVE + { "sigreserve", SIGRESERVE }, +#endif +#ifdef SIGRETRACT + { "sigretract", SIGRETRACT }, +#endif +#ifdef SIGSAK + { "sigsak", SIGSAK }, +#endif +#ifdef SIGSOUND + { "sigsound", SIGSOUND }, +#endif +#ifdef SIGSTOP + { "sigstop", SIGSTOP }, +#endif +#ifdef SIGSYS + { "sigsys", SIGSYS }, +#endif +#ifdef SIGTRAP + { "sigtrap", SIGTRAP }, +#endif +#ifdef SIGTSTP + { "sigtstp", SIGTSTP }, +#endif +#ifdef SIGTTIN + { "sigttin", SIGTTIN }, +#endif +#ifdef SIGTTOU + { "sigttou", SIGTTOU }, +#endif +#ifdef SIGURG + { "sigurg", SIGURG }, +#endif +#ifdef SIGUSR1 + { "sigusr1", SIGUSR1 }, +#endif +#ifdef SIGUSR2 + { "sigusr2", SIGUSR2 }, +#endif +#ifdef SIGVIRT + { "sigvirt", SIGVIRT }, +#endif +#ifdef SIGVTALRM + { "sigvtalrm", SIGVTALRM }, +#endif +#ifdef SIGWAITING + { "sigwaiting", SIGWAITING }, +#endif +#ifdef SIGWINCH + { "sigwinch", SIGWINCH }, +#endif +#ifdef SIGWINDOW + { "sigwindow", SIGWINDOW }, +#endif +#ifdef SIGXCPU + { "sigxcpu", SIGXCPU }, +#endif +#ifdef SIGXFSZ + { "sigxfsz", SIGXFSZ }, +#endif + { 0, 0 } +}; + +static Object P_Kill(pid, sig) Object pid, sig; { + int t, s; + + if ((t = TYPE(sig)) == T_Fixnum || t == T_Bignum) + s = Get_Integer(sig); + else if (t == T_Symbol) + s = Symbols_To_Bits(sig, 0, Signal_Syms); + else + Wrong_Type_Combination(sig, "symbol or integer"); + if (kill(Get_Integer(pid), s) == -1) + Raise_System_Error("~E"); + return Void; +} + +static Object P_List_Signals() { + return Syms_To_List(Signal_Syms); +} + +static Object P_Pause() { + pause(); + Fatal_Error("pause() returned unexpectedly"); +} + +#if defined(POSIX_SIGNALS) || defined(BSD_SIGNALS) +# define RELIABLE_SIGNALS +#endif + +#ifdef RELIABLE_SIGNALS + +static Object Handlers; + +static Object P_Alarm(s) Object s; { + return Make_Unsigned(alarm(Get_Unsigned(s))); +} + +/*ARGSUSED*/ +void General_Handler(sig) int sig; { + Object fun, args; + +#ifndef BSD_SIGNALS + (void)signal(sig, General_Handler); +#endif + Set_Error_Tag("signal-handler"); + Reset_IO(1); + args = Bits_To_Symbols((unsigned long)sig, 0, Signal_Syms); + args = Cons(args, Null); + fun = VECTOR(Handlers)->data[sig]; + if (TYPE(fun) != T_Compound) + Fatal_Error("no handler for signal %d", sig); + (void)Funcall(fun, args, 0); + Format(Curr_Output_Port, "~%\7Signal!~%", 15, 0, (Object *)0); + (void)P_Reset(); + /*NOTREACHED*/ +} + +static Object Action_To_Sym(act) void (*act)(); { + char *sym; + + if (act == Signal_Exit) + sym = "exit"; + else if (act == SIG_IGN) + sym = "ignore"; + else if (act == SIG_DFL || act == (void (*)())-1) + sym = "default"; + else + sym = "handler"; + return Intern(sym); +} + +void Add_To_Mask(sig) int sig; { +#ifdef POSIX_SIGNALS + sigaddset(&Sigset_Block, sig); +#else + Sigmask_Block |= sigmask(sig); +#endif + if (Intr_Level > 0) /* make sure new signal gets blocked */ + Force_Disable_Interrupts; +} + +void Remove_From_Mask(sig) int sig; { +#ifdef POSIX_SIGNALS + sigdelset(&Sigset_Block, sig); +#else + Sigmask_Block &= ~sigmask(sig); +#endif +} + +static Object P_Signal(argc, argv) int argc; Object *argv; { + int sig; + Object handler, old; + void (*disp)(); + + sig = Symbols_To_Bits(argv[0], 0, Signal_Syms); + if (sig >= NSIG) + Fatal_Error("signal %d >= NSIG", sig); + if (argc == 1) { + handler = VECTOR(Handlers)->data[sig]; + if (Truep(handler)) + return handler; + if ((disp = signal(sig, SIG_DFL)) != SIG_DFL) + (void)signal(sig, disp); + return Action_To_Sym(disp); + } + switch (sig) { +#ifdef SIGBUS + case SIGBUS: +#endif + case SIGFPE: + case SIGILL: + case SIGINT: + case SIGKILL: + case SIGSEGV: +#ifdef SIGABRT + case SIGABRT: +#endif + Primitive_Error("changing signal ~s not permitted", argv[0]); + } + handler = argv[1]; + if (EQ(handler, Sym_Exit)) { + disp = Signal_Exit; + } else if (EQ(handler, Sym_Default)) { + disp = SIG_DFL; + } else if (EQ(handler, Sym_Ignore)) { + disp = SIG_IGN; + } else if (TYPE(handler) == T_Compound) { + if (COMPOUND(handler)->min_args > 1 || + COMPOUND(handler)->max_args == 0) + Primitive_Error("handler expects wrong number of args"); + disp = General_Handler; + } else + Primitive_Error("invalid handler: ~s", handler); + old = VECTOR(Handlers)->data[sig]; + VECTOR(Handlers)->data[sig] = (disp == General_Handler) ? handler : False; + if (disp == General_Handler) + Add_To_Mask(sig); + else + Remove_From_Mask(sig); + if ((disp = signal(sig, disp)) == (void (*)())-1) + Raise_System_Error("~E"); + return Truep(old) ? old : Action_To_Sym(disp); +} +#endif /* RELIABLE_SIGNALS */ + +elk_init_unix_signal() { + Define_Symbol(&Sym_Exit, "exit"); + Define_Symbol(&Sym_Default, "default"); + Define_Symbol(&Sym_Ignore, "ignore"); + Def_Prim(P_Kill, "unix-kill", 2, 2, EVAL); + Def_Prim(P_List_Signals, "unix-list-signals", 0, 0, EVAL); + Def_Prim(P_Pause, "unix-pause", 0, 0, EVAL); +#ifdef RELIABLE_SIGNALS + Def_Prim(P_Alarm, "unix-alarm", 1, 1, EVAL); + Handlers = Make_Vector(NSIG, False); + Global_GC_Link(Handlers); + Def_Prim(P_Signal, "unix-signal", 1, 2, VARARGS); + P_Provide(Intern("unix:reliable-signals")); +#endif +} diff --git a/lib/unix/system.c b/lib/unix/system.c new file mode 100644 index 0000000..86e031d --- /dev/null +++ b/lib/unix/system.c @@ -0,0 +1,176 @@ +#include "unix.h" + +#if defined(UNAME) && !defined(GETHOSTNAME) +# include +#endif + +#define L_LINK_MAX 0 +#define L_NAME_MAX 1 +#define L_PATH_MAX 2 +#define L_PIPE_BUF 3 +#define L_NO_TRUNC 4 + +static SYMDESCR Limit_Syms[] = { + { "max-links", L_LINK_MAX }, + { "max-name", L_NAME_MAX }, + { "max-path", L_PATH_MAX }, + { "pipe-buf", L_PIPE_BUF }, + { "no-trunc", L_NO_TRUNC }, + { 0, 0 } +}; + +static Object P_File_Limit(lim, f) Object lim, f; { + int op, fd; + long ret; + char *fn = 0; + + switch (Symbols_To_Bits(lim, 0, Limit_Syms)) { + case L_LINK_MAX: +#ifdef LINK_MAX + return Make_Integer(LINK_MAX); +#else +#ifdef _PC_LINK_MAX + op = _PC_LINK_MAX; +# define HAVEOP +#else + return Make_Integer(sizeof(short) * 8); /* guess */ +#endif +#endif + break; + + case L_NAME_MAX: +#ifdef NAME_MAX + return Make_Integer(NAME_MAX); +#else +#ifdef _PC_NAME_MAX + op = _PC_NAME_MAX; +# define HAVEOP +#else + return Make_Integer(255); /* guess */ +#endif +#endif + break; + + case L_PATH_MAX: +#ifdef MAX_PATH + return Make_Integer(MAX_PATH); +#else +#ifdef _PC_PATH_MAX + op = _PC_PATH_MAX; +# define HAVEOP +#else +#ifdef MAXPATHLEN + return Make_Integer(MAXPATHLEN); +#else + return Make_Integer(1024); /* guess */ +#endif +#endif +#endif + break; + + case L_PIPE_BUF: +#ifdef PIPE_BUF + return Make_Integer(PIPE_BUF); +#else +#ifdef _PC_PIPE_BUF + op = _PC_PIPE_BUF; +# define HAVEOP +#else + return Make_Integer(512); /* guess */ +#endif +#endif + break; + + case L_NO_TRUNC: +#ifdef _PC_NO_TRUNC + op = _PC_NO_TRUNC; +# define HAVEOP +#else + return False; /* guess */ +#endif + break; + } +#ifdef HAVEOP + /* If we get here, we have a _PC_XXX symbol in `op' and can invoke + * either pathconf() or fpathconf(). + */ + Get_Filename_Or_Filedescr(f, fd, fn); + errno = 0; + ret = fn ? pathconf(fn, op) : fpathconf(fd, op); + if (ret == -1) { +#ifdef _PC_NO_TRUNC + if (op == _PC_NO_TRUNC && errno == 0) + return False; +#endif + Raise_System_Error1("~s: ~E", f); + } +#ifdef _PC_NO_TRUNC + if (op == _PC_NO_TRUNC) + return ret ? True : False; + else +#endif + return Make_Long(ret); +#endif +} + +static Object P_List_File_Limits() { + return Syms_To_List(Limit_Syms); +} + +static Object P_Job_Controlp() { +#ifdef _POSIX_JOB_CONTROL + return True; +#else +#ifdef _SC_JOB_CONTROL + return sysconf(_SC_JOB_CONTROL) == 1 ? True : False; +#else +#ifdef SIGTSTP + return True; +#else + return False; +#endif +#endif +#endif +} + +static Object P_System_Info(ret) Object ret; { +#ifdef GETHOSTNAME + char hostname[MAXHOSTNAMELEN]; + char *p = hostname; +#else +#ifdef UNAME + struct utsname uts; + char *p = uts.nodename; +#else + char *p = "unknown-hostname"; +#endif +#endif + char systype[64], *q; + Object x; + GC_Node; + + Check_Result_Vector(ret, 3); +#ifdef GETHOSTNAME + (void)gethostname(hostname, sizeof(hostname)); +#else +#ifdef UNAME + (void)uname(&uts); +#endif +#endif + GC_Link(ret); + x = Make_String(p, strlen(p)); VECTOR(ret)->data[0] = x; + strcpy(systype, SYSTEMTYPE); + if ((p = index(systype, '-')) && (q = index(p+1, '-'))) { + *p++ = 0; *q = 0; + } else p = "?"; + x = Make_String(systype, strlen(systype)); VECTOR(ret)->data[1] = x; + x = Make_String(p, strlen(p)); VECTOR(ret)->data[2] = x; + return Void; +} + +elk_init_unix_system() { + Def_Prim(P_File_Limit, "unix-file-limit", 2, 2, EVAL); + Def_Prim(P_List_File_Limits, "unix-list-file-limits", 0, 0, EVAL); + Def_Prim(P_Job_Controlp, "unix-job-control?", 0, 0, EVAL); + Def_Prim(P_System_Info, "unix-system-info-vector-fill!", 1, 1, EVAL); +} diff --git a/lib/unix/temp.c b/lib/unix/temp.c new file mode 100644 index 0000000..71c3cba --- /dev/null +++ b/lib/unix/temp.c @@ -0,0 +1,92 @@ +#include "unix.h" + +#ifdef TEMPNAM /* Make sure only one of these is defined (if any) */ +# undef TMPNAM /* Order of preference: tempnam, mktemp, tmpnam */ +# undef MKTEMP +#endif +#ifdef MKTEMP +# undef TMPNAM +# undef TEMPNAM +#endif +#ifdef TMPNAM +# undef TEMPNAM +# undef MKTEMP +#endif + +static Object P_Tempname(argc, argv) int argc; Object *argv; { + char *name, *dir = 0, *pref = 0; + Object ret; +#ifdef TMPNAM + extern char *tmpnam(); +#else +#ifdef TEMPNAM + extern char *tempnam(); +#else + char buf[1024]; +#ifdef MKTEMP + extern char *mktemp(); +#else + char *p, *q; + struct stat st; +#endif +#endif +#endif + + if (argc > 0) + dir = Get_Strsym(argv[0]); + if (argc > 1) + pref = Get_Strsym(argv[1]); +#ifdef TMPNAM + name = tmpnam((char *)0); +#else +#ifdef TEMPNAM + Disable_Interrupts; /* Make sure result gets freed */ + name = tempnam(dir, pref); +#else + if (!dir) dir = "/tmp"; + if (!pref) pref = "elk"; + if (strlen(dir) + strlen(pref) > 1000) + Primitive_Error("directory/prefix argument too long"); +#ifdef MKTEMP + sprintf(buf, "%s/%sXXXXXX", dir, pref); + name = mktemp(buf); +#else + name = 0; + sprintf(buf, "%s/%sa%d", dir, pref, getpid()); + p = buf+strlen(dir)+strlen(pref)+1; + while (stat(buf, &st) == 0) { /* Simple ersatz mktemp */ + q = p; + while (1) { + if (*q == '\0') goto fail; + if (*q == 'z') { + *q++ = 'a'; + } else { + if (*q >= '0' && *q <= '9') + *q = 'a'; + else + *++q; + break; + } + } + } + if (errno == ENOENT) + name = buf; +fail: ; +#endif +#endif +#endif + if (name == 0 || name[0] == '\0') { + Enable_Interrupts; + Raise_Error("cannot create temp file name"); + } + ret = Make_String(name, strlen(name)); +#ifdef TEMPNAM + free(name); + Enable_Interrupts; +#endif + return ret; +} + +elk_init_unix_temp() { + Def_Prim(P_Tempname, "unix-tempname", 0, 2, VARARGS); +} diff --git a/lib/unix/time.c b/lib/unix/time.c new file mode 100644 index 0000000..d63a5d0 --- /dev/null +++ b/lib/unix/time.c @@ -0,0 +1,143 @@ +#include "unix.h" + +#if !defined(GETTIMEOFDAY) && defined(FTIME) +# include +#endif + +#ifdef GETTIMEOFDAY +# include +#endif + +extern time_t time(); + +static Object P_Decode_Time(t, ret, utc) Object t, ret, utc; { + time_t tt; + struct tm *tp; + Object *op; + + Check_Result_Vector(ret, 9); + Check_Type(utc, T_Boolean); + tt = (time_t)Get_Unsigned_Long(t); + tp = Truep(utc) ? gmtime(&tt) : localtime(&tt); + op = VECTOR(ret)->data; + *op++ = Make_Integer(tp->tm_sec); + *op++ = Make_Integer(tp->tm_min); + *op++ = Make_Integer(tp->tm_hour); + *op++ = Make_Integer(tp->tm_mday); + *op++ = Make_Integer(tp->tm_mon); + *op++ = Make_Integer(tp->tm_year); + *op++ = Make_Integer(tp->tm_wday); + *op++ = Make_Integer(tp->tm_yday); + *op++ = Make_Integer(tp->tm_isdst); + return Void; +} + +static Object P_Nanotime(ret) Object ret; { + Object x, y; +#ifdef GETTIMEOFDAY + struct timeval tv; + struct timezone tz; +#else +#ifdef FTIME + struct timeb tb; +#else + time_t now; + int i; +#endif +#endif + GC_Node2; + + x = Null; + Check_Result_Vector(ret, 3); + GC_Link2(ret, x); +#ifdef GETTIMEOFDAY + (void)gettimeofday(&tv, &tz); + x = Cons(Null, Make_Unsigned_Long((unsigned long)tv.tv_usec * 1000)); + y = Make_Unsigned_Long((unsigned long)tv.tv_sec); + Car(x) = y; + VECTOR(ret)->data[0] = x; + VECTOR(ret)->data[1] = Make_Integer(tz.tz_minuteswest); + VECTOR(ret)->data[2] = Make_Integer(tz.tz_dsttime); +#else +#ifdef FTIME + (void)ftime(&tb); + x = Cons(Null, Make_Unsigned_Long((unsigned long)tb.millitm * 1000000)); + y = Make_Unsigned_Long((unsigned long)tb.time); + Car(x) = y; + VECTOR(ret)->data[0] = x; + VECTOR(ret)->data[1] = Make_Integer(tb.timezone); + VECTOR(ret)->data[2] = Make_Integer(tb.dstflag); +#else + (void)time(&now); + x = Cons(Make_Unsigned_Long((unsigned long)now), Make_Integer(0)); + VECTOR(ret)->data[0] = x; + VECTOR(ret)->data[1] = Make_Integer(0); + VECTOR(ret)->data[2] = Make_Integer(0); +#endif +#endif + GC_Unlink; + return Void; +} + +static Object P_Time() { + time_t t = time((time_t *)0); + return Make_Unsigned_Long((unsigned long)t); +} + +static struct tm *Get_Tm(v) Object v; { + static struct tm tm; + int i, n; + Object *op; + static struct { int min, max; } bounds[] = { + { 0, 61 }, /* sec */ + { 0, 59 }, /* min */ + { 0, 23 }, /* hour */ + { 1, 31 }, /* mday */ + { 0, 11 }, /* mon */ + { 0, 65535 }, /* year */ + { 0, 7 }, /* wday */ + { 0, 365 } /* yday */ + }; + + Check_Result_Vector(v, 9); + for (op = VECTOR(v)->data, i = 0; i < 7; i++, op++) + if ((n = Get_Integer(*op)) < bounds[i].min || n > bounds[i].max) + Range_Error(*op); + op = VECTOR(v)->data; + tm.tm_sec = Get_Integer(*op++); + tm.tm_min = Get_Integer(*op++); + tm.tm_hour = Get_Integer(*op++); + tm.tm_mday = Get_Integer(*op++); + tm.tm_mon = Get_Integer(*op++); + tm.tm_year = Get_Integer(*op++); + tm.tm_wday = Get_Integer(*op++); + tm.tm_yday = Get_Integer(*op++); + tm.tm_isdst = Get_Integer(*op); + return &tm; +} + +static Object P_Time_To_String(t) Object t; { + time_t tt; + char *ret; + + switch (TYPE(t)) { + case T_Fixnum: case T_Bignum: + tt = (time_t)Get_Unsigned_Long(t); + ret = ctime(&tt); + break; + case T_Vector: + ret = asctime(Get_Tm(t)); + break; + default: + Wrong_Type_Combination(t, "integer or vector"); + /*NOTREACHED*/ + } + return Make_String(ret, strlen(ret)); +} + +elk_init_unix_time() { + Def_Prim(P_Time, "unix-time", 0, 0, EVAL); + Def_Prim(P_Decode_Time, "unix-decode-time-vector-fill!", 3, 3, EVAL); + Def_Prim(P_Time_To_String, "unix-time->string-internal", 1, 1, EVAL); + Def_Prim(P_Nanotime, "unix-nanotime-vector-fill!", 1, 1, EVAL); +} diff --git a/lib/unix/unix.c b/lib/unix/unix.c new file mode 100644 index 0000000..5e2a9f4 --- /dev/null +++ b/lib/unix/unix.c @@ -0,0 +1,38 @@ +#include "unix.h" + +Object Integer_Pair(a, b) int a, b; { + Object x, y; + GC_Node2; + + x = y = Null; + GC_Link2(x, y); + x = Make_Integer(a); + y = Make_Integer(b); + x = Cons(x, y); + GC_Unlink; + return x; +} + +Object Syms_To_List(p) SYMDESCR *p; { + Object ret, mode; + GC_Node; + + ret = Null; + GC_Link(ret); + for ( ; p->name; p++) { + mode = Intern(p->name); + ret = Cons(mode, ret); + } + GC_Unlink; + return P_Reverse(ret); +} + +void Check_Result_Vector(x, len) Object x; { + Check_Type(x, T_Vector); + if (VECTOR(x)->size != len) + Primitive_Error("argument vector has the wrong length"); +} + +elk_init_unix_unix() { + P_Provide(Intern("unix.o")); +} diff --git a/lib/unix/unix.h b/lib/unix/unix.h new file mode 100644 index 0000000..078cefd --- /dev/null +++ b/lib/unix/unix.h @@ -0,0 +1,67 @@ +#include "scheme.h" + +#include +#include +#include +#include +#include +#include +#include + +#ifdef INCLUDE_UNISTD_H +# include +#endif + +extern int errno; +extern char *index(); + +extern Object Unix_Errobj, V_Call_Errhandler; +extern SYMDESCR Lseek_Syms[]; + +Object Integer_Pair P_((int, int)); +Object Syms_To_List P_((SYMDESCR*)); + +#define Get_Filename_Or_Filedescr(obj,fd,fn) \ + switch (TYPE(obj)) {\ + case T_String: case T_Symbol:\ + (fn) = Get_Strsym(obj); break;\ + case T_Fixnum: case T_Bignum:\ + (fd) = Get_Integer(obj); break;\ + default:\ + Wrong_Type_Combination(obj, "symbol, string, or integer");\ + } + +#define Raise_System_Error(msg) {\ + Saved_Errno = errno;\ + Raise_Error(msg);\ +} + +#define Raise_Error(msg) {\ + if (Var_Is_True(V_Call_Errhandler))\ + Primitive_Error(msg);\ + return Unix_Errobj;\ +} + +#define Raise_System_Error1(msg,a1) {\ + Saved_Errno = errno;\ + Raise_Error1(msg,a1);\ +} + +#define Raise_Error1(msg,a1) {\ + if (Var_Is_True(V_Call_Errhandler))\ + Primitive_Error(msg,a1);\ + return Unix_Errobj;\ +} + +#define Raise_System_Error2(msg,a1,a2) {\ + Saved_Errno = errno;\ + Raise_Error2(msg,a1,a2);\ +} + +#define Raise_Error2(msg,a1,a2) {\ + if (Var_Is_True(V_Call_Errhandler))\ + Primitive_Error(msg,a1,a2);\ + return Unix_Errobj;\ +} + +#define Def_Prim Define_Primitive diff --git a/lib/unix/wait.c b/lib/unix/wait.c new file mode 100644 index 0000000..ad4253f --- /dev/null +++ b/lib/unix/wait.c @@ -0,0 +1,142 @@ +#ifdef __MACH__ +# define _POSIX_SOURCE +#endif + +#include "unix.h" + +#if defined(WAITPID) || defined(WAIT4) +# define WAIT_PROCESS +#endif + +#if defined(WAITPID) || defined(WAIT3) || defined(WAIT4) +# define WAIT_OPTIONS +#endif + +#if defined(WAIT3) || defined(WAIT4) +# define WAIT_RUSAGE +# include +# include +#endif + +#ifdef WAIT_OPTIONS +static SYMDESCR Wait_Flags[] = { + { "nohang", WNOHANG }, + { "untraced", WUNTRACED }, + { 0, 0 } +}; +#endif + +#ifndef WEXITSTATUS +# define WEXITSTATUS(stat) ((int)((stat >> 8) & 0xFF)) +#endif +#ifndef WTERMSIG +# define WTERMSIG(stat) ((int)(stat & 0x7F)) +#endif +#ifndef WSTOPSIG +# define WSTOPSIG(stat) ((int)((stat >> 8) & 0xFF)) +#endif +#ifndef WIFSIGNALED +# define WIFSIGNALED(stat) ((int)(stat & 0x7F)) +#endif +#ifndef WIFSTOPPED +# define WIFSTOPPED(stat) ((int)(stat & 0x7F) == 0x7F) +#endif + + +static Object General_Wait(ret, ruret, haspid, pid, options) + Object ret, ruret; int haspid, pid, options; { + int retpid, st, code; + char *status; +#ifdef WAIT_RUSAGE + struct rusage ru; + Object sec; +#endif + Object x; + GC_Node3; + + x = Null; + Check_Result_Vector(ret, 5); + Check_Result_Vector(ruret, 2); + if (haspid) { +#ifdef WAIT4 + retpid = wait4(pid, &st, options, &ru); +#else +#ifdef WAITPID + retpid = waitpid(pid, &st, options); +#endif +#endif + } else { +#ifdef WAIT3 + retpid = wait3(&st, options, &ru); +#else + retpid = wait(&st); +#endif + } + if (retpid == -1 && errno != ECHILD) + Raise_System_Error("~E"); + GC_Link3(ret, ruret, x); + x = Make_Integer(retpid); VECTOR(ret)->data[0] = x; + if (retpid == 0 || retpid == -1) { + status = "none"; + st = code = 0; +#ifdef WAIT_RUSAGE + bzero((char *)&ru, sizeof(ru)); +#endif + } else if (WIFSTOPPED(st)) { + status = "stopped"; code = WSTOPSIG(st); + } else if (WIFSIGNALED(st)) { + status = "signaled"; code = WTERMSIG(st); + } else { + status = "exited"; code = WEXITSTATUS(st); + } + x = Intern(status); VECTOR(ret)->data[1] = x; + x = Make_Integer(code); VECTOR(ret)->data[2] = x; + VECTOR(ret)->data[3] = st & 0200 ? True : False; +#ifdef WAIT_RUSAGE + x = Cons(Null, Make_Unsigned_Long((unsigned long)ru.ru_utime.tv_usec + * 1000)); + sec = Make_Unsigned_Long((unsigned long)ru.ru_utime.tv_sec); + Car(x) = sec; + VECTOR(ruret)->data[0] = x; + x = Cons(Null, Make_Unsigned_Long((unsigned long)ru.ru_stime.tv_usec + * 1000)); + sec = Make_Unsigned_Long((unsigned long)ru.ru_stime.tv_sec); + Car(x) = sec; + VECTOR(ruret)->data[1] = x; +#endif + GC_Unlink; + return Void; +} + +static Object P_Wait(argc, argv) int argc; Object *argv; { + int flags = 0; + + if (argc == 3) +#ifdef WAIT_OPTIONS + flags = (int)Symbols_To_Bits(argv[2], 1, Wait_Flags); +#else + Primitive_Error("wait options not supported"); +#endif + return General_Wait(argv[0], argv[1], 0, 0, flags); +} + +#ifdef WAIT_PROCESS +/* If WAIT_PROCESS is supported, then WAIT_OPTIONS is supported as well, + * because both waitpid() and wait4() accept options. + */ +static Object P_Wait_Process(argc, argv) int argc; Object *argv; { + return General_Wait(argv[0], argv[1], 1, Get_Integer(argv[2]), + argc == 4 ? (int)Symbols_To_Bits(argv[3], 1, Wait_Flags) : 0); +} +#endif + +elk_init_unix_wait() { + Def_Prim(P_Wait, "unix-wait-vector-fill!", 2, 3, VARARGS); +#ifdef WAIT_PROCESS + Def_Prim(P_Wait_Process, "unix-wait-process-vector-fill!", 3, 4, VARARGS); + P_Provide(Intern("unix:wait-process")); +#endif +#ifdef WAIT_OPTIONS + P_Provide(Intern("unix:wait-options")); +#endif +} diff --git a/lib/xaw/ALIASES b/lib/xaw/ALIASES new file mode 100644 index 0000000..fe58a7f --- /dev/null +++ b/lib/xaw/ALIASES @@ -0,0 +1 @@ +(set! widget-aliases '()) diff --git a/lib/xaw/Makefile b/lib/xaw/Makefile new file mode 100644 index 0000000..cd1a7d3 --- /dev/null +++ b/lib/xaw/Makefile @@ -0,0 +1,24 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../../config/system ../../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + +lint: Makefile.local + $(MAKE) -f Makefile.local lint + +clean: Makefile.local + $(MAKE) -f Makefile.local clean + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/lib/xaw/ascii.d b/lib/xaw/ascii.d new file mode 100644 index 0000000..8738d2c --- /dev/null +++ b/lib/xaw/ascii.d @@ -0,0 +1,33 @@ +;;; -*-Scheme-*- + +(define-widget-type 'asciitext "AsciiText.h") + +(define-widget-class 'ascii-text 'asciiTextWidgetClass + '(font Font FontStruct) + '(foreground Foreground Pixel) + '(dataCompression DataCompression Boolean) + '(displayNonprinting Output Boolean) + '(echo Output Boolean) + '(editType EditType EditMode) + '(length Length Int) + '(pieceSize PieceSize Int) + '(string String String) + '(type Type AsciiType)) + +(define bad-resource +" Primitive_Error (\"cannot get or set sink/source\");") + +(scheme->c 'ascii-text-textSink bad-resource) +(scheme->c 'ascii-text-textSource bad-resource) +(c->scheme 'ascii-text-textSink bad-resource) +(c->scheme 'ascii-text-textSource bad-resource) + +(define-primitive 'ascii-text-string '(w) +" Arg a[1]; + char *s; + + Check_Widget_Class (w, asciiTextWidgetClass); + XtSetArg (a[0], XtNstring, &s); + XtGetValues (WIDGET(w)->widget, a, 1); + return Make_String (s, strlen (s));") + diff --git a/lib/xaw/box.d b/lib/xaw/box.d new file mode 100644 index 0000000..0c44713 --- /dev/null +++ b/lib/xaw/box.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'box "Box.h") + +(define-widget-class 'box 'boxWidgetClass) diff --git a/lib/xaw/build b/lib/xaw/build new file mode 100755 index 0000000..99b31e5 --- /dev/null +++ b/lib/xaw/build @@ -0,0 +1,125 @@ +. ../../config/system +. ../../config/site + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +CC= ${cc-cc} +CFLAGS= $cflags $obj_cflags +LINTFLAGS= $lintflags +SCMFLAGS= -p .:../../scm:../xt + +INC= ../../include + +H= \$(INC)/compat.h\\ + \$(INC)/config.h\\ + \$(INC)/cstring.h\\ + \$(INC)/exception.h\\ + \$(INC)/extern.h\\ + \$(INC)/funcproto.h\\ + \$(INC)/gc.h\\ + \$(INC)/misc.h\\ + \$(INC)/object.h\\ + \$(INC)/param.h\\ + \$(INC)/stkmem.h\\ + \$(INC)/type.h\\ + ../xlib/xlib.h\\ + ../xt/xt.h + +O= ascii.o\\ + box.o\\ + command.o\\ + dialog.o\\ + form.o\\ + grip.o\\ + label.o\\ + list.o\\ + menubutton.o\\ + paned.o\\ + panner.o\\ + porthole.o\\ + repeater.o\\ + scrollbar.o\\ + shell.o\\ + simplemenu.o\\ + sme.o\\ + smebsb.o\\ + smeline.o\\ + stripchart.o\\ + toggle.o\\ + tree.o\\ + viewport.o + +WIDGET_SET= xaw + +.SUFFIXES: .d .c .o + +.c.o: + \$(CC) \$(CFLAGS) -I\$(INC) -I../xlib $x11_incl -c \$< + ../../scripts/makedl \$@ \$@ + +.d.c: + ../../src/scheme \$(SCMFLAGS) -l mkwidget.scm \$< \$@ \$(WIDGET_SET) + +.d.o: + ../../src/scheme \$(SCMFLAGS) -l mkwidget.scm \$< \$*.c \$(WIDGET_SET) + \$(CC) \$(CFLAGS) -I\$(INC) -I../xlib $x11_incl -c \$*.c + ../../scripts/makedl \$@ \$@ + +all: \$(O) + +ascii.o: \$(H) ascii.d +box.o: \$(H) box.d +command.o: \$(H) command.d +dialog.o: \$(H) dialog.d +form.o: \$(H) form.d +grip.o: \$(H) grip.d +label.o: \$(H) label.d +list.o: \$(H) list.d +menubutton.o: \$(H) menubutton.d +paned.o: \$(H) paned.d +panner.o: \$(H) panner.d +porthole.o: \$(H) porthole.d +repeater.o: \$(H) repeater.d +scrollbar.o: \$(H) scrollbar.d +shell.o: \$(H) shell.d +simplemenu.o: \$(H) simplemenu.d +sme.o: \$(H) sme.d +smebsb.o: \$(H) smebsb.d +smeline.o: \$(H) smeline.d +stripchart.o: \$(H) stripchart.d +toggle.o: \$(H) toggle.d +tree.o: \$(H) tree.d +viewport.o: \$(H) viewport.d + +install: \$(O) + -@if [ ! -d $install_dir/runtime ]; then \\ + echo mkdir $install_dir/runtime; \\ + mkdir $install_dir/runtime; \\ + fi + -@if [ ! -d $install_dir/runtime/obj ]; then \\ + echo mkdir $install_dir/runtime/obj; \\ + mkdir $install_dir/runtime/obj; \\ + fi + -@if [ ! -d $install_dir/runtime/obj/xaw ]; then \\ + echo mkdir $install_dir/runtime/obj/xaw; \\ + mkdir $install_dir/runtime/obj/xaw; \\ + fi + @for i in \$(O) ALIASES ;\\ + do \\ + echo cp \$\$i $install_dir/runtime/obj/xaw; \\ + cp \$\$i $install_dir/runtime/obj/xaw; \\ + done + +lint: + lint \$(LINTFLAGS) -I\$(INC) -I../xlib $x11_incl *.c + +clean: + rm -f *.o *.c core + +distclean: + rm -f *.o *.c core lint.out Makefile.local +EOT diff --git a/lib/xaw/clock.d b/lib/xaw/clock.d new file mode 100644 index 0000000..1d21ce7 --- /dev/null +++ b/lib/xaw/clock.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'clock "Clock.h") + +(define-widget-class 'clock 'clockWidgetClass) diff --git a/lib/xaw/command.d b/lib/xaw/command.d new file mode 100644 index 0000000..5caf71b --- /dev/null +++ b/lib/xaw/command.d @@ -0,0 +1,7 @@ +;;; -*-Scheme-*- + +(define-widget-type 'command "Command.h") + +(define-widget-class 'command 'commandWidgetClass) + +(define-callback 'command 'callback #f) diff --git a/lib/xaw/dialog.d b/lib/xaw/dialog.d new file mode 100644 index 0000000..6e6d7a5 --- /dev/null +++ b/lib/xaw/dialog.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'dialog "Dialog.h") + +(define-widget-class 'dialog 'dialogWidgetClass) diff --git a/lib/xaw/form.d b/lib/xaw/form.d new file mode 100644 index 0000000..0e03ec9 --- /dev/null +++ b/lib/xaw/form.d @@ -0,0 +1,11 @@ +;;; -*-Scheme-*- + +(define-widget-type 'form "Form.h") + +(define-widget-class 'form 'formWidgetClass) + +(define-primitive 'form-do-layout '(w enable) +" Check_Widget_Class (w, formWidgetClass); + Check_Type (enable, T_Boolean); + XawFormDoLayout (WIDGET(w)->widget, EQ (enable, True)); + return Void;") diff --git a/lib/xaw/grip.d b/lib/xaw/grip.d new file mode 100644 index 0000000..11fbcb9 --- /dev/null +++ b/lib/xaw/grip.d @@ -0,0 +1,28 @@ +;;; -*-Scheme-*- + +(define-widget-type 'grip "Grip.h") + +(define-widget-class 'grip 'gripWidgetClass) + +(define-callback 'grip 'callback #t) + +(c->scheme 'callback:grip-callback +" Object args, ret, t; + register i; + GripCallData p = (GripCallData)x; + GC_Node3; + + args = ret = t = Null; + GC_Link3 (args, ret, t); + args = Get_Event_Args (p->event); + ret = Cons (Copy_List (args), Null); + Destroy_Event_Args (args); + t = P_Make_List (Make_Integer (p->num_params), Null); + for (i = 0, Cdr (ret) = t; i < p->num_params; i++, t = Cdr (t)) { + Object s; + + s = Make_String (p->params[i], strlen (p->params[i])); + Car (t) = s; + } + GC_Unlink; + return ret;") diff --git a/lib/xaw/label.d b/lib/xaw/label.d new file mode 100644 index 0000000..bd15dc3 --- /dev/null +++ b/lib/xaw/label.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'label "Label.h") + +(define-widget-class 'label 'labelWidgetClass) diff --git a/lib/xaw/list.d b/lib/xaw/list.d new file mode 100644 index 0000000..fa434f4 --- /dev/null +++ b/lib/xaw/list.d @@ -0,0 +1,60 @@ +;;; -*-Scheme-*- + +(define-widget-type 'list "List.h") + +(prolog +" +static char **Get_List (x) Object x; { + register i, n; + register char *s, **l; + Alloca_Begin; + + Check_List (x); + n = Fast_Length (x); + l = (char **)XtMalloc ((n+1) * sizeof (char *)); + for (i = 0; i < n; i++, x = Cdr (x)) { + Get_Strsym_Stack (Car (x), s); + l[i] = XtNewString (s); + } + l[i] = 0; + Alloca_End; + return l; +}") + +(define-widget-class 'list 'listWidgetClass) + +(define-callback 'list 'callback #t) + +(c->scheme 'callback:list-callback +" XawListReturnStruct *p = (XawListReturnStruct *)x; + return Cons (Make_String (p->string, strlen (p->string)), + Make_Integer (p->list_index));") + +(scheme->c 'list-list +" return (XtArgVal)Get_List (x);") + +(define-primitive 'list-change! '(w x resize) +" Check_Widget_Class (w, listWidgetClass); + Check_Type (resize, T_Boolean); + XawListChange (WIDGET(w)->widget, Get_List (x), 0, 0, EQ (resize, True)); + return Void;") + +(define-primitive 'list-highlight '(w i) +" Check_Widget_Class (w, listWidgetClass); + XawListHighlight (WIDGET(w)->widget, Get_Integer (i)); + return Void;") + +(define-primitive 'list-unhighlight '(w) +" Check_Widget_Class (w, listWidgetClass); + XawListUnhighlight (WIDGET(w)->widget); + return Void;") + +(define-primitive 'list-current '(w) +" XawListReturnStruct *p; + + Check_Widget_Class (w, listWidgetClass); + p = XawListShowCurrent (WIDGET(w)->widget); + if (p->list_index == XAW_LIST_NONE) + return False; + return Cons (Make_String (p->string, strlen (p->string)), + Make_Integer (p->list_index));") diff --git a/lib/xaw/menubutton.d b/lib/xaw/menubutton.d new file mode 100644 index 0000000..1984da4 --- /dev/null +++ b/lib/xaw/menubutton.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'menubutton "MenuButton.h") + +(define-widget-class 'menubutton 'menuButtonWidgetClass) diff --git a/lib/xaw/paned.d b/lib/xaw/paned.d new file mode 100644 index 0000000..dff1df8 --- /dev/null +++ b/lib/xaw/paned.d @@ -0,0 +1,33 @@ +;;; -*-Scheme-*- + +(define-widget-type 'paned "Paned.h") + +(define-widget-class 'paned 'panedWidgetClass) + +(define-primitive 'paned-allow-resize '(w enable) +" Check_Widget (w); + Check_Type (enable, T_Boolean); + XawPanedAllowResize (WIDGET(w)->widget, EQ (enable, True)); + return Void;") + +(define-primitive 'paned-set-min-max! '(w min max) +" Check_Widget (w); + XawPanedSetMinMax (WIDGET(w)->widget, Get_Integer (min), + Get_Integer (max)); + return Void;") + +(define-primitive 'paned-get-min-max '(w) +" int min, max; + Check_Widget (w); + XawPanedGetMinMax (WIDGET(w)->widget, &min, &max); + return Cons (Make_Integer (min), Make_Integer (max));") + +(define-primitive 'paned-set-refigure-mode! '(w enable) +" Check_Widget_Class (w, panedWidgetClass); + Check_Type (enable, T_Boolean); + XawPanedSetRefigureMode (WIDGET(w)->widget, EQ (enable, True)); + return Void;") + +(define-primitive 'paned-get-num-sub '(w) +" Check_Widget_Class (w, panedWidgetClass); + return Make_Integer (XawPanedGetNumSub (WIDGET(w)->widget));") diff --git a/lib/xaw/panner.d b/lib/xaw/panner.d new file mode 100644 index 0000000..f18e497 --- /dev/null +++ b/lib/xaw/panner.d @@ -0,0 +1,12 @@ +;;; -*-Scheme-*- + +(define-widget-type 'panner "Panner.h") + +(define-widget-class 'panner 'pannerWidgetClass) + +(define-callback 'panner 'reportCallback #t) + +(c->scheme 'callback:panner-reportCallback +" XawPannerReport *p = (XawPannerReport *)x; + + return Cons (Make_Integer (p->slider_x), Make_Integer (p->slider_y));") diff --git a/lib/xaw/porthole.d b/lib/xaw/porthole.d new file mode 100644 index 0000000..2c3d4f2 --- /dev/null +++ b/lib/xaw/porthole.d @@ -0,0 +1,37 @@ +;;; -*-Scheme-*- + +(define-widget-type 'porthole "Porthole.h") + +(prolog + +"static SYMDESCR Panner_Syms[] = { + { \"slider-x\", XawPRSliderX }, + { \"slider-y\", XawPRSliderY }, + { \"slider-width\", XawPRSliderWidth }, + { \"slider-height\", XawPRSliderHeight }, + { \"canvas-width\", XawPRCanvasWidth }, + { \"canvas-height\", XawPRCanvasHeight }, + { 0, 0 } +};") + +(define-widget-class 'porthole 'portholeWidgetClass) + +(define-callback 'porthole 'reportCallback #t) + +(c->scheme 'callback:porthole-reportCallback +" Object ret; + XawPannerReport *p = (XawPannerReport *)x; + GC_Node; + + ret = Null; + GC_Link (ret); + ret = Cons (Make_Integer (p->canvas_height), ret); + ret = Cons (Make_Integer (p->canvas_width), ret); + ret = Cons (Make_Integer (p->slider_height), ret); + ret = Cons (Make_Integer (p->slider_width), ret); + ret = Cons (Make_Integer (p->slider_y), ret); + ret = Cons (Make_Integer (p->slider_x), ret); + ret = Cons (Bits_To_Symbols ((unsigned long)p->changed, 1, Panner_Syms), + ret); + GC_Unlink; + return ret;") diff --git a/lib/xaw/repeater.d b/lib/xaw/repeater.d new file mode 100644 index 0000000..5596595 --- /dev/null +++ b/lib/xaw/repeater.d @@ -0,0 +1,9 @@ +;;; -*-Scheme-*- + +(define-widget-type 'repeater "Repeater.h") + +(define-widget-class 'repeater 'repeaterWidgetClass) + +(define-callback 'repeater 'startCallback #f) +(define-callback 'repeater 'stopCallback #f) +(define-callback 'repeater 'callback #f) diff --git a/lib/xaw/scrollbar.d b/lib/xaw/scrollbar.d new file mode 100644 index 0000000..d946295 --- /dev/null +++ b/lib/xaw/scrollbar.d @@ -0,0 +1,33 @@ +;;; -*-Scheme-*- + +(define-widget-type 'scrollbar "Scrollbar.h") + +(prolog + +"static SYMDESCR Orientation_Syms[] = { + { \"horizontal\", XtorientHorizontal }, + { \"vertical\", XtorientVertical }, + { 0, 0 } +};") + +(define-widget-class 'scrollbar 'scrollbarWidgetClass) + +(scheme->c 'scrollbar-orientation +" return (XtArgVal)Symbols_To_Bits (x, 0, Orientation_Syms);") + +(c->scheme 'scrollbar-orientation +" return Bits_To_Symbols ((unsigned long)x, 0, Orientation_Syms);") + +(define-callback 'scrollbar 'scrollProc #t) +(define-callback 'scrollbar 'jumpProc #t) + +(c->scheme 'callback:scrollbar-scrollProc +" return Make_Integer ((int)x);") + +(c->scheme 'callback:scrollbar-jumpProc +" return Make_Reduced_Flonum ((double)*(float *)x);") + +(define-primitive 'scrollbar-set-thumb! '(w t s) +" Check_Widget_Class (w, scrollbarWidgetClass); + XawScrollbarSetThumb (WIDGET(w)->widget, Get_Double (t), Get_Double (s)); + return Void;") diff --git a/lib/xaw/shell.d b/lib/xaw/shell.d new file mode 100644 index 0000000..fd464ba --- /dev/null +++ b/lib/xaw/shell.d @@ -0,0 +1,13 @@ +;;; -*-Scheme-*- + +(define-widget-type 'shell "") + +(prolog ; Shell.h is always under X11, since it's +"#include ") ; actually part of Xt, not of Xaw. + +(define-widget-class 'shell 'shellWidgetClass) +(define-widget-class 'override-shell 'overrideShellWidgetClass) +(define-widget-class 'wm-shell 'wmShellWidgetClass) +(define-widget-class 'transient-shell 'transientShellWidgetClass) +(define-widget-class 'toplevel-shell 'topLevelShellWidgetClass) +(define-widget-class 'application-shell 'applicationShellWidgetClass) diff --git a/lib/xaw/simplemenu.d b/lib/xaw/simplemenu.d new file mode 100644 index 0000000..a0dacbe --- /dev/null +++ b/lib/xaw/simplemenu.d @@ -0,0 +1,20 @@ +;;; -*-Scheme-*- + +(define-widget-type 'simplemenu "SimpleMenu.h") + +(define-widget-class 'simplemenu 'simpleMenuWidgetClass) + +(define-primitive 'simplemenu-add-global-actions '(c) +" Check_Context (c); + XawSimpleMenuAddGlobalActions (CONTEXT(c)->context); + return Void;") + +(define-primitive 'simplemenu-get-active-entry '(w) +" Check_Widget_Class (w, simpleMenuWidgetClass); + return + Make_Widget_Foreign (XawSimpleMenuGetActiveEntry (WIDGET(w)->widget));") + +(define-primitive 'simplemenu-clear-active-entry '(w) +" Check_Widget_Class (w, simpleMenuWidgetClass); + XawSimpleMenuClearActiveEntry (WIDGET(w)->widget); + return Void;") diff --git a/lib/xaw/sme.d b/lib/xaw/sme.d new file mode 100644 index 0000000..302c2b4 --- /dev/null +++ b/lib/xaw/sme.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'sme "Sme.h") + +(define-widget-class 'sme 'smeObjectClass) diff --git a/lib/xaw/smebsb.d b/lib/xaw/smebsb.d new file mode 100644 index 0000000..4e508c4 --- /dev/null +++ b/lib/xaw/smebsb.d @@ -0,0 +1,7 @@ +;;; -*-Scheme-*- + +(define-widget-type 'smebsb "SmeBSB.h") + +(define-widget-class 'smebsb 'smeBSBObjectClass) + +(define-callback 'smebsb 'callback #f) diff --git a/lib/xaw/smeline.d b/lib/xaw/smeline.d new file mode 100644 index 0000000..ce0571a --- /dev/null +++ b/lib/xaw/smeline.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'smeline "SmeLine.h") + +(define-widget-class 'smeline 'smeLineObjectClass) diff --git a/lib/xaw/stripchart.d b/lib/xaw/stripchart.d new file mode 100644 index 0000000..f40108f --- /dev/null +++ b/lib/xaw/stripchart.d @@ -0,0 +1,44 @@ +;;; -*-Scheme-*- + +(define-widget-type 'stripchart "StripChart.h") + +(prolog + +"static void Get_Value (w, client_data, value) Widget w; + XtPointer client_data; XtPointer value; { + Object ret; + + ret = Funcall (Get_Function ((int)client_data), Null, 0); + switch (TYPE(ret)) { + case T_Fixnum: *(double *)value = (double)FIXNUM(ret); break; + case T_Flonum: *(double *)value = FLONUM(ret)->val; break; + case T_Bignum: *(double *)value = Bignum_To_Double (ret); break; + default: Primitive_Error (\"stripchart sampler must return number\"); + } +}") + +(define-widget-class 'stripchart 'stripChartWidgetClass) + +(define-primitive 'stripchart-set-sampler '(w p) +" int i; + Arg a[1]; + XtCallbackList c; + + Check_Widget_Class (w, stripChartWidgetClass); + Check_Procedure (p); + XtSetArg (a[0], XtNgetValue, &c); + XtGetValues (WIDGET(w)->widget, a, 1); + if (c[0].callback) + Primitive_Error (\"stripchart already has a sampler\"); + i = Register_Function (p); + XtAddCallback (WIDGET(w)->widget, XtNgetValue, Get_Value, (XtPointer)i); + return Make_Id ('s', (XtPointer)WIDGET(w)->widget, i);") + +(define-primitive 'stripchart-remove-sampler '(i) +" Widget w; + + w = (Widget)Use_Id (i, 's'); + XtRemoveCallback (w, XtNgetValue, Get_Value, + (XtPointer)IDENTIFIER(i)->num); + Deregister_Function (IDENTIFIER(i)->num); + return Void;") diff --git a/lib/xaw/toggle.d b/lib/xaw/toggle.d new file mode 100644 index 0000000..c49d11c --- /dev/null +++ b/lib/xaw/toggle.d @@ -0,0 +1,33 @@ +;;; -*-Scheme-*- + +(define-widget-type 'toggle "Toggle.h") + +(define-widget-class 'toggle 'toggleWidgetClass) + +(define-callback 'toggle 'callback #f) + +(scheme->c 'toggle-radioData +" return (XtArgVal)Get_Integer (x);") + +(c->scheme 'toggle-radioData +" return Make_Integer ((int)x);") + +(define-primitive 'toggle-change-radio-group! '(w1 w2) +" Check_Widget_Class (w1, toggleWidgetClass); + Check_Widget_Class (w2, toggleWidgetClass); + XawToggleChangeRadioGroup (WIDGET(w1)->widget, WIDGET(w2)->widget); + return Void;") + +(define-primitive 'toggle-get-current '(w) +" Check_Widget_Class (w, toggleWidgetClass); + return Make_Integer ((int)XawToggleGetCurrent (WIDGET(w)->widget));") + +(define-primitive 'toggle-set-current! '(w x) +" Check_Widget_Class (w, toggleWidgetClass); + XawToggleSetCurrent (WIDGET(w)->widget, (caddr_t)Get_Integer (x)); + return Void;") + +(define-primitive 'toggle-unset-current! '(w) +" Check_Widget_Class (w, toggleWidgetClass); + XawToggleUnsetCurrent (WIDGET(w)->widget); + return Void;") diff --git a/lib/xaw/tree.d b/lib/xaw/tree.d new file mode 100644 index 0000000..ad1df22 --- /dev/null +++ b/lib/xaw/tree.d @@ -0,0 +1,10 @@ +;;; -*-Scheme-*- + +(define-widget-type 'tree "Tree.h") + +(define-widget-class 'tree 'treeWidgetClass) + +(define-primitive 'tree-force-layout '(w) +" Check_Widget_Class (w, treeWidgetClass); + XawTreeForceLayout (WIDGET(w)->widget); + return Void;") diff --git a/lib/xaw/viewport.d b/lib/xaw/viewport.d new file mode 100644 index 0000000..448cbb4 --- /dev/null +++ b/lib/xaw/viewport.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'viewport "Viewport.h") + +(define-widget-class 'viewport 'viewportWidgetClass) diff --git a/lib/xlib/MISSING b/lib/xlib/MISSING new file mode 100644 index 0000000..4a4e643 --- /dev/null +++ b/lib/xlib/MISSING @@ -0,0 +1,135 @@ +send-event? argument to all handler functions + +No support for screens and visuals yet + +Missing functions: + +XNewModifiermap XFreeModifiermap +XGetModifierMapping XSetModifierMapping +XInsertModifiermapEntry XDeleteModifiermapEntry + +XCreateImage XGetImage XGetPixel +XDestroyImage XPutImage XPutPixel +XGetSubImage XAddPixel XSubImage + +XCreateColormap XAllocColorPlanes +XCopyColormapAndFree XAllocColorCells +XStoreNamedColor XFreeColors XStoreColors + +XAddHosts XEnableAccessControl +XRemoveHosts XDisableAccessControl +XListHosts + +XGetWMColormapWindows XGetRGBColormaps XWMGeometry +XSetWMColormapWindows XSetRGBColormaps + +XGetErrorDatabaseText XGetErrorText + +XKillClient XSendEvent + +XVisualIDFromVisual +XGetVisualInfo +XMatchVisualInfo +XDefaultVisual + +XDoesBackingStore XDoesSaveUnders + +XRootWindowOfScreen +XDefaultVisualOfScreen +XDefaultGCOfScreen +XBlackPixelOfScreen +XWhitePixelOfScreen +XDefaultColormapOfScreen +XDisplayOfScreen +XEventMaskOfScreen +XScreenNumberOfScreen +XCellsOfScreen +XDefaultDepthOfScreen +XHeightMMOfScreen +XHeightOfScreen +XMaxCmapsOfScreen +XMinCmapsOfScreen +XPlanesOfScreen +XWidthMMOfScreen +XWidthOfScreen +XScreenOfDisplay +XDefaultScreenOfDisplay + +XActivateScreenSaver +XForceScreenSaver +XGetScreenSaver +XResetScreenSaver +XSetScreenSaver +XAutoRepeatOff +XAutoRepeatOn +XChangeKeyboardControl +XGetKeyboardControl +XChangeKeyboardMapping +XGetKeyboardMapping +XChangePointerControl +XGetPointerControl +XQueryKeymap + +XSupportsLocale +XSetLocaleModifiers +XCreateFontSet +XFreeFontSet +XFontsOfFontSet +XBaseFontNameListOfFontSet +XLocaleOfFontSet +XContextDependentDrawing +XExtentsOfFontSet + +XmbTextEscapement +XwcTextEscapement +XmbTextExtents +XwcTextExtents +XmbTextPerCharExtents +XwcTextPerCharExtents +XmbDrawText +XwcDrawText +XmbDrawString +XwcDrawString +XmbDrawImageString +XwcDrawImageString +XmbLookupString +XwcLookupString +XDefaultString +XmbTextListToTextProperty +XwcTextListToTextProperty +XwcFreeStringList +XmbTextPropertyToTextList +XwcTextPropertyToTextList +XmbSetWMProperties + +XOpenIM +XCloseIM +XGetIMValues +XDisplayOfIM +XLocaleOfIM +XCreateIC +XDestroyIC +XSetICFocus +XUnsetICFocus +XwcResetIC +XmbResetIC +XSetICValues +XGetICValues +XIMOfIC + +XClipBox +XCreateRegion +XDestroyRegion +XEmptyRegion +XEqualRegion +XIntersectRegion +XOffsetRegion +XPointInRegion +XPolygonRegion +XRectInRegion +XSetRegion +XShrinkRegion +XSubtractRegion +XUnionRectWithRegion +XUnionRegion +XXorRegion diff --git a/lib/xlib/Makefile b/lib/xlib/Makefile new file mode 100644 index 0000000..cd1a7d3 --- /dev/null +++ b/lib/xlib/Makefile @@ -0,0 +1,24 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../../config/system ../../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + +lint: Makefile.local + $(MAKE) -f Makefile.local lint + +clean: Makefile.local + $(MAKE) -f Makefile.local clean + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/lib/xlib/build b/lib/xlib/build new file mode 100755 index 0000000..4553a32 --- /dev/null +++ b/lib/xlib/build @@ -0,0 +1,138 @@ +. ../../config/system +. ../../config/site + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +CC= ${cc-cc} +CFLAGS= $cflags $obj_cflags +LINTFLAGS= $lintflags + +INC= ../../include + +H= \$(INC)/compat.h\\ + \$(INC)/config.h\\ + \$(INC)/cstring.h\\ + \$(INC)/exception.h\\ + \$(INC)/extern.h\\ + \$(INC)/funcproto.h\\ + \$(INC)/gc.h\\ + \$(INC)/misc.h\\ + \$(INC)/object.h\\ + \$(INC)/param.h\\ + \$(INC)/stkmem.h\\ + \$(INC)/type.h\\ + xlib.h + +C= client.c\\ + color.c\\ + colormap.c\\ + cursor.c\\ + display.c\\ + error.c\\ + event.c\\ + extension.c\\ + font.c\\ + gcontext.c\\ + grab.c\\ + graphics.c\\ + init.c\\ + key.c\\ + objects.c\\ + pixel.c\\ + pixmap.c\\ + property.c\\ + text.c\\ + type.c\\ + util.c\\ + window.c\\ + wm.c + +O= client.o\\ + color.o\\ + colormap.o\\ + cursor.o\\ + display.o\\ + error.o\\ + event.o\\ + extension.o\\ + font.o\\ + gcontext.o\\ + grab.o\\ + graphics.o\\ + init.o\\ + key.o\\ + objects.o\\ + pixel.o\\ + pixmap.o\\ + property.o\\ + text.o\\ + type.o\\ + util.o\\ + window.o\\ + wm.o + +all: \$(O) xlib.pre + +.c.o: + \$(CC) \$(CFLAGS) -I\$(INC) $x11_incl -c \$< + +client.o: \$(H) client.c +color.o: \$(H) color.c +colormap.o: \$(H) colormap.c +cursor.o: \$(H) cursor.c +display.o: \$(H) display.c +error.o: \$(H) error.c +event.o: \$(H) event.c +extension.o: \$(H) extension.c +font.o: \$(H) font.c +gcontext.o: \$(H) gcontext.c +grab.o: \$(H) grab.c +graphics.o: \$(H) graphics.c +init.o: \$(H) init.c +key.o: \$(H) key.c +objects.o: \$(H) objects.c +pixel.o: \$(H) pixel.c +pixmap.o: \$(H) pixmap.c +property.o: \$(H) property.c +text.o: \$(H) text.c +type.o: \$(H) type.c +util.o: \$(H) util.c +window.o: \$(H) window.c +wm.o: \$(H) wm.c + +xlib.pre: \$(O) + ../../scripts/makedl \$@ \$(O) + +install: xlib.pre + -@if [ ! -d $install_dir/runtime ]; then \\ + echo mkdir $install_dir/runtime; \\ + mkdir $install_dir/runtime; \\ + fi + -@if [ ! -d $install_dir/runtime/obj ]; then \\ + echo mkdir $install_dir/runtime/obj; \\ + mkdir $install_dir/runtime/obj; \\ + fi + cp xlib.pre $install_dir/runtime/obj/xlib.o + -@if [ ! -d $install_dir/include ]; then \\ + echo mkdir $install_dir/include; \\ + mkdir $install_dir/include; \\ + fi + -@if [ ! -d $install_dir/include/extensions ]; then \\ + echo mkdir $install_dir/include/extensions; \\ + mkdir $install_dir/include/extensions; \\ + fi + cp xlib.h $install_dir/include/extensions + +lint: + lint \$(LINTFLAGS) -I\$(INC) $x11_incl \$(C) + +clean: + rm -f *.o xlib.pre core + +distclean: + rm -f *.o xlib.pre core lint.out Makefile.local +EOT diff --git a/lib/xlib/client.c b/lib/xlib/client.c new file mode 100644 index 0000000..e110b14 --- /dev/null +++ b/lib/xlib/client.c @@ -0,0 +1,390 @@ +#include "xlib.h" + +static Object Sym_Wm_Hints, Sym_Size_Hints; + +static Object P_Iconify_Window (w, scr) Object w, scr; { + Check_Type (w, T_Window); + if (!XIconifyWindow (WINDOW(w)->dpy, WINDOW(w)->win, + Get_Screen_Number (WINDOW(w)->dpy, scr))) + Primitive_Error ("cannot iconify window"); + return Void; +} + +static Object P_Withdraw_Window (w, scr) Object w, scr; { + Check_Type (w, T_Window); + if (!XWithdrawWindow (WINDOW(w)->dpy, WINDOW(w)->win, + Get_Screen_Number (WINDOW(w)->dpy, scr))) + Primitive_Error ("cannot withdraw window"); + return Void; +} + +static Object P_Reconfigure_Wm_Window (w, scr, conf) Object w, scr, conf; { + unsigned long mask; + + Check_Type (w, T_Window); + mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec); + if (!XReconfigureWMWindow (WINDOW(w)->dpy, WINDOW(w)->win, + Get_Screen_Number (WINDOW(w)->dpy, scr), mask, &WC)) + Primitive_Error ("cannot reconfigure window"); + return Void; +} + +static Object P_Wm_Command (w) Object w; { + int i, ac; + char **av; + Object s, ret, t; + GC_Node2; + + Check_Type (w, T_Window); + Disable_Interrupts; + if (!XGetCommand (WINDOW(w)->dpy, WINDOW(w)->win, &av, &ac)) + ac = 0; + Enable_Interrupts; + ret = t = P_Make_List (Make_Integer (ac), Null); + GC_Link2 (ret, t); + for (i = 0; i < ac; i++, t = Cdr (t)) { + s = Make_String (av[i], strlen (av[i])); + Car (t) = s; + } + GC_Unlink; + if (ac) XFreeStringList (av); + return ret; +} + +static String_List_To_Text_Property (x, ret) Object x; XTextProperty *ret; { + register i, n; + register char **s; + Object t; + Alloca_Begin; + + Check_List (x); + n = Fast_Length (x); + Alloca (s, char**, n * sizeof (char *)); + for (i = 0; i < n; i++, x = Cdr (x)) { + t = Car (x); + Get_Strsym_Stack (t, s[i]); + } + if (!XStringListToTextProperty (s, n, ret)) + Primitive_Error ("cannot create text property"); + Alloca_End; +} + +static Object Text_Property_To_String_List (p) XTextProperty *p; { + int n; + register i; + char **s; + Object x, ret, t; + GC_Node2; + + if (!XTextPropertyToStringList (p, &s, &n)) + Primitive_Error ("cannot convert from text property"); + ret = t = P_Make_List (Make_Integer (n), Null); + GC_Link2 (ret, t); + for (i = 0; i < n; i++, t = Cdr (t)) { + x = Make_String (s[i], strlen (s[i])); + Car (t) = x; + } + GC_Unlink; + XFreeStringList (s); + return ret; +} + +static Object P_Get_Text_Property (w, a) Object w, a; { + XTextProperty ret; + + Check_Type (w, T_Window); + Check_Type (a, T_Atom); + Disable_Interrupts; + if (!XGetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &ret, + ATOM(a)->atom)) { + Enable_Interrupts; + return False; + } + Enable_Interrupts; + return Text_Property_To_String_List (&ret); +} + +static Object P_Set_Text_Property (w, prop, a) Object w, prop, a; { + XTextProperty p; + + Check_Type (w, T_Window); + Check_Type (a, T_Atom); + String_List_To_Text_Property (prop, &p); + XSetTextProperty (WINDOW(w)->dpy, WINDOW(w)->win, &p, ATOM(a)->atom); + XFree ((char *)p.value); + return Void; +} + +static Object P_Wm_Protocols (w) Object w; { + Atom *p; + int i, n; + Object ret; + GC_Node; + + Check_Type (w, T_Window); + Disable_Interrupts; + if (!XGetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n)) + Primitive_Error ("cannot get WM protocols"); + Enable_Interrupts; + ret = Make_Vector (n, Null); + GC_Link (ret); + for (i = 0; i < n; i++) { + Object a; + + a = Make_Atom (p[i]); + VECTOR(ret)->data[i] = a; + } + XFree ((char *)p); + GC_Unlink; + return ret; +} + +static Object P_Set_Wm_Protocols (w, v) Object w, v; { + Atom *p; + int i, n; + Alloca_Begin; + + Check_Type (w, T_Window); + Check_Type (v, T_Vector); + n = VECTOR(v)->size; + Alloca (p, Atom*, n * sizeof (Atom)); + for (i = 0; i < n; i++) { + Object a; + a = VECTOR(v)->data[i]; + Check_Type (a, T_Atom); + p[i] = ATOM(a)->atom; + } + if (!XSetWMProtocols (WINDOW(w)->dpy, WINDOW(w)->win, p, n)) + Primitive_Error ("cannot set WM protocols"); + Alloca_End; + return Void; +} + +static Object P_Wm_Class (w) Object w; { + Object ret, x; + XClassHint c; + GC_Node; + + Check_Type (w, T_Window); + /* + * In X11.2 XGetClassHint() returns either 0 or Success, which happens + * to be defined as 0. So until this bug is fixed, we must + * explicitly check whether the XClassHint structure has been filled. + */ + c.res_name = c.res_class = 0; + Disable_Interrupts; + (void)XGetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c); + Enable_Interrupts; + ret = Cons (False, False); + GC_Link (ret); + if (c.res_name) { + x = Make_String (c.res_name, strlen (c.res_name)); + Car (ret) = x; + XFree (c.res_name); + } + if (c.res_class) { + x = Make_String (c.res_class, strlen (c.res_class)); + Cdr (ret) = x; + XFree (c.res_class); + } + GC_Unlink; + return ret; +} + +static Object P_Set_Wm_Class (w, name, class) Object w, name, class; { + XClassHint c; + + Check_Type (w, T_Window); + c.res_name = Get_Strsym (name); + c.res_class = Get_Strsym (class); + XSetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c); + return Void; +} + +static Object P_Set_Wm_Command (w, cmd) Object w, cmd; { + register i, n; + register char **argv; + Object c; + Alloca_Begin; + + Check_Type (w, T_Window); + Check_List (cmd); + n = Fast_Length (cmd); + Alloca (argv, char**, n * sizeof (char *)); + for (i = 0; i < n; i++, cmd = Cdr (cmd)) { + c = Car (cmd); + Get_Strsym_Stack (c, argv[i]); + } + XSetCommand (WINDOW(w)->dpy, WINDOW(w)->win, argv, n); + Alloca_End; + return Void; +} + +static Object P_Wm_Hints (w) Object w; { + XWMHints *p; + + Check_Type (w, T_Window); + Disable_Interrupts; + p = XGetWMHints (WINDOW(w)->dpy, WINDOW(w)->win); + Enable_Interrupts; + if (p) { + WMH = *p; + XFree ((char *)p); + } else { + WMH.flags = 0; + } + return Record_To_Vector (Wm_Hints_Rec, Wm_Hints_Size, Sym_Wm_Hints, + WINDOW(w)->dpy, (unsigned long)WMH.flags); +} + +static Object P_Set_Wm_Hints (w, h) Object w, h; { + unsigned long mask; + + Check_Type (w, T_Window); + mask = Vector_To_Record (h, Wm_Hints_Size, Sym_Wm_Hints, Wm_Hints_Rec); + WMH.flags = mask; + XSetWMHints (WINDOW(w)->dpy, WINDOW(w)->win, &WMH); + return Void; +} + +static Object P_Size_Hints (w, a) Object w, a; { + long supplied; + + Check_Type (w, T_Window); + Check_Type (a, T_Atom); + Disable_Interrupts; + if (!XGetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, &supplied, + ATOM(a)->atom)) + SZH.flags = 0; + if (!(supplied & PBaseSize)) + SZH.flags &= ~PBaseSize; + if (!(supplied & PWinGravity)) + SZH.flags &= ~PWinGravity; + Enable_Interrupts; + if ((SZH.flags & (PPosition|USPosition)) == (PPosition|USPosition)) + SZH.flags &= ~PPosition; + if ((SZH.flags & (PSize|USSize)) == (PSize|USSize)) + SZH.flags &= ~PSize; + return Record_To_Vector (Size_Hints_Rec, Size_Hints_Size, Sym_Size_Hints, + WINDOW(w)->dpy, (unsigned long)SZH.flags); +} + +static Object P_Set_Size_Hints (w, a, h) Object w, a, h; { + unsigned long mask; + + Check_Type (w, T_Window); + Check_Type (a, T_Atom); + bzero ((char *)&SZH, sizeof (SZH)); /* Not portable? */ + mask = Vector_To_Record (h, Size_Hints_Size, Sym_Size_Hints, + Size_Hints_Rec); + if ((mask & (PPosition|USPosition)) == (PPosition|USPosition)) + mask &= ~PPosition; + if ((mask & (PSize|USSize)) == (PSize|USSize)) + mask &= ~PSize; + SZH.flags = mask; + XSetWMSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, ATOM(a)->atom); + return Void; +} + +static Object P_Icon_Sizes (w) Object w; { + XIconSize *p; + int i, n; + Object v; + GC_Node; + + Check_Type (w, T_Window); + Disable_Interrupts; + if (!XGetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n)) + n = 0; + Enable_Interrupts; + v = Make_Vector (n, Null); + GC_Link (v); + for (i = 0; i < n; i++) { + register XIconSize *q = &p[i]; + Object t; + + t = P_Make_List (Make_Integer (6), Null); + VECTOR(v)->data[i] = t; + Car (t) = Make_Integer (q->min_width); t = Cdr (t); + Car (t) = Make_Integer (q->min_height); t = Cdr (t); + Car (t) = Make_Integer (q->max_width); t = Cdr (t); + Car (t) = Make_Integer (q->max_height); t = Cdr (t); + Car (t) = Make_Integer (q->width_inc); t = Cdr (t); + Car (t) = Make_Integer (q->height_inc); + } + GC_Unlink; + if (n > 0) + XFree ((char *)p); + return v; +} + +static Object P_Set_Icon_Sizes (w, v) Object w, v; { + register i, n; + XIconSize *p; + Alloca_Begin; + + Check_Type (w, T_Window); + Check_Type (v, T_Vector); + n = VECTOR(v)->size; + Alloca (p, XIconSize*, n * sizeof (XIconSize)); + for (i = 0; i < n; i++) { + register XIconSize *q = &p[i]; + Object t; + + t = VECTOR(v)->data[i]; + Check_List (t); + if (Fast_Length (t) != 6) + Primitive_Error ("invalid argument: ~s", t); + q->min_width = Get_Integer (Car (t)); t = Cdr (t); + q->min_height = Get_Integer (Car (t)); t = Cdr (t); + q->max_width = Get_Integer (Car (t)); t = Cdr (t); + q->max_height = Get_Integer (Car (t)); t = Cdr (t); + q->width_inc = Get_Integer (Car (t)); t = Cdr (t); + q->height_inc = Get_Integer (Car (t)); + } + XSetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, p, n); + Alloca_End; + return Void; +} + +static Object P_Transient_For (w) Object w; { + Window win; + + Disable_Interrupts; + if (!XGetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, &win)) + win = None; + Enable_Interrupts; + return Make_Window (0, WINDOW(w)->dpy, win); +} + +static Object P_Set_Transient_For (w, pw) Object w, pw; { + Check_Type (w, T_Window); + XSetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, Get_Window (pw)); + return Void; +} + +elk_init_xlib_client () { + Define_Symbol (&Sym_Wm_Hints, "wm-hints"); + Define_Symbol (&Sym_Size_Hints, "size-hints"); + Define_Primitive (P_Iconify_Window, "iconify-window", 2, 2, EVAL); + Define_Primitive (P_Withdraw_Window, "withdraw-window", 2, 2, EVAL); + Define_Primitive (P_Reconfigure_Wm_Window, + "xlib-reconfigure-wm-window", 3, 3, EVAL); + Define_Primitive (P_Wm_Command, "wm-command", 1, 1, EVAL); + Define_Primitive (P_Get_Text_Property,"get-text-property", 2, 2, EVAL); + Define_Primitive (P_Set_Text_Property,"set-text-property!",3, 3, EVAL); + Define_Primitive (P_Wm_Protocols, "wm-protocols", 1, 1, EVAL); + Define_Primitive (P_Set_Wm_Protocols, "set-wm-protocols!", 2, 2, EVAL); + Define_Primitive (P_Wm_Class, "wm-class", 1, 1, EVAL); + Define_Primitive (P_Set_Wm_Class, "set-wm-class!", 3, 3, EVAL); + Define_Primitive (P_Set_Wm_Command, "set-wm-command!", 2, 2, EVAL); + Define_Primitive (P_Wm_Hints, "xlib-wm-hints", 1, 1, EVAL); + Define_Primitive (P_Set_Wm_Hints, "xlib-set-wm-hints!",2, 2, EVAL); + Define_Primitive (P_Size_Hints, "xlib-wm-size-hints",2, 2, EVAL); + Define_Primitive (P_Set_Size_Hints, + "xlib-set-wm-size-hints!", 3, 3, EVAL); + Define_Primitive (P_Icon_Sizes, "icon-sizes", 1, 1, EVAL); + Define_Primitive (P_Set_Icon_Sizes, "set-icon-sizes!", 2, 2, EVAL); + Define_Primitive (P_Transient_For, "transient-for", 1, 1, EVAL); + Define_Primitive (P_Set_Transient_For,"set-transient-for!",2, 2, EVAL); +} diff --git a/lib/xlib/color.c b/lib/xlib/color.c new file mode 100644 index 0000000..634aaa5 --- /dev/null +++ b/lib/xlib/color.c @@ -0,0 +1,129 @@ +#include "xlib.h" + +Generic_Predicate (Color) + +static Color_Equal (x, y) Object x, y; { + register XColor *p = &COLOR(x)->c, *q = &COLOR(y)->c; + return p->red == q->red && p->green == q->green && p->blue == q->blue; +} + +Generic_Print (Color, "#[color %lu]", POINTER(x)) + +Object Make_Color (r, g, b) unsigned int r, g, b; { + Object c; + + c = Find_Object (T_Color, (GENERIC)0, Match_X_Obj, r, g, b); + if (Nullp (c)) { + c = Alloc_Object (sizeof (struct S_Color), T_Color, 0); + COLOR(c)->tag = Null; + COLOR(c)->c.red = r; + COLOR(c)->c.green = g; + COLOR(c)->c.blue = b; + Register_Object (c, (GENERIC)0, (PFO)0, 0); + } + return c; +} + +XColor *Get_Color (c) Object c; { + Check_Type (c, T_Color); + return &COLOR(c)->c; +} + +static unsigned short Get_RGB_Value (x) Object x; { + double d; + + d = Get_Double (x); + if (d < 0.0 || d > 1.0) + Primitive_Error ("bad RGB value: ~s", x); + return (unsigned short)(d * 65535); +} + +static Object P_Make_Color (r, g, b) Object r, g, b; { + return Make_Color (Get_RGB_Value (r), Get_RGB_Value (g), Get_RGB_Value (b)); +} + +static Object P_Color_Rgb_Values (c) Object c; { + Object ret, t, x; + GC_Node3; + + Check_Type (c, T_Color); + ret = t = Null; + GC_Link3 (c, ret, t); + t = ret = P_Make_List (Make_Integer (3), Null); + GC_Unlink; + x = Make_Reduced_Flonum ((double)COLOR(c)->c.red / 65535.0); + Car (t) = x; t = Cdr (t); + x = Make_Reduced_Flonum ((double)COLOR(c)->c.green / 65535.0); + Car (t) = x; t = Cdr (t); + x = Make_Reduced_Flonum ((double)COLOR(c)->c.blue / 65535.0); + Car (t) = x; + return ret; +} + +static Object P_Query_Color (cmap, p) Object cmap, p; { + XColor c; + Colormap cm = Get_Colormap (cmap); + + c.pixel = Get_Pixel (p); + Disable_Interrupts; + XQueryColor (COLORMAP(cmap)->dpy, cm, &c); + Enable_Interrupts; + return Make_Color (c.red, c.green, c.blue); +} + +static Object P_Query_Colors (cmap, v) Object cmap, v; { + Colormap cm = Get_Colormap (cmap); + register i, n; + Object ret; + register XColor *p; + GC_Node; + Alloca_Begin; + + Check_Type (v, T_Vector); + n = VECTOR(v)->size; + Alloca (p, XColor*, n * sizeof (XColor)); + for (i = 0; i < n; i++) + p[i].pixel = Get_Pixel (VECTOR(v)->data[i]); + Disable_Interrupts; + XQueryColors (COLORMAP(cmap)->dpy, cm, p, n); + Enable_Interrupts; + ret = Make_Vector (n, Null); + GC_Link (ret); + for (i = 0; i < n; i++, p++) { + Object x; + + x = Make_Color (p->red, p->green, p->blue); + VECTOR(ret)->data[i] = x; + } + GC_Unlink; + Alloca_End; + return ret; +} + +static Object P_Lookup_Color (cmap, name) Object cmap, name; { + XColor visual, exact; + Colormap cm = Get_Colormap (cmap); + Object ret, x; + GC_Node; + + if (!XLookupColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name), + &visual, &exact)) + Primitive_Error ("no such color: ~s", name); + ret = Cons (Null, Null); + GC_Link (ret); + x = Make_Color (visual.red, visual.green, visual.blue); + Car (ret) = x; + x = Make_Color (exact.red, exact.green, exact.blue); + Cdr (ret) = x; + GC_Unlink; + return ret; +} + +elk_init_xlib_color () { + Generic_Define (Color, "color", "color?"); + Define_Primitive (P_Make_Color, "make-color", 3, 3, EVAL); + Define_Primitive (P_Color_Rgb_Values, "color-rgb-values", 1, 1, EVAL); + Define_Primitive (P_Query_Color, "query-color", 2, 2, EVAL); + Define_Primitive (P_Query_Colors, "query-colors", 2, 2, EVAL); + Define_Primitive (P_Lookup_Color, "lookup-color", 2, 2, EVAL); +} diff --git a/lib/xlib/colormap.c b/lib/xlib/colormap.c new file mode 100644 index 0000000..c1b75da --- /dev/null +++ b/lib/xlib/colormap.c @@ -0,0 +1,88 @@ +#include "xlib.h" + +Generic_Predicate (Colormap) + +Generic_Equal_Dpy (Colormap, COLORMAP, cm) + +Generic_Print (Colormap, "#[colormap %lu]", COLORMAP(x)->cm) + +Generic_Get_Display (Colormap, COLORMAP) + +Object Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; { + Object cm; + + if (cmap == None) + return Sym_None; + cm = Find_Object (T_Colormap, (GENERIC)dpy, Match_X_Obj, cmap); + if (Nullp (cm)) { + cm = Alloc_Object (sizeof (struct S_Colormap), T_Colormap, 0); + COLORMAP(cm)->tag = Null; + COLORMAP(cm)->cm = cmap; + COLORMAP(cm)->dpy = dpy; + COLORMAP(cm)->free = 0; + Register_Object (cm, (GENERIC)dpy, finalize ? P_Free_Colormap : + (PFO)0, 0); + } + return cm; +} + +Colormap Get_Colormap (c) Object c; { + Check_Type (c, T_Colormap); + return COLORMAP(c)->cm; +} + +Object P_Free_Colormap (c) Object c; { + Check_Type (c, T_Colormap); + if (!COLORMAP(c)->free) + XFreeColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm); + Deregister_Object (c); + COLORMAP(c)->free = 1; + return Void; +} + +static Object P_Alloc_Color (cmap, color) Object cmap, color; { + XColor c; + Colormap cm = Get_Colormap (cmap); + int r; + + c = *Get_Color (color); + Disable_Interrupts; + r = XAllocColor (COLORMAP(cmap)->dpy, cm, &c); + Enable_Interrupts; + if (!r) + return False; + return Make_Pixel (c.pixel); +} + +static Object P_Alloc_Named_Color (cmap, name) Object cmap, name; { + Colormap cm = Get_Colormap (cmap); + XColor screen, exact; + int r; + Object ret, t, x; + GC_Node2; + + Disable_Interrupts; + r = XAllocNamedColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name), + &screen, &exact); + Enable_Interrupts; + if (!r) + return False; + t = ret = P_Make_List (Make_Integer (3), Null); + GC_Link2 (t, ret); + x = Make_Pixel (screen.pixel); + Car (t) = x; t = Cdr (t); + x = Make_Color (screen.red, screen.green, screen.blue); + Car (t) = x; t = Cdr (t); + x = Make_Color (exact.red, exact.green, exact.blue); + Car (t) = x; + GC_Unlink; + return ret; +} + +elk_init_xlib_colormap () { + Generic_Define (Colormap, "colormap", "colormap?"); + Define_Primitive (P_Colormap_Display, "colormap-display", 1, 1, EVAL); + Define_Primitive (P_Free_Colormap, "free-colormap", 1, 1, EVAL); + Define_Primitive (P_Alloc_Color, "alloc-color", 2, 2, EVAL); + Define_Primitive (P_Alloc_Named_Color,"alloc-named-color",2, 2, EVAL); +} diff --git a/lib/xlib/cursor.c b/lib/xlib/cursor.c new file mode 100644 index 0000000..e5066a8 --- /dev/null +++ b/lib/xlib/cursor.c @@ -0,0 +1,91 @@ +#include "xlib.h" + +Generic_Predicate (Cursor) + +Generic_Equal_Dpy (Cursor, CURSOR, cursor) + +Generic_Print (Cursor, "#[cursor %lu]", CURSOR(x)->cursor) + +Generic_Get_Display (Cursor, CURSOR) + +static Object Internal_Make_Cursor (finalize, dpy, cursor) + Display *dpy; Cursor cursor; { + Object c; + + if (cursor == None) + return Sym_None; + c = Find_Object (T_Cursor, (GENERIC)dpy, Match_X_Obj, cursor); + if (Nullp (c)) { + c = Alloc_Object (sizeof (struct S_Cursor), T_Cursor, 0); + CURSOR(c)->tag = Null; + CURSOR(c)->cursor = cursor; + CURSOR(c)->dpy = dpy; + CURSOR(c)->free = 0; + Register_Object (c, (GENERIC)dpy, + finalize ? P_Free_Cursor : (PFO)0, 0); + } + return c; +} + +/* Backwards compatibility: */ +Object Make_Cursor (dpy, cursor) Display *dpy; Cursor cursor; { + return Internal_Make_Cursor (1, dpy, cursor); +} + +Object Make_Cursor_Foreign (dpy, cursor) Display *dpy; Cursor cursor; { + return Internal_Make_Cursor (0, dpy, cursor); +} + +Cursor Get_Cursor (c) Object c; { + if (EQ(c, Sym_None)) + return None; + Check_Type (c, T_Cursor); + return CURSOR(c)->cursor; +} + +Object P_Free_Cursor (c) Object c; { + Check_Type (c, T_Cursor); + if (!CURSOR(c)->free) + XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor); + Deregister_Object (c); + CURSOR(c)->free = 1; + return Void; +} + +static Object P_Create_Cursor (srcp, maskp, x, y, f, b) + Object srcp, maskp, x, y, f, b; { + Pixmap sp = Get_Pixmap (srcp), mp; + Display *d = PIXMAP(srcp)->dpy; + + mp = EQ(maskp, Sym_None) ? None : Get_Pixmap (maskp); + return Make_Cursor (d, XCreatePixmapCursor (d, sp, mp, + Get_Color (f), Get_Color (b), Get_Integer (x), Get_Integer (y))); +} + +static Object P_Create_Glyph_Cursor (srcf, srcc, maskf, maskc, f, b) + Object srcf, srcc, maskf, maskc, f, b; { + Font sf = Get_Font (srcf), mf; + Display *d = FONT(srcf)->dpy; + + mf = EQ(maskf, Sym_None) ? None : Get_Font (maskf); + return Make_Cursor (d, XCreateGlyphCursor (d, sf, mf, + Get_Integer (srcc), mf == None ? 0 : Get_Integer (maskc), + Get_Color (f), Get_Color (b))); +} + +static Object P_Recolor_Cursor (c, f, b) Object c, f, b; { + Check_Type (c, T_Cursor); + XRecolorCursor (CURSOR(c)->dpy, CURSOR(c)->cursor, Get_Color (f), + Get_Color (b)); + return Void; +} + +elk_init_xlib_cursor () { + Generic_Define (Cursor, "cursor", "cursor?"); + Define_Primitive (P_Cursor_Display, "cursor-display", 1, 1, EVAL); + Define_Primitive (P_Free_Cursor, "free-cursor", 1, 1, EVAL); + Define_Primitive (P_Create_Cursor, "create-cursor", 6, 6, EVAL); + Define_Primitive (P_Create_Glyph_Cursor, "create-glyph-cursor", + 6, 6, EVAL); + Define_Primitive (P_Recolor_Cursor, "recolor-cursor", 3, 3, EVAL); +} diff --git a/lib/xlib/display.c b/lib/xlib/display.c new file mode 100644 index 0000000..885a3a6 --- /dev/null +++ b/lib/xlib/display.c @@ -0,0 +1,308 @@ +#include "xlib.h" + +static Display_Visit (dp, f) Object *dp; int (*f)(); { + (*f)(&DISPLAY(*dp)->after); +} + +Generic_Predicate (Display) + +Generic_Equal (Display, DISPLAY, dpy) + +static Display_Print (d, port, raw, depth, length) Object d, port; { + Printf (port, "#[display %lu %s]", (unsigned)DISPLAY(d)->dpy, + DisplayString (DISPLAY(d)->dpy)); +} + +Object Make_Display (finalize, dpy) Display *dpy; { + Object d; + + d = Find_Object (T_Display, (GENERIC)dpy, Match_X_Obj); + if (Nullp (d)) { + d = Alloc_Object (sizeof (struct S_Display), T_Display, 0); + DISPLAY(d)->dpy = dpy; + DISPLAY(d)->free = 0; + DISPLAY(d)->after = False; + Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display : + (PFO)0, 1); + } + return d; +} + +static Object P_Open_Display (argc, argv) Object *argv; { + register char *s; + Display *dpy; + + if (argc == 1) { + if ((dpy = XOpenDisplay (Get_Strsym (argv[0]))) == 0) + Primitive_Error ("cannot open display ~s", argv[0]); + } else if ((dpy = XOpenDisplay ((char *)0)) == 0) { + s = XDisplayName ((char *)0); + Primitive_Error ("cannot open display ~s", + Make_String (s, strlen (s))); + } + return Make_Display (1, dpy); +} + +Object P_Close_Display (d) Object d; { + register struct S_Display *p; + + Check_Type (d, T_Display); + p = DISPLAY(d); + if (!p->free) { + Terminate_Group ((GENERIC)p->dpy); + XCloseDisplay (p->dpy); + } + Deregister_Object (d); + p->free = 1; + return Void; +} + +static Object P_Display_Default_Root_Window (d) Object d; { + Check_Type (d, T_Display); + return Make_Window (0, DISPLAY(d)->dpy, + DefaultRootWindow (DISPLAY(d)->dpy)); +} + +static Object P_Display_Default_Colormap (d) Object d; { + register Display *dpy; + + Check_Type (d, T_Display); + dpy = DISPLAY(d)->dpy; + return Make_Colormap (0, dpy, DefaultColormap (dpy, DefaultScreen (dpy))); +} + +static Object P_Display_Default_Gcontext (d) Object d; { + register Display *dpy; + + Check_Type (d, T_Display); + dpy = DISPLAY(d)->dpy; + return Make_Gc (0, dpy, DefaultGC (dpy, DefaultScreen (dpy))); +} + +static Object P_Display_Default_Depth (d) Object d; { + register Display *dpy; + + Check_Type (d, T_Display); + dpy = DISPLAY(d)->dpy; + return Make_Integer (DefaultDepth (dpy, DefaultScreen (dpy))); +} + +static Object P_Display_Default_Screen_Number (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (DefaultScreen (DISPLAY(d)->dpy)); +} + +int Get_Screen_Number (dpy, scr) Display *dpy; Object scr; { + register s; + + if ((s = Get_Integer (scr)) < 0 || s > ScreenCount (dpy)-1) + Primitive_Error ("invalid screen number"); + return s; +} + +static Object P_Display_Cells (d, scr) Object d, scr; { + Check_Type (d, T_Display); + return Make_Integer (DisplayCells (DISPLAY(d)->dpy, + Get_Screen_Number (DISPLAY(d)->dpy, scr))); +} + +static Object P_Display_Planes (d, scr) Object d, scr; { + Check_Type (d, T_Display); + return Make_Integer (DisplayPlanes (DISPLAY(d)->dpy, + Get_Screen_Number (DISPLAY(d)->dpy, scr))); +} + +static Object P_Display_String (d) Object d; { + register char *s; + + Check_Type (d, T_Display); + s = DisplayString (DISPLAY(d)->dpy); + return Make_String (s, strlen (s)); +} + +static Object P_Display_Vendor (d) Object d; { + register char *s; + Object ret, name; + GC_Node; + + Check_Type (d, T_Display); + s = ServerVendor (DISPLAY(d)->dpy); + name = Make_String (s, strlen (s)); + GC_Link (name); + ret = Cons (Null, Make_Integer (VendorRelease (DISPLAY(d)->dpy))); + Car (ret) = name; + GC_Unlink; + return ret; +} + +static Object P_Display_Protocol_Version (d) Object d; { + Check_Type (d, T_Display); + return Cons (Make_Integer (ProtocolVersion (DISPLAY(d)->dpy)), + Make_Integer (ProtocolRevision (DISPLAY(d)->dpy))); +} + +static Object P_Display_Screen_Count (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (ScreenCount (DISPLAY(d)->dpy)); +} + +static Object P_Display_Image_Byte_Order (d) Object d; { + Check_Type (d, T_Display); + return Bits_To_Symbols ((unsigned long)ImageByteOrder (DISPLAY(d)->dpy), + 0, Byte_Order_Syms); +} + +static Object P_Display_Bitmap_Unit (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (BitmapUnit (DISPLAY(d)->dpy)); +} + +static Object P_Display_Bitmap_Bit_Order (d) Object d; { + Check_Type (d, T_Display); + return Bits_To_Symbols ((unsigned long)BitmapBitOrder (DISPLAY(d)->dpy), + 0, Byte_Order_Syms); +} + +static Object P_Display_Bitmap_Pad (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (BitmapPad (DISPLAY(d)->dpy)); +} + +static Object P_Display_Width (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (DisplayWidth (DISPLAY(d)->dpy, + DefaultScreen (DISPLAY(d)->dpy))); +} + +static Object P_Display_Height (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (DisplayHeight (DISPLAY(d)->dpy, + DefaultScreen (DISPLAY(d)->dpy))); +} + +static Object P_Display_Width_Mm (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (DisplayWidthMM (DISPLAY(d)->dpy, + DefaultScreen (DISPLAY(d)->dpy))); +} + +static Object P_Display_Height_Mm (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (DisplayHeightMM (DISPLAY(d)->dpy, + DefaultScreen (DISPLAY(d)->dpy))); +} + +static Object P_Display_Motion_Buffer_Size (d) Object d; { + Check_Type (d, T_Display); + return Make_Unsigned_Long (XDisplayMotionBufferSize (DISPLAY(d)->dpy)); +} + +static Object P_Display_Flush_Output (d) Object d; { + Check_Type (d, T_Display); + XFlush (DISPLAY(d)->dpy); + return Void; +} + +static Object P_Display_Wait_Output (d, discard) Object d, discard; { + Check_Type (d, T_Display); + Check_Type (discard, T_Boolean); + XSync (DISPLAY(d)->dpy, EQ(discard, True)); + return Void; +} + +static Object P_No_Op (d) Object d; { + Check_Type (d, T_Display); + XNoOp (DISPLAY(d)->dpy); + return Void; +} + +static Object P_List_Depths (d, scr) Object d, scr; { + int num; + register *p, i; + Object ret; + + Check_Type (d, T_Display); + if (!(p = XListDepths (DISPLAY(d)->dpy, + Get_Screen_Number (DISPLAY(d)->dpy, scr), &num))) + return False; + ret = Make_Vector (num, Null); + for (i = 0; i < num; i++) + VECTOR(ret)->data[i] = Make_Integer (p[i]); + XFree ((char *)p); + return ret; +} + +static Object P_List_Pixmap_Formats (d) Object d; { + register XPixmapFormatValues *p; + int num; + register i; + Object ret; + GC_Node; + + Check_Type (d, T_Display); + if (!(p = XListPixmapFormats (DISPLAY(d)->dpy, &num))) + return False; + ret = Make_Vector (num, Null); + GC_Link (ret); + for (i = 0; i < num; i++) { + Object t; + + t = P_Make_List (Make_Integer (3), Null); + VECTOR(ret)->data[i] = t; + Car (t) = Make_Integer (p[i].depth); t = Cdr (t); + Car (t) = Make_Integer (p[i].bits_per_pixel); t = Cdr (t); + Car (t) = Make_Integer (p[i].scanline_pad); + } + GC_Unlink; + XFree ((char *)p); + return ret; +} + +elk_init_xlib_display () { + T_Display = Define_Type (0, "display", NOFUNC, sizeof (struct S_Display), + Display_Equal, Display_Equal, Display_Print, Display_Visit); + Define_Primitive (P_Displayp, "display?", 1, 1, EVAL); + Define_Primitive (P_Open_Display, "open-display", 0, 1, VARARGS); + Define_Primitive (P_Close_Display, "close-display", 1, 1, EVAL); + Define_Primitive (P_Display_Default_Root_Window, + "display-default-root-window", 1, 1, EVAL); + Define_Primitive (P_Display_Default_Colormap, + "display-default-colormap", 1, 1, EVAL); + Define_Primitive (P_Display_Default_Gcontext, + "display-default-gcontext", 1, 1, EVAL); + Define_Primitive (P_Display_Default_Depth, + "display-default-depth", 1, 1, EVAL); + Define_Primitive (P_Display_Default_Screen_Number, + "display-default-screen-number", 1, 1, EVAL); + Define_Primitive (P_Display_Cells, "display-cells", 2, 2, EVAL); + Define_Primitive (P_Display_Planes, "display-planes", 2, 2, EVAL); + Define_Primitive (P_Display_String, "display-string", 1, 1, EVAL); + Define_Primitive (P_Display_Vendor, "display-vendor", 1, 1, EVAL); + Define_Primitive (P_Display_Protocol_Version, + "display-protocol-version", 1, 1, EVAL); + Define_Primitive (P_Display_Screen_Count, + "display-screen-count", 1, 1, EVAL); + Define_Primitive (P_Display_Image_Byte_Order, + "display-image-byte-order", 1, 1, EVAL); + Define_Primitive (P_Display_Bitmap_Unit, + "display-bitmap-unit", 1, 1, EVAL); + Define_Primitive (P_Display_Bitmap_Bit_Order, + "display-bitmap-bit-order", 1, 1, EVAL); + Define_Primitive (P_Display_Bitmap_Pad, + "display-bitmap-pad", 1, 1, EVAL); + Define_Primitive (P_Display_Width, "display-width", 1, 1, EVAL); + Define_Primitive (P_Display_Height, "display-height", 1, 1, EVAL); + Define_Primitive (P_Display_Width_Mm,"display-width-mm", 1, 1, EVAL); + Define_Primitive (P_Display_Height_Mm, + "display-height-mm", 1, 1, EVAL); + Define_Primitive (P_Display_Motion_Buffer_Size, + "display-motion-buffer-size", 1, 1, EVAL); + Define_Primitive (P_Display_Flush_Output, + "display-flush-output", 1, 1, EVAL); + Define_Primitive (P_Display_Wait_Output, + "display-wait-output", 2, 2, EVAL); + Define_Primitive (P_No_Op, "no-op", 1, 1, EVAL); + Define_Primitive (P_List_Depths, "list-depths", 2, 2, EVAL); + Define_Primitive (P_List_Pixmap_Formats, + "list-pixmap-formats", 1, 1, EVAL); +} diff --git a/lib/xlib/error.c b/lib/xlib/error.c new file mode 100644 index 0000000..4bc4084 --- /dev/null +++ b/lib/xlib/error.c @@ -0,0 +1,92 @@ +#include "xlib.h" + +static Object V_X_Error_Handler, V_X_Fatal_Error_Handler; + +/* Default error handlers of the Xlib */ +extern int _XDefaultIOError(); +extern int _XDefaultError(); + +static X_Fatal_Error (d) Display *d; { + Object args, fun; + GC_Node; + + Reset_IO (0); + args = Make_Display (0, d); + GC_Link (args); + args = Cons (args, Null); + GC_Unlink; + fun = Var_Get (V_X_Fatal_Error_Handler); + if (TYPE(fun) == T_Compound) + (void)Funcall (fun, args, 0); + _XDefaultIOError (d); + exit (1); /* In case the default handler doesn't exit() */ + /*NOTREACHED*/ +} + +static X_Error (d, ep) Display *d; XErrorEvent *ep; { + Object args, a, fun; + GC_Node; + + Reset_IO (0); + args = Make_Unsigned_Long ((unsigned long)ep->resourceid); + GC_Link (args); + args = Cons (args, Null); + a = Make_Unsigned (ep->minor_code); + args = Cons (a, args); + a = Make_Unsigned (ep->request_code); + args = Cons (a, args); + a = Bits_To_Symbols ((unsigned long)ep->error_code, 0, Error_Syms); + if (Nullp (a)) + a = Make_Unsigned (ep->error_code); + args = Cons (a, args); + a = Make_Unsigned_Long (ep->serial); + args = Cons (a, args); + a = Make_Display (0, ep->display); + args = Cons (a, args); + GC_Unlink; + fun = Var_Get (V_X_Error_Handler); + if (TYPE(fun) == T_Compound) + (void)Funcall (fun, args, 0); + else + _XDefaultError (d, ep); +} + +static X_After_Function (d) Display *d; { + Object args; + GC_Node; + + args = Make_Display (0, d); + GC_Link (args); + args = Cons (args, Null); + GC_Unlink; + (void)Funcall (DISPLAY(Car (args))->after, args, 0); +} + +static Object P_Set_After_Function (d, f) Object d, f; { + Object old; + + Check_Type (d, T_Display); + if (EQ(f, False)) { + (void)XSetAfterFunction (DISPLAY(d)->dpy, (int (*)())0); + } else { + Check_Procedure (f); + (void)XSetAfterFunction (DISPLAY(d)->dpy, X_After_Function); + } + old = DISPLAY(d)->after; + DISPLAY(d)->after = f; + return old; +} + +static Object P_After_Function (d) Object d; { + Check_Type (d, T_Display); + return DISPLAY(d)->after; +} + +elk_init_xlib_error () { + Define_Variable (&V_X_Fatal_Error_Handler, "x-fatal-error-handler", Null); + Define_Variable (&V_X_Error_Handler, "x-error-handler", Null); + (void)XSetIOErrorHandler (X_Fatal_Error); + (void)XSetErrorHandler (X_Error); + Define_Primitive (P_Set_After_Function, "set-after-function!", 2, 2, EVAL); + Define_Primitive (P_After_Function, "after-function", 1, 1, EVAL); +} diff --git a/lib/xlib/event.c b/lib/xlib/event.c new file mode 100644 index 0000000..4aa721b --- /dev/null +++ b/lib/xlib/event.c @@ -0,0 +1,514 @@ +#include "xlib.h" + +#define MAX_ARGS 14 + +static Object Argl, Argv; + +static struct event_desc { + char *name; + int argc; +} Event_Table[] = { + { "event-0", 1 }, + { "event-1", 1 }, + { "key-press", 12 }, + { "key-release", 12 }, + { "button-press", 12 }, + { "button-release", 12 }, + { "motion-notify", 12 }, + { "enter-notify", 14 }, + { "leave-notify", 14 }, + { "focus-in", 4 }, + { "focus-out", 4 }, + { "keymap-notify", 3 }, + { "expose", 7 }, + { "graphics-expose", 9 }, + { "no-expose", 4 }, + { "visibility-notify", 3 }, + { "create-notify", 9 }, + { "destroy-notify", 3 }, + { "unmap-notify", 4 }, + { "map-notify", 4 }, + { "map-request", 3 }, + { "reparent-notify", 7 }, + { "configure-notify", 10 }, + { "configure-request", 11 }, + { "gravity-notify", 5 }, + { "resize-request", 4 }, + { "circulate-notify", 4 }, + { "circulate-request", 4 }, + { "property-notify", 5 }, + { "selection-clear", 4 }, + { "selection-request", 7 }, + { "selection-notify", 6 }, + { "colormap-notify", 5 }, + { "client-message", 4 }, + { "mapping-notify", 4 }, + { 0, 0 } +}; + +struct predicate_arg { + Object *funcs; + Object *ret; +}; + +/*ARGSUSED*/ +static Event_Predicate (dpy, ep, ptr) Display *dpy; XEvent *ep; +#ifdef XLIB_RELEASE_5_OR_LATER + XPointer ptr; { +#else + char *ptr; { +#endif + struct predicate_arg *ap = (struct predicate_arg *)ptr; + register i; + Object args; + GC_Node; + + if ((i = ep->type) < LASTEvent && !Nullp (ap->funcs[i])) { + args = Get_Event_Args (ep); + GC_Link (args); + *ap->ret = Funcall (ap->funcs[i], args, 0); + Destroy_Event_Args (args); + GC_Unlink; + } + return Truep (*ap->ret); +} + +/* (handle-events display discard? peek? clause...) + * clause = (event function) or ((event...) function) or (else function) + * loops/blocks until a function returns x != #f, then returns x. + * discard?: discard unprocessed events. + * peek?: don't discard processed events. + */ + +static Object P_Handle_Events (argl) Object argl; { + Object next, clause, func, ret, funcs[LASTEvent], args; + register i, discard, peek; + Display *dpy; + char *errmsg = "event occurs more than once"; + GC_Node3; struct gcnode gcv; + TC_Prolog; + + TC_Disable; + clause = args = Null; + GC_Link3 (argl, clause, args); + next = Eval (Car (argl)); + Check_Type (next, T_Display); + dpy = DISPLAY(next)->dpy; + argl = Cdr (argl); + next = Eval (Car (argl)); + Check_Type (next, T_Boolean); + discard = Truep (next); + argl = Cdr (argl); + next = Eval (Car (argl)); + Check_Type (next, T_Boolean); + peek = Truep (next); + for (i = 0; i < LASTEvent; i++) + funcs[i] = Null; + gcv.gclen = 1+LASTEvent; gcv.gcobj = funcs; gcv.next = &gc3; GC_List = &gcv; + for (argl = Cdr (argl); !Nullp (argl); argl = Cdr (argl)) { + clause = Car (argl); + Check_List (clause); + if (Fast_Length (clause) != 2) + Primitive_Error ("badly formed event clause"); + func = Eval (Car (Cdr (clause))); + Check_Procedure (func); + clause = Car (clause); + if (EQ(clause, Sym_Else)) { + for (i = 0; i < LASTEvent; i++) + if (Nullp (funcs[i])) funcs[i] = func; + } else { + if (TYPE(clause) == T_Pair) { + for (; !Nullp (clause); clause = Cdr (clause)) { + i = Encode_Event (Car (clause)); + if (!Nullp (funcs[i])) + Primitive_Error (errmsg); + funcs[i] = func; + } + } else { + i = Encode_Event (clause); + if (!Nullp (funcs[i])) + Primitive_Error (errmsg); + funcs[i] = func; + } + } + } + ret = False; + while (!Truep (ret)) { + XEvent e; + if (discard) { + (peek ? XPeekEvent : XNextEvent) (dpy, &e); + if ((i = e.type) < LASTEvent && !Nullp (funcs[i])) { + args = Get_Event_Args (&e); + ret = Funcall (funcs[i], args, 0); + Destroy_Event_Args (args); + } else { + if (peek) + XNextEvent (dpy, &e); /* discard it */ + } + } else { + struct predicate_arg a; + a.funcs = funcs; + a.ret = &ret; + (peek ? XPeekIfEvent : XIfEvent) (dpy, &e, Event_Predicate, +#ifdef XLIB_RELEASE_5_OR_LATER + (XPointer)&a); +#else + (char *)&a); +#endif + } + } + GC_Unlink; + TC_Enable; + return ret; +} + +static Object Get_Time_Arg (t) Time t; { + return t == CurrentTime ? Sym_Now : Make_Unsigned_Long ((unsigned long)t); +} + +Object Get_Event_Args (ep) XEvent *ep; { + Object tmpargs[MAX_ARGS]; + register e, i; + register Object *a, *vp; + struct gcnode gcv; + Object dummy; + GC_Node; + + e = ep->type; + dummy = Null; + a = tmpargs; + for (i = 0; i < MAX_ARGS; i++) + a[i] = Null; + GC_Link (dummy); + gcv.gclen = 1 + MAX_ARGS; gcv.gcobj = a; gcv.next = &gc1; GC_List = &gcv; + switch (e) { + case KeyPress: case KeyRelease: + case ButtonPress: case ButtonRelease: + case MotionNotify: + case EnterNotify: case LeaveNotify: { + register XKeyEvent *p = (XKeyEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Window (0, p->display, p->root); + a[3] = Make_Window (0, p->display, p->subwindow); + a[4] = Get_Time_Arg (p->time); + a[5] = Make_Integer (p->x); + a[6] = Make_Integer (p->y); + a[7] = Make_Integer (p->x_root); + a[8] = Make_Integer (p->y_root); + if (e == KeyPress || e == KeyRelease) { + a[9] = Bits_To_Symbols ((unsigned long)p->state, 1, State_Syms); + a[10] = Make_Integer (p->keycode); + a[11] = p->same_screen ? True : False; + } else if (e == ButtonPress || e == ButtonRelease) { + register XButtonEvent *q = (XButtonEvent *)ep; + a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms); + a[10] = Bits_To_Symbols ((unsigned long)q->button, 0, Button_Syms); + a[11] = q->same_screen ? True : False; + } else if (e == MotionNotify) { + register XMotionEvent *q = (XMotionEvent *)ep; + a[9] = Bits_To_Symbols ((unsigned long)q->state, 1, State_Syms); + a[10] = q->is_hint ? True : False; + a[11] = q->same_screen ? True : False; + } else { + register XCrossingEvent *q = (XCrossingEvent *)ep; + a[9] = Bits_To_Symbols ((unsigned long)q->mode, 0, Cross_Mode_Syms); + a[10] = Bits_To_Symbols ((unsigned long)q->detail, 0, + Cross_Detail_Syms); + a[11] = q->same_screen ? True : False; + a[12] = q->focus ? True : False; + a[13] = Bits_To_Symbols ((unsigned long)q->state, 1, Button_Syms); + } + } break; + case FocusIn: case FocusOut: { + register XFocusChangeEvent *p = (XFocusChangeEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Bits_To_Symbols ((unsigned long)p->mode, 0, Cross_Mode_Syms); + a[3] = Bits_To_Symbols ((unsigned long)p->detail, 0, Focus_Detail_Syms); + } break; + case KeymapNotify: { + register XKeymapEvent *p = (XKeymapEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_String (p->key_vector, 32); + } break; + case Expose: { + register XExposeEvent *p = (XExposeEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Integer (p->x); + a[3] = Make_Integer (p->y); + a[4] = Make_Integer (p->width); + a[5] = Make_Integer (p->height); + a[6] = Make_Integer (p->count); + } break; + case GraphicsExpose: { + register XGraphicsExposeEvent *p = (XGraphicsExposeEvent *)ep; + a[1] = Make_Window (0, p->display, p->drawable); + a[2] = Make_Integer (p->x); + a[3] = Make_Integer (p->y); + a[4] = Make_Integer (p->width); + a[5] = Make_Integer (p->height); + a[6] = Make_Integer (p->count); + a[7] = Make_Integer (p->major_code); + a[8] = Make_Integer (p->minor_code); + } break; + case NoExpose: { + register XNoExposeEvent *p = (XNoExposeEvent *)ep; + a[1] = Make_Window (0, p->display, p->drawable); + a[2] = Make_Integer (p->major_code); + a[3] = Make_Integer (p->minor_code); + } break; + case VisibilityNotify: { + register XVisibilityEvent *p = (XVisibilityEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Bits_To_Symbols ((unsigned long)p->state, 0, Visibility_Syms); + } break; + case CreateNotify: { + register XCreateWindowEvent *p = (XCreateWindowEvent *)ep; + a[1] = Make_Window (0, p->display, p->parent); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Integer (p->x); + a[4] = Make_Integer (p->y); + a[5] = Make_Integer (p->width); + a[6] = Make_Integer (p->height); + a[7] = Make_Integer (p->border_width); + a[8] = p->override_redirect ? True : False; + } break; + case DestroyNotify: { + register XDestroyWindowEvent *p = (XDestroyWindowEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + } break; + case UnmapNotify: { + register XUnmapEvent *p = (XUnmapEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = p->from_configure ? True : False; + } break; + case MapNotify: { + register XMapEvent *p = (XMapEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = p->override_redirect ? True : False; + } break; + case MapRequest: { + register XMapRequestEvent *p = (XMapRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->parent); + a[2] = Make_Window (0, p->display, p->window); + } break; + case ReparentNotify: { + register XReparentEvent *p = (XReparentEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Window (0, p->display, p->parent); + a[4] = Make_Integer (p->x); + a[5] = Make_Integer (p->y); + a[6] = p->override_redirect ? True : False; + } break; + case ConfigureNotify: { + register XConfigureEvent *p = (XConfigureEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Integer (p->x); + a[4] = Make_Integer (p->y); + a[5] = Make_Integer (p->width); + a[6] = Make_Integer (p->height); + a[7] = Make_Integer (p->border_width); + a[8] = Make_Window (0, p->display, p->above); + a[9] = p->override_redirect ? True : False; + } break; + case ConfigureRequest: { + register XConfigureRequestEvent *p = (XConfigureRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->parent); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Integer (p->x); + a[4] = Make_Integer (p->y); + a[5] = Make_Integer (p->width); + a[6] = Make_Integer (p->height); + a[7] = Make_Integer (p->border_width); + a[8] = Make_Window (0, p->display, p->above); + a[9] = Bits_To_Symbols ((unsigned long)p->detail, 0, Stack_Mode_Syms); + a[10] = Make_Unsigned_Long (p->value_mask); + } break; + case GravityNotify: { + register XGravityEvent *p = (XGravityEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Make_Integer (p->x); + a[4] = Make_Integer (p->y); + } break; + case ResizeRequest: { + register XResizeRequestEvent *p = (XResizeRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Integer (p->width); + a[3] = Make_Integer (p->height); + } break; + case CirculateNotify: { + register XCirculateEvent *p = (XCirculateEvent *)ep; + a[1] = Make_Window (0, p->display, p->event); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms); + } break; + case CirculateRequest: { + register XCirculateRequestEvent *p = (XCirculateRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->parent); + a[2] = Make_Window (0, p->display, p->window); + a[3] = Bits_To_Symbols ((unsigned long)p->place, 0, Place_Syms); + } break; + case PropertyNotify: { + register XPropertyEvent *p = (XPropertyEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Atom (p->atom); + a[3] = Get_Time_Arg (p->time); + a[4] = Bits_To_Symbols ((unsigned long)p->state, 0, Prop_Syms); + } break; + case SelectionClear: { + register XSelectionClearEvent *p = (XSelectionClearEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Atom (p->selection); + a[3] = Get_Time_Arg (p->time); + } break; + case SelectionRequest: { + register XSelectionRequestEvent *p = (XSelectionRequestEvent *)ep; + a[1] = Make_Window (0, p->display, p->owner); + a[2] = Make_Window (0, p->display, p->requestor); + a[3] = Make_Atom (p->selection); + a[4] = Make_Atom (p->target); + a[5] = Make_Atom (p->property); + a[6] = Get_Time_Arg (p->time); + } break; + case SelectionNotify: { + register XSelectionEvent *p = (XSelectionEvent *)ep; + a[1] = Make_Window (0, p->display, p->requestor); + a[2] = Make_Atom (p->selection); + a[3] = Make_Atom (p->target); + a[4] = Make_Atom (p->property); + a[5] = Get_Time_Arg (p->time); + } break; + case ColormapNotify: { + register XColormapEvent *p = (XColormapEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Colormap (0, p->display, p->colormap); + a[3] = p->new ? True : False; + a[4] = p->state == ColormapInstalled ? True : False; + } break; + case ClientMessage: { + register XClientMessageEvent *p = (XClientMessageEvent *)ep; + register i; + + a[1] = Make_Window (0, p->display, p->window); + a[2] = Make_Atom (p->message_type); + switch (p->format) { + case 8: + a[3] = Make_String (p->data.b, 20); + break; + case 16: + a[3] = Make_Vector (10, Null); + for (i = 0; i < 10; i++) + VECTOR(a[3])->data[i] = Make_Integer (p->data.s[i]); + break; + case 32: + a[3] = Make_Vector (5, Null); + for (i = 0; i < 5; i++) + VECTOR(a[3])->data[i] = Make_Long (p->data.l[i]); + break; + default: + a[3] = Make_Integer (p->format); /* ??? */ + } + } break; + case MappingNotify: { + register XMappingEvent *p = (XMappingEvent *)ep; + a[1] = Make_Window (0, p->display, p->window); + a[2] = Bits_To_Symbols ((unsigned long)p->request, 0, Mapping_Syms); + a[3] = Make_Integer (p->first_keycode); + a[4] = Make_Integer (p->count); + } break; + } + a[0] = Intern (Event_Table[e].name); + for (vp = VECTOR(Argv)->data, i = 0; i < Event_Table[e].argc; i++) { + if (i) vp++; + Car (*vp) = a[i]; + Cdr (*vp) = vp[1]; + } + Cdr (*vp) = Null; + GC_Unlink; + return Argl; +} + +void Destroy_Event_Args (args) Object args; { + Object t; + + for (t = args; !Nullp (t); t = Cdr (t)) + Car (t) = Null; +} + +Encode_Event (e) Object e; { + Object s; + register char *p; + register struct event_desc *ep; + register n; + + Check_Type (e, T_Symbol); + s = SYMBOL(e)->name; + p = STRING(s)->data; + n = STRING(s)->size; + for (ep = Event_Table; ep->name; ep++) + if (n && strncmp (ep->name, p, n) == 0) break; + if (ep->name == 0) + Primitive_Error ("no such event: ~s", e); + return ep-Event_Table; +} + +static Object P_Get_Motion_Events (w, from, to) Object w, from, to; { + XTimeCoord *p; + int n; + register i; + Object e, ret; + GC_Node2; + + Check_Type (w, T_Window); + p = XGetMotionEvents (WINDOW(w)->dpy, WINDOW(w)->win, Get_Time (from), + Get_Time (to), &n); + e = ret = Make_Vector (n, Null); + GC_Link2 (ret, e); + for (i = 0; i < n; i++) { + e = P_Make_List (Make_Integer (3), Null); + VECTOR(ret)->data[i] = e; + Car (e) = Get_Time_Arg (p[i].time); e = Cdr (e); + Car (e) = Make_Integer (p[i].x); e = Cdr (e); + Car (e) = Make_Integer (p[i].y); + } + GC_Unlink; + XFree ((char *)p); + return ret; +} + +static Object P_Event_Listen (d, wait_flag) Object d, wait_flag; { + Display *dpy; + register n; + XEvent e; + + Check_Type (d, T_Display); + Check_Type (wait_flag, T_Boolean); + dpy = DISPLAY(d)->dpy; + n = XPending (dpy); + if (n == 0 && EQ(wait_flag, True)) { + XPeekEvent (dpy, &e); + n = XPending (dpy); + } + return Make_Integer (n); +} + +elk_init_xlib_event () { + Object t; + register i; + + Argl = P_Make_List (Make_Integer (MAX_ARGS), Null); + Global_GC_Link (Argl); + Argv = Make_Vector (MAX_ARGS, Null); + Global_GC_Link (Argv); + for (i = 0, t = Argl; i < MAX_ARGS; i++, t = Cdr (t)) + VECTOR(Argv)->data[i] = t; + Define_Primitive (P_Handle_Events, "handle-events", 3, MANY, NOEVAL); + Define_Primitive (P_Get_Motion_Events, + "get-motion-events", 3, 3, EVAL); + Define_Primitive (P_Event_Listen, "event-listen", 2, 2, EVAL); +} diff --git a/lib/xlib/extension.c b/lib/xlib/extension.c new file mode 100644 index 0000000..1013a44 --- /dev/null +++ b/lib/xlib/extension.c @@ -0,0 +1,48 @@ +#include "xlib.h" + +static Object P_List_Extensions (d) Object d; { + Object ret; + int n; + register i; + register char **p; + GC_Node; + + Check_Type (d, T_Display); + Disable_Interrupts; + p = XListExtensions (DISPLAY(d)->dpy, &n); + Enable_Interrupts; + ret = Make_Vector (n, Null); + GC_Link (ret); + for (i = 0; i < n; i++) { + Object e; + + e = Make_String (p[i], strlen (p[i])); + VECTOR(ret)->data[i] = e; + } + GC_Unlink; + XFreeExtensionList (p); + return ret; +} + +static Object P_Query_Extension (d, name) Object d, name; { + int opcode, event, error; + Object ret, t; + GC_Node2; + + Check_Type (d, T_Display); + if (!XQueryExtension (DISPLAY(d)->dpy, Get_Strsym (name), &opcode, + &event, &error)) + return False; + t = ret = P_Make_List (Make_Integer (3), Null); + GC_Link2 (ret, t); + Car (t) = (opcode ? Make_Integer (opcode) : False); t = Cdr (t); + Car (t) = (event ? Make_Integer (event) : False); t = Cdr (t); + Car (t) = (error ? Make_Integer (error) : False); + GC_Unlink; + return ret; +} + +elk_init_xlib_extension () { + Define_Primitive (P_List_Extensions, "list-extensions", 1, 1, EVAL); + Define_Primitive (P_Query_Extension, "query-extension", 2, 2, EVAL); +} diff --git a/lib/xlib/font.c b/lib/xlib/font.c new file mode 100644 index 0000000..f28d4f3 --- /dev/null +++ b/lib/xlib/font.c @@ -0,0 +1,299 @@ +#include "xlib.h" + +Object Sym_Char_Info; +static Object Sym_Font_Info, Sym_Min, Sym_Max; + +Generic_Predicate (Font) + +static Font_Equal (x, y) Object x, y; { + Font id1 = FONT(x)->id, id2 = FONT(y)->id; + if (id1 && id2) + return id1 == id2 && FONT(x)->dpy == FONT(y)->dpy; + else + return 0; +} + +Generic_Print (Font, "#[font %lu]", FONT(x)->id ? FONT(x)->id : POINTER(x)) + +static Font_Visit (fp, f) Object *fp; int (*f)(); { + (*f)(&FONT(*fp)->name); +} + +Generic_Get_Display (Font, FONT) + +static Object Internal_Make_Font (finalize, dpy, name, id, info) + Display *dpy; Object name; Font id; XFontStruct *info; { + Object f; + GC_Node; + + GC_Link (name); + f = Alloc_Object (sizeof (struct S_Font), T_Font, 0); + FONT(f)->dpy = dpy; + if (TYPE(name) == T_Symbol) + name = SYMBOL(name)->name; + FONT(f)->name = name; + FONT(f)->id = id; + FONT(f)->info = info; + if (id) + Register_Object (f, (GENERIC)dpy, finalize ? P_Close_Font : (PFO)0, 0); + GC_Unlink; + return f; +} + +/* Backwards compatibility: */ +Object Make_Font (dpy, name, id, info) + Display *dpy; Object name; Font id; XFontStruct *info; { + return Internal_Make_Font (1, dpy, name, id, info); +} + +Object Make_Font_Foreign (dpy, name, id, info) + Display *dpy; Object name; Font id; XFontStruct *info; { + return Internal_Make_Font (0, dpy, name, id, info); +} + +Font Get_Font (f) Object f; { + Check_Type (f, T_Font); + Open_Font_Maybe (f); + return FONT(f)->id; +} + +static XFontStruct *Internal_Open_Font (d, name) Display *d; Object name; { + register char *s; + XFontStruct *p; + Alloca_Begin; + + Get_Strsym_Stack (name, s); + Disable_Interrupts; + if ((p = XLoadQueryFont (d, s)) == 0) + Primitive_Error ("cannot open font: ~s", name); + Enable_Interrupts; + Alloca_End; + return p; +} + +static Object P_Open_Font (d, name) Object d, name; { + XFontStruct *p; + + Check_Type (d, T_Display) + p = Internal_Open_Font (DISPLAY(d)->dpy, name); + return Make_Font (DISPLAY(d)->dpy, name, p->fid, p); +} + +void Open_Font_Maybe (f) Object f; { + Object name; + XFontStruct *p; + + name = FONT(f)->name; + if (!Truep (name)) + Primitive_Error ("invalid font"); + if (FONT(f)->id == 0) { + p = Internal_Open_Font (FONT(f)->dpy, name); + FONT(f)->id = p->fid; + FONT(f)->info = p; + Register_Object (f, (GENERIC)(FONT(f)->dpy), P_Close_Font, 0); + } +} + +Object P_Close_Font (f) Object f; { + Check_Type (f, T_Font); + if (FONT(f)->id) + XUnloadFont (FONT(f)->dpy, FONT(f)->id); + FONT(f)->id = 0; + Deregister_Object (f); + return Void; +} + +static Object P_Font_Name (f) Object f; { + Check_Type (f, T_Font); + return FONT(f)->name; +} + +static Object P_Gcontext_Font (g) Object g; { + register struct S_Gc *p; + register XFontStruct *info; + + Check_Type (g, T_Gc); + p = GCONTEXT(g); + Disable_Interrupts; + info = XQueryFont (p->dpy, XGContextFromGC (p->gc)); + Enable_Interrupts; + return Make_Font_Foreign (p->dpy, False, (Font)0, info); +} + +static Object Internal_List_Fonts (d, pat, with_info) Object d, pat; { + char **ret; + int n; + XFontStruct *iret; + register i; + Object f, v; + Display *dpy; + GC_Node2; + + Check_Type (d, T_Display); + dpy = DISPLAY(d)->dpy; + Disable_Interrupts; + if (with_info) + ret = XListFontsWithInfo (dpy, Get_Strsym (pat), 65535, &n, &iret); + else + ret = XListFonts (dpy, Get_Strsym (pat), 65535, &n); + Enable_Interrupts; + v = Make_Vector (n, Null); + f = Null; + GC_Link2 (f, v); + for (i = 0; i < n; i++) { + f = Make_String (ret[i], strlen (ret[i])); + if (with_info) + f = Make_Font (dpy, f, (Font)0, &iret[i]); + VECTOR(v)->data[i] = f; + } + GC_Unlink; + if (with_info) + XFreeFontInfo (ret, (XFontStruct *)0, 0); + else + XFreeFontNames (ret); + return v; +} + +static Object P_List_Font_Names (d, pat) Object d, pat; { + return Internal_List_Fonts (d, pat, 0); +} + +static Object P_List_Fonts (d, pat) Object d, pat; { + return Internal_List_Fonts (d, pat, 1); +} + +static Object P_Font_Info (f) Object f; { + Check_Type (f, T_Font); + FI = *FONT(f)->info; + return Record_To_Vector (Font_Info_Rec, Font_Info_Size, + Sym_Font_Info, FONT(f)->dpy, ~0L); +} + +static Object P_Char_Info (f, index) Object f, index; { + register t = TYPE(index); + register unsigned i; + register XCharStruct *cp; + register XFontStruct *p; + char *msg = "argument must be integer, character, 'min, or 'max"; + + Check_Type (f, T_Font); + Open_Font_Maybe (f); + p = FONT(f)->info; + cp = &p->max_bounds; + if (t == T_Symbol) { + if (EQ(index, Sym_Min)) + cp = &p->min_bounds; + else if (!EQ(index, Sym_Max)) + Primitive_Error (msg); + } else { + if (t == T_Character) + i = CHAR(index); + else if (t == T_Fixnum || t == T_Bignum) + i = (unsigned)Get_Integer (index); + else + Primitive_Error (msg); + if (!p->min_byte1 && !p->max_byte1) { + if (i < p->min_char_or_byte2 || i > p->max_char_or_byte2) + Range_Error (index); + i -= p->min_char_or_byte2; + } else { + register unsigned b1 = i & 0xff, b2 = (i >> 8) & 0xff; + if (b1 < p->min_byte1 || b1 > p->max_byte1 || + b2 < p->min_char_or_byte2 || b2 > p->max_char_or_byte2) + Range_Error (index); + b1 -= p->min_byte1; + b2 -= p->min_char_or_byte2; + i = b1 * (p->max_char_or_byte2 - p->min_char_or_byte2 + 1) + b2; + } + if (p->per_char) + cp = p->per_char + i; + } + CI = *cp; + return Record_To_Vector (Char_Info_Rec, Char_Info_Size, + Sym_Char_Info, FONT(f)->dpy, ~0L); +} + +static Object P_Font_Properties (f) Object f; { + register i, n; + Object v, a, val, x; + GC_Node4; + + Check_Type (f, T_Font); + n = FONT(f)->info->n_properties; + v = Make_Vector (n, Null); + a = val = Null; + GC_Link4 (v, a, val, f); + for (i = 0; i < n; i++) { + register XFontProp *p = FONT(f)->info->properties+i; + a = Make_Atom (p->name); + val = Make_Unsigned_Long ((unsigned long)p->card32); + x = Cons (a, val); + VECTOR(v)->data[i] = x; + } + GC_Unlink; + return v; +} + +static Object P_Font_Path (d) Object d; { + Object v; + int i, n; + char **ret; + GC_Node; + + Check_Type (d, T_Display); + Disable_Interrupts; + ret = XGetFontPath (DISPLAY(d)->dpy, &n); + Enable_Interrupts; + v = Make_Vector (n, Null); + GC_Link (v); + for (i = 0; i < n; i++) { + Object x; + + x = Make_String (ret[i], strlen (ret[i])); + VECTOR(v)->data[i] = x; + } + GC_Unlink; + XFreeFontPath (ret); + return P_Vector_To_List (v); +} + +static Object P_Set_Font_Path (d, p) Object d, p; { + register char **path; + register i, n; + Object c; + Alloca_Begin; + + Check_Type (d, T_Display); + Check_List (p); + n = Fast_Length (p); + Alloca (path, char**, n * sizeof (char *)); + for (i = 0; i < n; i++, p = Cdr (p)) { + c = Car (p); + Get_Strsym_Stack (c, path[i]); + } + XSetFontPath (DISPLAY(d)->dpy, path, n); + Alloca_End; + return Void; +} + +elk_init_xlib_font () { + Define_Symbol (&Sym_Font_Info, "font-info"); + Define_Symbol (&Sym_Char_Info, "char-info"); + Define_Symbol (&Sym_Min, "min"); + Define_Symbol (&Sym_Max, "max"); + T_Font = Define_Type (0, "font", NOFUNC, sizeof (struct S_Font), + Font_Equal, Font_Equal, Font_Print, Font_Visit); + Define_Primitive (P_Fontp, "font?", 1, 1, EVAL); + Define_Primitive (P_Font_Display, "font-display", 1, 1, EVAL); + Define_Primitive (P_Open_Font, "open-font", 2, 2, EVAL); + Define_Primitive (P_Close_Font, "close-font", 1, 1, EVAL); + Define_Primitive (P_Font_Name, "font-name", 1, 1, EVAL); + Define_Primitive (P_Gcontext_Font, "gcontext-font", 1, 1, EVAL); + Define_Primitive (P_List_Font_Names, "list-font-names", 2, 2, EVAL); + Define_Primitive (P_List_Fonts, "list-fonts", 2, 2, EVAL); + Define_Primitive (P_Font_Info, "xlib-font-info", 1, 1, EVAL); + Define_Primitive (P_Char_Info, "xlib-char-info", 2, 2, EVAL); + Define_Primitive (P_Font_Properties, "font-properties", 1, 1, EVAL); + Define_Primitive (P_Font_Path, "font-path", 1, 1, EVAL); + Define_Primitive (P_Set_Font_Path, "set-font-path!", 2, 2, EVAL); +} diff --git a/lib/xlib/gcontext.c b/lib/xlib/gcontext.c new file mode 100644 index 0000000..e1ffbc5 --- /dev/null +++ b/lib/xlib/gcontext.c @@ -0,0 +1,162 @@ +#include "xlib.h" + +static Object Sym_Gc; + +Generic_Predicate (Gc) + +Generic_Equal_Dpy (Gc, GCONTEXT, gc) + +Generic_Print (Gc, "#[gcontext %lu]", GCONTEXT(x)->gc) + +Generic_Get_Display (Gc, GCONTEXT) + +Object Make_Gc (finalize, dpy, g) Display *dpy; GC g; { + Object gc; + + if (g == None) + return Sym_None; + gc = Find_Object (T_Gc, (GENERIC)dpy, Match_X_Obj, g); + if (Nullp (gc)) { + gc = Alloc_Object (sizeof (struct S_Gc), T_Gc, 0); + GCONTEXT(gc)->tag = Null; + GCONTEXT(gc)->gc = g; + GCONTEXT(gc)->dpy = dpy; + GCONTEXT(gc)->free = 0; + Register_Object (gc, (GENERIC)dpy, finalize ? P_Free_Gc : + (PFO)0, 0); + } + return gc; +} + +static Object P_Create_Gc (w, g) Object w, g; { + unsigned long mask; + Display *dpy; + Drawable dr; + + dr = Get_Drawable (w, &dpy); + mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec); + return Make_Gc (1, dpy, XCreateGC (dpy, dr, mask, &GCV)); +} + +static Object P_Copy_Gc (gc, w) Object gc, w; { + GC dst; + Display *dpy; + Drawable dr; + + Check_Type (gc, T_Gc); + dr = Get_Drawable (w, &dpy); + dst = XCreateGC (dpy, dr, 0L, &GCV); + XCopyGC (dpy, GCONTEXT(gc)->gc, ~0L, dst); + return Make_Gc (1, dpy, dst); +} + +static Object P_Change_Gc (gc, g) Object gc, g; { + unsigned long mask; + + Check_Type (gc, T_Gc); + mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec); + XChangeGC (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV); + return Void; +} + +Object P_Free_Gc (g) Object g; { + Check_Type (g, T_Gc); + if (!GCONTEXT(g)->free) + XFreeGC (GCONTEXT(g)->dpy, GCONTEXT(g)->gc); + Deregister_Object (g); + GCONTEXT(g)->free = 1; + return Void; +} + +static Object P_Query_Best_Size (d, w, h, shape) Object d, w, h, shape; { + unsigned int rw, rh; + + Check_Type (d, T_Display); + if (!XQueryBestSize (DISPLAY(d)->dpy, Symbols_To_Bits (shape, 0, + Shape_Syms), DefaultRootWindow (DISPLAY(d)->dpy), + Get_Integer (w), Get_Integer (h), &rw, &rh)) + Primitive_Error ("cannot query best shape"); + return Cons (Make_Integer (rw), Make_Integer (rh)); +} + +static Object P_Set_Gcontext_Clip_Rectangles (gc, x, y, v, ord) + Object gc, x, y, v, ord; { + register XRectangle *p; + register i, n; + Alloca_Begin; + + Check_Type (gc, T_Gc); + Check_Type (v, T_Vector); + n = VECTOR(v)->size; + Alloca (p, XRectangle*, n * sizeof (XRectangle)); + for (i = 0; i < n; i++) { + Object rect; + + rect = VECTOR(v)->data[i]; + Check_Type (rect, T_Pair); + if (Fast_Length (rect) != 4) + Primitive_Error ("invalid rectangle: ~s", rect); + p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].height = Get_Integer (Car (rect)); + } + XSetClipRectangles (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, Get_Integer (x), + Get_Integer (y), p, n, Symbols_To_Bits (ord, 0, Ordering_Syms)); + Alloca_End; + return Void; +} + +static Object P_Set_Gcontext_Dashlist (gc, off, v) Object gc, off, v; { + register char *p; + register i, n, d; + Alloca_Begin; + + Check_Type (gc, T_Gc); + Check_Type (v, T_Vector); + n = VECTOR(v)->size; + Alloca (p, char*, n); + for (i = 0; i < n; i++) { + d = Get_Integer (VECTOR(v)->data[i]); + if (d < 0 || d > 255) + Range_Error (VECTOR(v)->data[i]); + p[i] = d; + } + XSetDashes (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, Get_Integer (off), p, n); + Alloca_End; + return Void; +} + +#define ValidGCValuesBits \ + (GCFunction | GCPlaneMask | GCForeground | GCBackground | GCLineWidth |\ + GCLineStyle | GCCapStyle | GCJoinStyle | GCFillStyle | GCFillRule |\ + GCTile | GCStipple | GCTileStipXOrigin | GCTileStipYOrigin | GCFont |\ + GCSubwindowMode | GCGraphicsExposures | GCClipXOrigin | GCClipYOrigin |\ + GCDashOffset | GCArcMode) + +static Object P_Get_Gc_Values (gc) Object gc; { + unsigned long mask = ValidGCValuesBits; + + Check_Type (gc, T_Gc); + if (!XGetGCValues (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV)) + Primitive_Error ("cannot get gcontext values"); + return Record_To_Vector (GC_Rec, GC_Size, Sym_Gc, GCONTEXT(gc)->dpy, + mask); +} + +elk_init_xlib_gcontext () { + Define_Symbol (&Sym_Gc, "gcontext"); + Generic_Define (Gc, "gcontext", "gcontext?"); + Define_Primitive (P_Gc_Display, "gcontext-display", 1, 1, EVAL); + Define_Primitive (P_Create_Gc, "xlib-create-gcontext",2, 2, EVAL); + Define_Primitive (P_Copy_Gc, "copy-gcontext", 2, 2, EVAL); + Define_Primitive (P_Change_Gc, "xlib-change-gcontext",2, 2, EVAL); + Define_Primitive (P_Free_Gc, "free-gcontext", 1, 1, EVAL); + Define_Primitive (P_Query_Best_Size, "query-best-size", 4, 4, EVAL); + Define_Primitive (P_Set_Gcontext_Clip_Rectangles, + "set-gcontext-clip-rectangles!", 5, 5, EVAL); + Define_Primitive (P_Set_Gcontext_Dashlist, + "set-gcontext-dashlist!", 3, 3, EVAL); + Define_Primitive (P_Get_Gc_Values, + "xlib-get-gcontext-values", 1, 1, EVAL); +} diff --git a/lib/xlib/grab.c b/lib/xlib/grab.c new file mode 100644 index 0000000..4d9c8cb --- /dev/null +++ b/lib/xlib/grab.c @@ -0,0 +1,138 @@ +#include "xlib.h" + +static Object Sym_Any; + +Time Get_Time (time) Object time; { + if (EQ(time, Sym_Now)) + return CurrentTime; + return (Time)Get_Long (time); +} + +static Get_Mode (m) Object m; { + Check_Type (m, T_Boolean); + return EQ(m, True) ? GrabModeSync : GrabModeAsync; +} + +static Object P_Grab_Pointer (win, ownerp, events, psyncp, ksyncp, confine_to, + cursor, time) Object win, ownerp, events, psyncp, ksyncp, confine_to, + cursor, time; { + Check_Type (win, T_Window); + Check_Type (ownerp, T_Boolean); + return Bits_To_Symbols ((unsigned long)XGrabPointer (WINDOW(win)->dpy, + WINDOW(win)->win, + EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms), + Get_Mode (psyncp), Get_Mode (ksyncp), + Get_Window (confine_to), Get_Cursor (cursor), Get_Time (time)), + 0, Grabstatus_Syms); +} + +static Object P_Ungrab_Pointer (d, time) Object d, time; { + Check_Type (d, T_Display); + XUngrabPointer (DISPLAY(d)->dpy, Get_Time (time)); + return Void; +} + +static Object P_Grab_Button (win, button, mods, ownerp, events, psyncp, ksyncp, + confine_to, cursor) Object win, button, mods, ownerp, events, + psyncp, ksyncp, confine_to, cursor; { + Check_Type (win, T_Window); + Check_Type (ownerp, T_Boolean); + XGrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms), + Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win, + EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms), + Get_Mode (psyncp), Get_Mode (ksyncp), + Get_Window (confine_to), Get_Cursor (cursor)); + return Void; +} + +static Object P_Ungrab_Button (win, button, mods) Object win, button, mods; { + Check_Type (win, T_Window); + XUngrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms), + Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win); + return Void; +} + +static Object P_Change_Active_Pointer_Grab (d, events, cursor, time) + Object d, events, cursor, time; { + Check_Type (d, T_Display); + XChangeActivePointerGrab (DISPLAY(d)->dpy, Symbols_To_Bits (events, 1, + Event_Syms), Get_Cursor (cursor), Get_Time (time)); + return Void; +} + +static Object P_Grab_Keyboard (win, ownerp, psyncp, ksyncp, time) Object win, + ownerp, psyncp, ksyncp, time; { + Check_Type (win, T_Window); + Check_Type (ownerp, T_Boolean); + return Bits_To_Symbols ((unsigned long)XGrabKeyboard (WINDOW(win)->dpy, + WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp), + Get_Mode (ksyncp), Get_Time (time)), + 0, Grabstatus_Syms); +} + +static Object P_Ungrab_Keyboard (d, time) Object d, time; { + Check_Type (d, T_Display); + XUngrabKeyboard (DISPLAY(d)->dpy, Get_Time (time)); + return Void; +} + +static Object P_Grab_Key (win, key, mods, ownerp, psyncp, ksyncp) Object win, + key, mods, ownerp, psyncp, ksyncp; { + int keycode = AnyKey; + + Check_Type (win, T_Window); + if (!EQ(key, Sym_Any)) + keycode = Get_Integer (key); + Check_Type (ownerp, T_Boolean); + XGrabKey (WINDOW(win)->dpy, keycode, Symbols_To_Bits (mods, 1, State_Syms), + WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp), + Get_Mode (ksyncp)); + return Void; +} + +static Object P_Ungrab_Key (win, key, mods) Object win, key, mods; { + int keycode = AnyKey; + + Check_Type (win, T_Window); + if (!EQ(key, Sym_Any)) + keycode = Get_Integer (key); + XUngrabKey (WINDOW(win)->dpy, keycode, + Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win); + return Void; +} + +static Object P_Allow_Events (d, mode, time) Object d, mode, time; { + Check_Type (d, T_Display); + XAllowEvents (DISPLAY(d)->dpy, Symbols_To_Bits (mode, 0, + Allow_Events_Syms), Get_Time (time)); + return Void; +} + +static Object P_Grab_Server (d) Object d; { + Check_Type (d, T_Display); + XGrabServer (DISPLAY(d)->dpy); + return Void; +} + +static Object P_Ungrab_Server (d) Object d; { + Check_Type (d, T_Display); + XUngrabServer (DISPLAY(d)->dpy); + return Void; +} + +elk_init_xlib_grab () { + Define_Primitive (P_Grab_Pointer, "grab-pointer", 8, 8, EVAL); + Define_Primitive (P_Ungrab_Pointer, "ungrab-pointer", 2, 2, EVAL); + Define_Primitive (P_Grab_Button, "grab-button", 9, 9, EVAL); + Define_Primitive (P_Ungrab_Button, "ungrab-button", 3, 3, EVAL); + Define_Primitive (P_Change_Active_Pointer_Grab, + "change-active-pointer-grab", 4, 4, EVAL); + Define_Primitive (P_Grab_Keyboard, "grab-keyboard", 5, 5, EVAL); + Define_Primitive (P_Ungrab_Keyboard, "ungrab-keyboard", 2, 2, EVAL); + Define_Primitive (P_Grab_Key, "grab-key", 6, 6, EVAL); + Define_Primitive (P_Ungrab_Key, "ungrab-key", 3, 3, EVAL); + Define_Primitive (P_Allow_Events, "allow-events", 3, 3, EVAL); + Define_Primitive (P_Grab_Server, "grab-server", 1, 1, EVAL); + Define_Primitive (P_Ungrab_Server, "ungrab-server", 1, 1, EVAL); + Define_Symbol (&Sym_Any, "any"); +} diff --git a/lib/xlib/graphics.c b/lib/xlib/graphics.c new file mode 100644 index 0000000..648b0e0 --- /dev/null +++ b/lib/xlib/graphics.c @@ -0,0 +1,267 @@ +#include "xlib.h" + +extern XDrawPoints(), XDrawLines(), XDrawRectangle(), XFillRectangle(); +extern XDrawRectangles(), XFillRectangles(), XDrawArc(), XFillArc(); +extern XDrawArcs(), XFillArcs(), XFillPolygon(); + +static Object P_Clear_Area (win, x, y, w, h, e) Object win, x, y, w, h, e; { + Check_Type (win, T_Window); + Check_Type (e, T_Boolean); + XClearArea (WINDOW(win)->dpy, WINDOW(win)->win, Get_Integer (x), + Get_Integer (y), Get_Integer (w), Get_Integer (h), EQ(e, True)); + return Void; +} + +static Object P_Copy_Area (src, gc, sx, sy, w, h, dst, dx, dy) Object src, gc, + sx, sy, w, h, dst, dx, dy; { + Display *dpy; + Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy); + + Check_Type (gc, T_Gc); + XCopyArea (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx), + Get_Integer (sy), Get_Integer (w), Get_Integer (h), + Get_Integer (dx), Get_Integer (dy)); + return Void; +} + +static Object P_Copy_Plane (src, gc, plane, sx, sy, w, h, dst, dx, dy) + Object src, gc, plane, sx, sy, w, h, dst, dx, dy; { + Display *dpy; + Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy); + register unsigned long p; + + Check_Type (gc, T_Gc); + p = (unsigned long)Get_Long (plane); + if (p & (p-1)) + Primitive_Error ("invalid plane: ~s", plane); + XCopyPlane (dpy, dsrc, ddst, GCONTEXT(gc)->gc, Get_Integer (sx), + Get_Integer (sy), Get_Integer (w), Get_Integer (h), + Get_Integer (dx), Get_Integer (dy), p); + return Void; +} + +static Object P_Draw_Point (d, gc, x, y) Object d, gc, x, y; { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + + Check_Type (gc, T_Gc); + XDrawPoint (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y)); + return Void; +} + +static Object Internal_Draw_Points (d, gc, v, relative, func, shape) + Object d, gc, v, relative, shape; int (*func)(); { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + register XPoint *p; + register i, n; + int rel, sh; + Alloca_Begin; + + Check_Type (gc, T_Gc); + Check_Type (relative, T_Boolean); + rel = EQ(relative, True) ? CoordModePrevious : CoordModeOrigin; + if (func == XFillPolygon) + sh = Symbols_To_Bits (shape, 0, Polyshape_Syms); + n = VECTOR(v)->size; + Alloca (p, XPoint*, n * sizeof (XPoint)); + for (i = 0; i < n; i++) { + Object point; + + point = VECTOR(v)->data[i]; + Check_Type (point, T_Pair); + p[i].x = Get_Integer (Car (point)); + p[i].y = Get_Integer (Cdr (point)); + } + if (func == XFillPolygon) + XFillPolygon (dpy, dr, GCONTEXT(gc)->gc, p, n, sh, rel); + else + (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n, rel); + Alloca_End; + return Void; +} + +static Object P_Draw_Points (d, gc, v, relative) Object d, gc, v, relative; { + return Internal_Draw_Points (d, gc, v, relative, XDrawPoints, Null); +} + +static Object P_Draw_Line (d, gc, x1, y1, x2, y2) + Object d, gc, x1, y1, x2, y2; { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + + Check_Type (gc, T_Gc); + XDrawLine (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x1), Get_Integer (y1), + Get_Integer (x2), Get_Integer (y2)); + return Void; +} + +static Object P_Draw_Lines (d, gc, v, relative) Object d, gc, v, relative; { + return Internal_Draw_Points (d, gc, v, relative, XDrawLines, Null); +} + +static Object P_Draw_Segments (d, gc, v) Object d, gc, v; { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + register XSegment *p; + register i, n; + Alloca_Begin; + + Check_Type (gc, T_Gc); + n = VECTOR(v)->size; + Alloca (p, XSegment*, n * sizeof (XSegment)); + for (i = 0; i < n; i++) { + Object seg; + + seg = VECTOR(v)->data[i]; + Check_Type (seg, T_Pair); + if (Fast_Length (seg) != 4) + Primitive_Error ("invalid segment: ~s", seg); + p[i].x1 = Get_Integer (Car (seg)); seg = Cdr (seg); + p[i].y1 = Get_Integer (Car (seg)); seg = Cdr (seg); + p[i].x2 = Get_Integer (Car (seg)); seg = Cdr (seg); + p[i].y2 = Get_Integer (Car (seg)); + } + XDrawSegments (dpy, dr, GCONTEXT(gc)->gc, p, n); + Alloca_End; + return Void; +} + +static Object Internal_Draw_Rectangle (d, gc, x, y, w, h, func) + Object d, gc, x, y, w, h; int (*func)(); { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + + Check_Type (gc, T_Gc); + (*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), + Get_Integer (y), Get_Integer (w), Get_Integer (h)); + return Void; +} + +static Object P_Draw_Rectangle (d, gc, x, y, w, h) Object d, gc, x, y, w, h; { + return Internal_Draw_Rectangle (d, gc, x, y, w, h, XDrawRectangle); +} + +static Object P_Fill_Rectangle (d, gc, x, y, w, h) Object d, gc, x, y, w, h; { + return Internal_Draw_Rectangle (d, gc, x, y, w, h, XFillRectangle); +} + +static Object Internal_Draw_Rectangles (d, gc, v, func) + Object d, gc, v; int (*func)(); { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + register XRectangle *p; + register i, n; + Alloca_Begin; + + Check_Type (gc, T_Gc); + n = VECTOR(v)->size; + Alloca (p, XRectangle*, n * sizeof (XRectangle)); + for (i = 0; i < n; i++) { + Object rect; + + rect = VECTOR(v)->data[i]; + Check_Type (rect, T_Pair); + if (Fast_Length (rect) != 4) + Primitive_Error ("invalid rectangle: ~s", rect); + p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect); + p[i].height = Get_Integer (Car (rect)); + } + (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n); + Alloca_End; + return Void; +} + +static Object P_Draw_Rectangles (d, gc, v) Object d, gc, v; { + return Internal_Draw_Rectangles (d, gc, v, XDrawRectangles); +} + +static Object P_Fill_Rectangles (d, gc, v) Object d, gc, v; { + return Internal_Draw_Rectangles (d, gc, v, XFillRectangles); +} + +static Object Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, func) + Object d, gc, x, y, w, h, a1, a2; int (*func)(); { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + + Check_Type (gc, T_Gc); + (*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y), + Get_Integer (w), Get_Integer (h), Get_Integer (a1), Get_Integer (a2)); + return Void; +} + +static Object P_Draw_Arc (d, gc, x, y, w, h, a1, a2) + Object d, gc, x, y, w, h, a1, a2; { + return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XDrawArc); +} + +static Object P_Fill_Arc (d, gc, x, y, w, h, a1, a2) + Object d, gc, x, y, w, h, a1, a2; { + return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XFillArc); +} + +static Object Internal_Draw_Arcs (d, gc, v, func) Object d, gc, v; + int (*func)(); { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + register XArc *p; + register i, n; + Alloca_Begin; + + Check_Type (gc, T_Gc); + n = VECTOR(v)->size; + Alloca (p, XArc*, n * sizeof (XArc)); + for (i = 0; i < n; i++) { + Object arc; + + arc = VECTOR(v)->data[i]; + Check_Type (arc, T_Pair); + if (Fast_Length (arc) != 6) + Primitive_Error ("invalid arc: ~s", arc); + p[i].x = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].y = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].width = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].height = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].angle1 = Get_Integer (Car (arc)); arc = Cdr (arc); + p[i].angle2 = Get_Integer (Car (arc)); + } + (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n); + Alloca_End; + return Void; +} + +static Object P_Draw_Arcs (d, gc, v) Object d, gc, v; { + return Internal_Draw_Arcs (d, gc, v, XDrawArcs); +} + +static Object P_Fill_Arcs (d, gc, v) Object d, gc, v; { + return Internal_Draw_Arcs (d, gc, v, XFillArcs); +} + +static Object P_Fill_Polygon (d, gc, v, relative, shape) + Object d, gc, v, relative, shape; { + return Internal_Draw_Points (d, gc, v, relative, XFillPolygon, shape); +} + +elk_init_xlib_graphics () { + Define_Primitive (P_Clear_Area, "clear-area", 6, 6, EVAL); + Define_Primitive (P_Copy_Area, "copy-area", 9, 9, EVAL); + Define_Primitive (P_Copy_Plane, "copy-plane", 10,10, EVAL); + Define_Primitive (P_Draw_Point, "draw-point", 4, 4, EVAL); + Define_Primitive (P_Draw_Points, "draw-points", 4, 4, EVAL); + Define_Primitive (P_Draw_Line, "draw-line", 6, 6, EVAL); + Define_Primitive (P_Draw_Lines, "draw-lines", 4, 4, EVAL); + Define_Primitive (P_Draw_Segments, "draw-segments", 3, 3, EVAL); + Define_Primitive (P_Draw_Rectangle, "draw-rectangle", 6, 6, EVAL); + Define_Primitive (P_Fill_Rectangle, "fill-rectangle", 6, 6, EVAL); + Define_Primitive (P_Draw_Rectangles, "draw-rectangles", 3, 3, EVAL); + Define_Primitive (P_Fill_Rectangles, "fill-rectangles", 3, 3, EVAL); + Define_Primitive (P_Draw_Arc, "draw-arc", 8, 8, EVAL); + Define_Primitive (P_Fill_Arc, "fill-arc", 8, 8, EVAL); + Define_Primitive (P_Draw_Arcs, "draw-arcs", 3, 3, EVAL); + Define_Primitive (P_Fill_Arcs, "fill-arcs", 3, 3, EVAL); + Define_Primitive (P_Fill_Polygon, "fill-polygon", 5, 5, EVAL); +} diff --git a/lib/xlib/init.c b/lib/xlib/init.c new file mode 100644 index 0000000..a259842 --- /dev/null +++ b/lib/xlib/init.c @@ -0,0 +1,50 @@ +#include "xlib.h" + +static Object P_Xlib_Release_4_Or_Laterp () { + return True; +} + +static Object P_Xlib_Release_5_Or_Laterp () { +#ifdef XLIB_RELEASE_5_OR_LATER + return True; +#else + return False; +#endif +} + +static Object P_Xlib_Release_6_Or_Laterp () { +#ifdef XLIB_RELEASE_6_OR_LATER + return True; +#else + return False; +#endif +} + +elk_init_xlib_init () { + Define_Primitive (P_Xlib_Release_4_Or_Laterp, + "xlib-release-4-or-later?", 0, 0, EVAL); + Define_Primitive (P_Xlib_Release_5_Or_Laterp, + "xlib-release-5-or-later?", 0, 0, EVAL); + Define_Primitive (P_Xlib_Release_6_Or_Laterp, + "xlib-release-6-or-later?", 0, 0, EVAL); + P_Provide (Intern ("xlib.o")); +} + +#if defined(XLIB_RELEASE_5_OR_LATER) && (defined(sun) || defined(__sun__)) &&\ + defined(__svr4__) +/* + * Stub interface to dynamic linker routines + * that SunOS uses but didn't ship with 4.1. + * + * The C library routine wcstombs in SunOS 4.1 tries to dynamically + * load some routines using the dlsym interface, described in dlsym(3x). + * Unfortunately SunOS 4.1 does not include the necessary library, libdl. + */ + +void *dlopen() { return 0; } + +void *dlsym() { return 0; } + +int dlclose() { return -1; } + +#endif diff --git a/lib/xlib/key.c b/lib/xlib/key.c new file mode 100644 index 0000000..9f269c2 --- /dev/null +++ b/lib/xlib/key.c @@ -0,0 +1,159 @@ +#include "xlib.h" + +#ifdef XLIB_RELEASE_5_OR_LATER + +/* I don't know if XDisplayKeycodes() was already there in X11R4. + */ +static Object P_Display_Min_Keycode (d) Object d; { + int mink, maxk; + + Check_Type (d, T_Display); + XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk); + return Make_Integer (mink); +} + +static Object P_Display_Max_Keycode (d) Object d; { + int mink, maxk; + + Check_Type (d, T_Display); + XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk); + return Make_Integer (maxk); +} + +#else +static Object P_Display_Min_Keycode (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (DISPLAY(d)->dpy->min_keycode); +} + +static Object P_Display_Max_Keycode (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (DISPLAY(d)->dpy->max_keycode); +} +#endif + +#ifdef XLIB_RELEASE_5_OR_LATER + +/* I'm not sure if this works correctly in X11R4: + */ +static Object P_Display_Keysyms_Per_Keycode (d) Object d; { + KeySym *ksyms; + int mink, maxk, ksyms_per_kode; + + Check_Type (d, T_Display); + XDisplayKeycodes(DISPLAY(d)->dpy, &mink, &maxk); + ksyms = XGetKeyboardMapping(DISPLAY(d)->dpy, (KeyCode)mink, + maxk - mink + 1, &ksyms_per_kode); + return Make_Integer (ksyms_per_kode); +} + +#else +static Object P_Display_Keysyms_Per_Keycode (d) Object d; { + Check_Type (d, T_Display); + /* Force initialization: */ + Disable_Interrupts; + (void)XKeycodeToKeysym (DISPLAY(d)->dpy, DISPLAY(d)->dpy->min_keycode, 0); + Enable_Interrupts; + return Make_Integer (DISPLAY(d)->dpy->keysyms_per_keycode); +} +#endif + +static Object P_String_To_Keysym (s) Object s; { + KeySym k; + + k = XStringToKeysym (Get_Strsym (s)); + return k == NoSymbol ? False : Make_Unsigned_Long ((unsigned long)k); +} + +static Object P_Keysym_To_String (k) Object k; { + register char *s; + + s = XKeysymToString ((KeySym)Get_Long (k)); + return s ? Make_String (s, strlen (s)) : False; +} + +static Object P_Keycode_To_Keysym (d, k, index) Object d, k, index; { + Object ret; + + Check_Type (d, T_Display); + Disable_Interrupts; + ret = Make_Unsigned_Long ((unsigned long)XKeycodeToKeysym (DISPLAY(d)->dpy, + Get_Integer (k), Get_Integer (index))); + Enable_Interrupts; + return ret; +} + +static Object P_Keysym_To_Keycode (d, k) Object d, k; { + Object ret; + + Check_Type (d, T_Display); + Disable_Interrupts; + ret = Make_Unsigned (XKeysymToKeycode (DISPLAY(d)->dpy, + (KeySym)Get_Long (k))); + Enable_Interrupts; + return ret; +} + +static Object P_Lookup_String (d, k, mask) Object d, k, mask; { + XKeyEvent e; + char buf[1024]; + register len; + KeySym keysym_return; + XComposeStatus status_return; + + Check_Type (d, T_Display); + e.display = DISPLAY(d)->dpy; + e.keycode = Get_Integer (k); + e.state = Symbols_To_Bits (mask, 1, State_Syms); + Disable_Interrupts; + len = XLookupString (&e, buf, 1024, &keysym_return, &status_return); + Enable_Interrupts; + return Make_String (buf, len); +} + +static Object P_Rebind_Keysym (d, k, mods, str) Object d, k, mods, str; { + KeySym *p; + register i, n; + Alloca_Begin; + + Check_Type (d, T_Display); + Check_Type (str, T_String); + Check_Type (mods, T_Vector); + n = VECTOR(mods)->size; + Alloca (p, KeySym*, n * sizeof (KeySym)); + for (i = 0; i < n; i++) + p[i] = (KeySym)Get_Long (VECTOR(mods)->data[i]); + XRebindKeysym (DISPLAY(d)->dpy, (KeySym)Get_Long (k), p, n, + (unsigned char *)STRING(str)->data, STRING(str)->size); + Alloca_End; + return Void; +} + +static Object P_Refresh_Keyboard_Mapping (w, event) Object w, event; { + static XMappingEvent fake; + + Check_Type (w, T_Window); + fake.type = MappingNotify; + fake.display = WINDOW(w)->dpy; + fake.window = WINDOW(w)->win; + fake.request = Symbols_To_Bits (event, 0, Mapping_Syms); + XRefreshKeyboardMapping (&fake); + return Void; +} + +elk_init_xlib_key () { + Define_Primitive (P_Display_Min_Keycode, "display-min-keycode", + 1, 1, EVAL); + Define_Primitive (P_Display_Max_Keycode, "display-max-keycode", + 1, 1, EVAL); + Define_Primitive (P_Display_Keysyms_Per_Keycode, + "display-keysyms-per-keycode", 1, 1, EVAL); + Define_Primitive (P_String_To_Keysym, "string->keysym", 1, 1, EVAL); + Define_Primitive (P_Keysym_To_String, "keysym->string", 1, 1, EVAL); + Define_Primitive (P_Keycode_To_Keysym, "keycode->keysym", 3, 3, EVAL); + Define_Primitive (P_Keysym_To_Keycode, "keysym->keycode", 2, 2, EVAL); + Define_Primitive (P_Lookup_String, "lookup-string", 3, 3, EVAL); + Define_Primitive (P_Rebind_Keysym, "rebind-keysym", 4, 4, EVAL); + Define_Primitive (P_Refresh_Keyboard_Mapping, + "refresh-keyboard-mapping", 2, 2, EVAL); +} diff --git a/lib/xlib/objects.c b/lib/xlib/objects.c new file mode 100644 index 0000000..b70b869 --- /dev/null +++ b/lib/xlib/objects.c @@ -0,0 +1,38 @@ +#include + +#include "xlib.h" + +Object Sym_None; + +int Match_X_Obj (x, v) Object x; va_list v; { + register type = TYPE(x); + + if (type == T_Display) { + return 1; + } else if (type == T_Gc) { + return va_arg (v, GC) == GCONTEXT(x)->gc; + } else if (type == T_Pixel) { + return va_arg (v, unsigned long) == PIXEL(x)->pix; + } else if (type == T_Pixmap) { + return va_arg (v, Pixmap) == PIXMAP(x)->pm; + } else if (type == T_Window) { + return va_arg (v, Window) == WINDOW(x)->win; + } else if (type == T_Font) { + return va_arg (v, Font) == FONT(x)->id; + } else if (type == T_Colormap) { + return va_arg (v, Colormap) == COLORMAP(x)->cm; + } else if (type == T_Color) { + return va_arg (v, unsigned int) == COLOR(x)->c.red + && va_arg (v, unsigned int) == COLOR(x)->c.green + && va_arg (v, unsigned int) == COLOR(x)->c.blue; + } else if (type == T_Cursor) { + return va_arg (v, Cursor) == CURSOR(x)->cursor; + } else if (type == T_Atom) { + return va_arg (v, Atom) == ATOM(x)->atom; + } else Panic ("Match_X_Obj"); + return 0; +} + +elk_init_xlib_objects () { + Define_Symbol (&Sym_None, "none"); +} diff --git a/lib/xlib/pixel.c b/lib/xlib/pixel.c new file mode 100644 index 0000000..d004995 --- /dev/null +++ b/lib/xlib/pixel.c @@ -0,0 +1,48 @@ +#include "xlib.h" + +Generic_Predicate (Pixel) + +Generic_Simple_Equal (Pixel, PIXEL, pix) + +Generic_Print (Pixel, "#[pixel 0x%lx]", PIXEL(x)->pix) + +Object Make_Pixel (val) unsigned long val; { + Object pix; + + pix = Find_Object (T_Pixel, (GENERIC)0, Match_X_Obj, val); + if (Nullp (pix)) { + pix = Alloc_Object (sizeof (struct S_Pixel), T_Pixel, 0); + PIXEL(pix)->tag = Null; + PIXEL(pix)->pix = val; + Register_Object (pix, (GENERIC)0, (PFO)0, 0); + } + return pix; +} + +unsigned long Get_Pixel (p) Object p; { + Check_Type (p, T_Pixel); + return PIXEL(p)->pix; +} + +static Object P_Pixel_Value (p) Object p; { + return Make_Unsigned_Long (Get_Pixel (p)); +} + +static Object P_Black_Pixel (d) Object d; { + Check_Type (d, T_Display); + return Make_Pixel (BlackPixel (DISPLAY(d)->dpy, + DefaultScreen (DISPLAY(d)->dpy))); +} + +static Object P_White_Pixel (d) Object d; { + Check_Type (d, T_Display); + return Make_Pixel (WhitePixel (DISPLAY(d)->dpy, + DefaultScreen (DISPLAY(d)->dpy))); +} + +elk_init_xlib_pixel () { + Generic_Define (Pixel, "pixel", "pixel?"); + Define_Primitive (P_Pixel_Value, "pixel-value", 1, 1, EVAL); + Define_Primitive (P_Black_Pixel, "black-pixel", 1, 1, EVAL); + Define_Primitive (P_White_Pixel, "white-pixel", 1, 1, EVAL); +} diff --git a/lib/xlib/pixmap.c b/lib/xlib/pixmap.c new file mode 100644 index 0000000..4d1aaa0 --- /dev/null +++ b/lib/xlib/pixmap.c @@ -0,0 +1,148 @@ +#include "xlib.h" + +Generic_Predicate (Pixmap) + +Generic_Equal_Dpy (Pixmap, PIXMAP, pm) + +Generic_Print (Pixmap, "#[pixmap %lu]", PIXMAP(x)->pm) + +Generic_Get_Display (Pixmap, PIXMAP) + +static Object Internal_Make_Pixmap (finalize, dpy, pix) + Display *dpy; Pixmap pix; { + Object pm; + + if (pix == None) + return Sym_None; + pm = Find_Object (T_Pixmap, (GENERIC)dpy, Match_X_Obj, pix); + if (Nullp (pm)) { + pm = Alloc_Object (sizeof (struct S_Pixmap), T_Pixmap, 0); + PIXMAP(pm)->tag = Null; + PIXMAP(pm)->pm = pix; + PIXMAP(pm)->dpy = dpy; + PIXMAP(pm)->free = 0; + Register_Object (pm, (GENERIC)dpy, + finalize ? P_Free_Pixmap : (PFO)0, 0); + } + return pm; +} + +/* Backwards compatibility: */ +Object Make_Pixmap (dpy, pix) Display *dpy; Pixmap pix; { + return Internal_Make_Pixmap (1, dpy, pix); +} + +Object Make_Pixmap_Foreign (dpy, pix) Display *dpy; Pixmap pix; { + return Internal_Make_Pixmap (0, dpy, pix); +} + +Pixmap Get_Pixmap (p) Object p; { + Check_Type (p, T_Pixmap); + return PIXMAP(p)->pm; +} + +Object P_Free_Pixmap (p) Object p; { + Check_Type (p, T_Pixmap); + if (!PIXMAP(p)->free) + XFreePixmap (PIXMAP(p)->dpy, PIXMAP(p)->pm); + Deregister_Object (p); + PIXMAP(p)->free = 1; + return Void; +} + +static Object P_Create_Pixmap (d, w, h, depth) Object d, w, h, depth; { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + + return Make_Pixmap (dpy, XCreatePixmap (dpy, dr, Get_Integer (w), + Get_Integer (h), Get_Integer (depth))); +} + +static Object P_Create_Bitmap_From_Data (win, data, pw, ph) + Object win, data, pw, ph; { + register w, h; + + Check_Type (win, T_Window); + Check_Type (data, T_String); + w = Get_Integer (pw); + h = Get_Integer (ph); + if (w * h > 8 * STRING(data)->size) + Primitive_Error ("bitmap too small"); + return Make_Pixmap (WINDOW(win)->dpy, + XCreateBitmapFromData (WINDOW(win)->dpy, WINDOW(win)->win, + STRING(data)->data, w, h)); +} + +static Object P_Create_Pixmap_From_Bitmap_Data (win, data, pw, ph, fg, bg, + depth) Object win, data, pw, ph, fg, bg, depth; { + register w, h; + + Check_Type (win, T_Window); + Check_Type (data, T_String); + w = Get_Integer (pw); + h = Get_Integer (ph); + if (w * h > 8 * STRING(data)->size) + Primitive_Error ("bitmap too small"); + return Make_Pixmap (WINDOW(win)->dpy, + XCreatePixmapFromBitmapData (WINDOW(win)->dpy, WINDOW(win)->win, + STRING(data)->data, w, h, Get_Pixel (fg), Get_Pixel (bg), + Get_Integer (depth))); +} + +static Object P_Read_Bitmap_File (d, fn) Object d, fn; { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + unsigned width, height; + int r, xhot, yhot; + Pixmap bitmap; + Object t, ret, x; + GC_Node2; + + Disable_Interrupts; + r = XReadBitmapFile (dpy, dr, Get_Strsym (fn), &width, &height, &bitmap, + &xhot, &yhot); + Enable_Interrupts; + if (r != BitmapSuccess) + return Bits_To_Symbols ((unsigned long)r, 0, Bitmapstatus_Syms); + t = ret = P_Make_List (Make_Integer (5), Null); + GC_Link2 (ret, t); + x = Make_Pixmap (dpy, bitmap); + Car (t) = x; t = Cdr (t); + Car (t) = Make_Integer (width); t = Cdr (t); + Car (t) = Make_Integer (height); t = Cdr (t); + Car (t) = Make_Integer (xhot); t = Cdr (t); + Car (t) = Make_Integer (yhot); + GC_Unlink; + return ret; +} + +static Object P_Write_Bitmap_File (argc, argv) Object *argv; { + Pixmap pm; + int ret, xhot = -1, yhot = -1; + + pm = Get_Pixmap (argv[1]); + if (argc == 5) + Primitive_Error ("both x-hot and y-hot must be specified"); + if (argc == 6) { + xhot = Get_Integer (argv[4]); + yhot = Get_Integer (argv[5]); + } + Disable_Interrupts; + ret = XWriteBitmapFile (PIXMAP(argv[1])->dpy, Get_Strsym (argv[0]), pm, + Get_Integer (argv[2]), Get_Integer (argv[3]), xhot, yhot); + Enable_Interrupts; + return Bits_To_Symbols ((unsigned long)ret, 0, Bitmapstatus_Syms); +} + +elk_init_xlib_pixmap () { + Generic_Define (Pixmap, "pixmap", "pixmap?"); + Define_Primitive (P_Pixmap_Display, "pixmap-display", 1, 1, EVAL); + Define_Primitive (P_Free_Pixmap, "free-pixmap", 1, 1, EVAL); + Define_Primitive (P_Create_Pixmap, "create-pixmap", 4, 4, EVAL); + Define_Primitive (P_Create_Bitmap_From_Data, + "create-bitmap-from-data", 4, 4, EVAL); + Define_Primitive (P_Create_Pixmap_From_Bitmap_Data, + "create-pixmap-from-bitmap-data", 7, 7, EVAL); + Define_Primitive (P_Read_Bitmap_File, "read-bitmap-file", 2, 2, EVAL); + Define_Primitive (P_Write_Bitmap_File, "write-bitmap-file", 4, 6, VARARGS); +} diff --git a/lib/xlib/property.c b/lib/xlib/property.c new file mode 100644 index 0000000..9bf5c47 --- /dev/null +++ b/lib/xlib/property.c @@ -0,0 +1,250 @@ +#include "xlib.h" + +Object Sym_Now; + +Generic_Predicate (Atom) + +Generic_Simple_Equal (Atom, ATOM, atom) + +Generic_Print (Atom, "#[atom %lu]", ATOM(x)->atom) + +Object Make_Atom (a) Atom a; { + Object atom; + + if (a == None) + return Sym_None; + atom = Find_Object (T_Atom, (GENERIC)0, Match_X_Obj, a); + if (Nullp (atom)) { + atom = Alloc_Object (sizeof (struct S_Atom), T_Atom, 0); + ATOM(atom)->tag = Null; + ATOM(atom)->atom = a; + Register_Object (atom, (GENERIC)0, (PFO)0, 0); + } + return atom; +} + +/* Should be used with care */ +static Object P_Make_Atom (n) Object n; { + return Make_Atom ((Atom)Get_Long (n)); +} + +static Object P_Intern_Atom (d, name) Object d, name; { + Check_Type (d, T_Display); + return Make_Atom (XInternAtom (DISPLAY(d)->dpy, Get_Strsym (name), 0)); +} + +static Object P_Find_Atom (d, name) Object d, name; { + Check_Type (d, T_Display); + return Make_Atom (XInternAtom (DISPLAY(d)->dpy, Get_Strsym (name), 1)); +} + +static Object P_Atom_Name (d, a) Object d, a; { + register char *s; + + Check_Type (d, T_Display); + Check_Type (a, T_Atom); + Disable_Interrupts; + s = XGetAtomName (DISPLAY(d)->dpy, ATOM(a)->atom); + Enable_Interrupts; + return Make_String (s, strlen (s)); +} + +static Object P_List_Properties (w) Object w; { + register i; + int n; + register Atom *ap; + Object v; + GC_Node; + + Check_Type (w, T_Window); + Disable_Interrupts; + ap = XListProperties (WINDOW(w)->dpy, WINDOW(w)->win, &n); + Enable_Interrupts; + v = Make_Vector (n, Null); + GC_Link (v); + for (i = 0; i < n; i++) { + Object x; + + x = Make_Atom (ap[i]); + VECTOR(v)->data[i] = x; + } + GC_Unlink; + XFree ((char *)ap); + return v; +} + +static Object P_Get_Property (w, prop, type, start, len, deletep) + Object w, prop, type, start, len, deletep; { + Atom req_type = AnyPropertyType, actual_type; + int format; + unsigned long nitems, bytes_left; + unsigned char *data; + Object ret, t, x; + register i; + GC_Node2; + + Check_Type (w, T_Window); + Check_Type (prop, T_Atom); + if (!EQ(type, False)) { + Check_Type (type, T_Atom); + req_type = ATOM(type)->atom; + } + Check_Type (deletep, T_Boolean); + Disable_Interrupts; + if (XGetWindowProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom, + Get_Long (start), Get_Long (len), + EQ(deletep, True), req_type, &actual_type, &format, + &nitems, &bytes_left, &data) != Success) + Primitive_Error ("cannot get property"); + Enable_Interrupts; + ret = t = P_Make_List (Make_Integer (4), Null); + GC_Link2 (ret, t); + x = Make_Atom (actual_type); + Car (t) = x; t = Cdr (t); + x = Make_Integer (format); + Car (t) = x; t = Cdr (t); + if (nitems) { + if (format == 8) { + Object s; + x = Make_String ((char *)0, (int)nitems); + s = Car (t) = x; + bcopy ((char *)data, STRING(s)->data, (int)nitems); + } else { + Object v; + GC_Node; + /* Assumes short is 16 bits and int is 32 bits. + */ + v = Make_Vector ((int)nitems, Null); + GC_Link (v); + for (i = 0; i < nitems; i++) { + x = Make_Unsigned (format == 16 ? + *((short *)data + i) : *((int *)data + i)); + VECTOR(v)->data[i] = x; + } + Car (t) = v; + GC_Unlink; + } + } + t = Cdr (t); + x = Make_Unsigned_Long (bytes_left); + Car (t) = x; + GC_Unlink; + return ret; +} + +static Object P_Change_Property (w, prop, type, format, mode, data) + Object w, prop, type, format, mode, data; { + register i, m, x, nitems, f; + char *buf; + Alloca_Begin; + + Check_Type (w, T_Window); + Check_Type (prop, T_Atom); + Check_Type (type, T_Atom); + m = Symbols_To_Bits (mode, 0, Propmode_Syms); + switch (f = Get_Integer (format)) { + case 8: + Check_Type (data, T_String); + buf = STRING(data)->data; + nitems = STRING(data)->size; + break; + case 16: case 32: + Check_Type (data, T_Vector); + nitems = VECTOR(data)->size; + Alloca (buf, char*, nitems * (f / sizeof (char))); + for (i = 0; i < nitems; i++) { + x = Get_Integer (VECTOR(data)->data[i]); + if (f == 16) { + if (x > 65535) + Primitive_Error ("format mismatch"); + *((short *)buf + i) = x; /* Assumes short is 16 bits */ + } else *((int *)buf + i) = x; /* and int is 32 bits. */ + } + break; + default: + Primitive_Error ("invalid format: ~s", format); + } + XChangeProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom, + ATOM(type)->atom, f, m, (unsigned char *)buf, nitems); + Alloca_End; + return Void; +} + +static Object P_Delete_Property (w, prop) Object w, prop; { + Check_Type (w, T_Window); + Check_Type (prop, T_Atom); + XDeleteProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom); + return Void; +} + +static Object P_Rotate_Properties (w, v, delta) Object w, v, delta; { + Atom *p; + register i, n; + Alloca_Begin; + + Check_Type (w, T_Window); + Check_Type (v, T_Vector); + n = VECTOR(v)->size; + Alloca (p, Atom*, n * sizeof (Atom)); + for (i = 0; i < n; i++) { + Object a; + + a = VECTOR(v)->data[i]; + Check_Type (a, T_Atom); + p[i] = ATOM(a)->atom; + } + XRotateWindowProperties (WINDOW(w)->dpy, WINDOW(w)->win, p, n, + Get_Integer (delta)); + Alloca_End; + return Void; +} + +static Object P_Set_Selection_Owner (d, s, owner, time) Object d, s, owner, + time; { + Check_Type (d, T_Display); + Check_Type (s, T_Atom); + XSetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom, Get_Window (owner), + Get_Time (time)); + return Void; +} + +static Object P_Selection_Owner (d, s) Object d, s; { + Check_Type (d, T_Display); + Check_Type (s, T_Atom); + return Make_Window (0, DISPLAY(d)->dpy, + XGetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom)); +} + +static Object P_Convert_Selection (s, target, prop, w, time) + Object s, target, prop, w, time; { + Atom p = None; + + Check_Type (s, T_Atom); + Check_Type (target, T_Atom); + if (!EQ(prop, Sym_None)) { + Check_Type (prop, T_Atom); + p = ATOM(prop)->atom; + } + Check_Type (w, T_Window); + XConvertSelection (WINDOW(w)->dpy, ATOM(s)->atom, ATOM(target)->atom, + p, WINDOW(w)->win, Get_Time (time)); + return Void; +} + +elk_init_xlib_property () { + Define_Symbol (&Sym_Now, "now"); + Generic_Define (Atom, "atom", "atom?"); + Define_Primitive (P_Make_Atom, "make-atom", 1, 1, EVAL); + Define_Primitive (P_Intern_Atom, "intern-atom", 2, 2, EVAL); + Define_Primitive (P_Find_Atom, "find-atom", 2, 2, EVAL); + Define_Primitive (P_Atom_Name, "atom-name", 2, 2, EVAL); + Define_Primitive (P_List_Properties, "list-properties", 1, 1, EVAL); + Define_Primitive (P_Get_Property, "get-property", 6, 6, EVAL); + Define_Primitive (P_Change_Property, "change-property", 6, 6, EVAL); + Define_Primitive (P_Delete_Property, "delete-property", 2, 2, EVAL); + Define_Primitive (P_Rotate_Properties, "rotate-properties", 3, 3, EVAL); + Define_Primitive (P_Set_Selection_Owner, "set-selection-owner!", + 4, 4, EVAL); + Define_Primitive (P_Selection_Owner, "selection-owner", 2, 2, EVAL); + Define_Primitive (P_Convert_Selection, "convert-selection", 5, 5, EVAL); +} diff --git a/lib/xlib/text.c b/lib/xlib/text.c new file mode 100644 index 0000000..cc3c2b9 --- /dev/null +++ b/lib/xlib/text.c @@ -0,0 +1,180 @@ +#include "xlib.h" + +extern XDrawText(), XDrawText16(); +static Object Sym_1byte, Sym_2byte; + +static Two_Byte (format) Object format; { + Check_Type (format, T_Symbol); + if (EQ(format, Sym_1byte)) + return 0; + else if (EQ(format, Sym_2byte)) + return 1; + Primitive_Error ("index format must be '1-byte or '2-byte"); + /*NOTREACHED*/ +} + +static Get_1_Byte_Char (x) Object x; { + register c = Get_Integer (x); + if (c < 0 || c > 255) + Range_Error (x); + return c; +} + +static Get_2_Byte_Char (x) Object x; { + register c = Get_Integer (x); + if (c < 0 || c > 65535) + Range_Error (x); + return c; +} + +/* Calculation of text widths and extents should not be done using + * the Xlib functions. For instance, the values returned by + * XTextExtents() are only shorts and can therefore overflow for + * long strings. + */ + +static Object Internal_Text_Metrics (font, t, f, width) Object font, t, f; { + char *s; + XChar2b *s2; + XFontStruct *info; + Object *data; + register i, n; + int dir, fasc, fdesc; + Alloca_Begin; + + Check_Type (font, T_Font); + info = FONT(font)->info; + Check_Type (t, T_Vector); + n = VECTOR(t)->size; + data = VECTOR(t)->data; + if (Two_Byte (f)) { + Alloca (s2, XChar2b*, n * sizeof (XChar2b)); + for (i = 0; i < n; i++) { + register c = Get_2_Byte_Char (data[i]); + s2[i].byte1 = (c >> 8) & 0xff; + s2[i].byte2 = c & 0xff; + } + if (width) + i = XTextWidth16 (info, s2, n); + else + XTextExtents16 (info, s2, n, &dir, &fasc, &fdesc, &CI); + } else { + Alloca (s, char*, n); + for (i = 0; i < n; i++) + s[i] = Get_1_Byte_Char (data[i]); + if (width) + i = XTextWidth (info, s, n); + else + XTextExtents (info, s, n, &dir, &fasc, &fdesc, &CI); + } + Alloca_End; + return width ? Make_Integer (i) : Record_To_Vector (Char_Info_Rec, + Char_Info_Size, Sym_Char_Info, FONT(font)->dpy, ~0L); +} + +static Object P_Text_Width (font, t, f) Object font, t, f; { + return Internal_Text_Metrics (font, t, f, 1); +} + +static Object P_Text_Extents (font, t, f) Object font, t, f; { + return Internal_Text_Metrics (font, t, f, 0); +} + +static Object P_Draw_Image_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + Object *data; + register i, n; + char *s; + XChar2b *s2; + Alloca_Begin; + + Check_Type (gc, T_Gc); + Check_Type (t, T_Vector); + n = VECTOR(t)->size; + data = VECTOR(t)->data; + if (Two_Byte (f)) { + Alloca (s2, XChar2b*, n * sizeof (XChar2b)); + for (i = 0; i < n; i++) { + register c = Get_2_Byte_Char (data[i]); + s2[i].byte1 = (c >> 8) & 0xff; + s2[i].byte2 = c & 0xff; + } + XDrawImageString16 (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), + Get_Integer (y), s2, n); + } else { + Alloca (s, char*, n); + for (i = 0; i < n; i++) + s[i] = Get_1_Byte_Char (data[i]); + XDrawImageString (dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), + Get_Integer (y), s, n); + } + Alloca_End; + return Void; +} + +static Object P_Draw_Poly_Text (d, gc, x, y, t, f) Object d, gc, x, y, t, f; { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + Object *data; + register i, n, j, k; + int twobyte, nitems; + XTextItem *items; + int (*func)(); + Alloca_Begin; + + Check_Type (gc, T_Gc); + twobyte = Two_Byte (f); + func = twobyte ? (int(*)())XDrawText16 : (int(*)())XDrawText; + Check_Type (t, T_Vector); + if ((n = VECTOR(t)->size) == 0) + return Void; + for (data = VECTOR(t)->data, i = 0, nitems = 1; i < n; i++) + if (TYPE(data[i]) == T_Font) nitems++; + Alloca (items, XTextItem*, nitems * sizeof (XTextItem)); + items[0].delta = 0; + items[0].font = None; + for (j = k = i = 0; i <= n; i++) { + if (i == n || TYPE(data[i]) == T_Font) { + items[j].nchars = i-k; + if (twobyte) { + register XChar2b *p; + + Alloca (p, XChar2b*, (i-k) * sizeof (XChar2b)); + ((XTextItem16 *)items)[j].chars = p; + for ( ; k < i; k++, p++) { + register c = Get_2_Byte_Char (data[k]); + p->byte1 = (c >> 8) & 0xff; + p->byte2 = c & 0xff; + } + } else { + register char *p; + + Alloca (p, char*, i-k); + items[j].chars = p; + for ( ; k < i; k++) + *p++ = Get_1_Byte_Char (data[k]); + } + k++; + j++; + if (i < n) { + items[j].delta = 0; + Open_Font_Maybe (data[i]); + items[j].font = FONT(data[i])->id; + } + } + } + (*func)(dpy, dr, GCONTEXT(gc)->gc, Get_Integer (x), Get_Integer (y), + items, nitems); + Alloca_End; + return Void; +} + +elk_init_xlib_text () { + Define_Primitive (P_Text_Width, "text-width", 3, 3, EVAL); + Define_Primitive (P_Text_Extents, "xlib-text-extents", 3, 3, EVAL); + Define_Primitive (P_Draw_Image_Text, "draw-image-text", 6, 6, EVAL); + Define_Primitive (P_Draw_Poly_Text, "draw-poly-text", 6, 6, EVAL); + Define_Symbol (&Sym_1byte, "1-byte"); + Define_Symbol (&Sym_2byte, "2-byte"); +} diff --git a/lib/xlib/type.c b/lib/xlib/type.c new file mode 100644 index 0000000..06d3832 --- /dev/null +++ b/lib/xlib/type.c @@ -0,0 +1,803 @@ +#include "xlib.h" + +static Object Set_Attr_Slots; +static Object Conf_Slots; +static Object GC_Slots; +static Object Geometry_Slots; +static Object Win_Attr_Slots; +static Object Font_Info_Slots; +static Object Char_Info_Slots; +static Object Wm_Hints_Slots; +static Object Size_Hints_Slots; + +static Object Sym_Parent_Relative, Sym_Copy_From_Parent; + +XSetWindowAttributes SWA; +RECORD Set_Attr_Rec[] = { + { (char *)&SWA.background_pixmap, "background-pixmap", T_BACKGROUND, + 0, CWBackPixmap }, + { (char *)&SWA.background_pixel, "background-pixel", T_PIXEL, + 0, CWBackPixel }, + { (char *)&SWA.border_pixmap, "border-pixmap", T_BORDER, + 0, CWBorderPixmap }, + { (char *)&SWA.border_pixel, "border-pixel", T_PIXEL, + 0, CWBorderPixel }, + { (char *)&SWA.bit_gravity, "bit-gravity", T_SYM, + Bit_Grav_Syms, CWBitGravity }, + { (char *)&SWA.win_gravity, "gravity", T_SYM, + Grav_Syms, CWWinGravity }, + { (char *)&SWA.backing_store, "backing-store", T_SYM, + Backing_Store_Syms, CWBackingStore }, + { (char *)&SWA.backing_planes, "backing-planes", T_PIXEL, + 0, CWBackingPlanes }, + { (char *)&SWA.backing_pixel, "backing-pixel", T_PIXEL, + 0, CWBackingPixel }, + { (char *)&SWA.save_under, "save-under", T_BOOL, + 0, CWSaveUnder }, + { (char *)&SWA.event_mask, "event-mask", T_MASK, + Event_Syms, CWEventMask }, + { (char *)&SWA.do_not_propagate_mask, "do-not-propagate-mask", T_MASK, + Event_Syms, CWDontPropagate }, + { (char *)&SWA.override_redirect, "override-redirect", T_BOOL, + 0, CWOverrideRedirect }, + { (char *)&SWA.colormap, "colormap", T_COLORMAP, + 0, CWColormap }, + { (char *)&SWA.cursor, "cursor", T_CURSOR, + 0, CWCursor }, + { 0, 0, T_NONE, 0, 0 } +}; +int Set_Attr_Size = sizeof Set_Attr_Rec / sizeof (RECORD); + +XWindowChanges WC; +RECORD Conf_Rec[] = { + { (char *)&WC.x, "x", T_INT, 0, CWX }, + { (char *)&WC.y, "y", T_INT, 0, CWY }, + { (char *)&WC.width, "width", T_INT, 0, CWWidth }, + { (char *)&WC.height, "height", T_INT, 0, CWHeight }, + { (char *)&WC.border_width, "border-width", T_INT, 0, CWBorderWidth }, + { (char *)&WC.sibling, "sibling", T_WINDOW, 0, CWSibling }, + { (char *)&WC.stack_mode, "stack-mode", T_SYM, Stack_Mode_Syms, + CWStackMode }, + { 0, 0, T_NONE, 0, 0 } +}; +int Conf_Size = sizeof Conf_Rec / sizeof (RECORD); + +XGCValues GCV; +RECORD GC_Rec[] = { + { (char *)&GCV.function, "function", T_SYM, + Func_Syms, GCFunction }, + { (char *)&GCV.plane_mask, "plane-mask", T_PIXEL, + 0, GCPlaneMask }, + { (char *)&GCV.foreground, "foreground", T_PIXEL, + 0, GCForeground }, + { (char *)&GCV.background, "background", T_PIXEL, + 0, GCBackground }, + { (char *)&GCV.line_width, "line-width", T_INT, + 0, GCLineWidth }, + { (char *)&GCV.line_style, "line-style", T_SYM, + Line_Style_Syms, GCLineStyle }, + { (char *)&GCV.cap_style, "cap-style", T_SYM, + Cap_Style_Syms, GCCapStyle }, + { (char *)&GCV.join_style, "join-style", T_SYM, + Join_Style_Syms, GCJoinStyle }, + { (char *)&GCV.fill_style, "fill-style", T_SYM, + Fill_Style_Syms, GCFillStyle }, + { (char *)&GCV.fill_rule, "fill-rule", T_SYM, + Fill_Rule_Syms, GCFillRule }, + { (char *)&GCV.arc_mode, "arc-mode", T_SYM, + Arc_Mode_Syms, GCArcMode }, + { (char *)&GCV.tile, "tile", T_PIXMAP, + 0, GCTile }, + { (char *)&GCV.stipple, "stipple", T_PIXMAP, + 0, GCStipple }, + { (char *)&GCV.ts_x_origin, "ts-x", T_INT, + 0, GCTileStipXOrigin }, + { (char *)&GCV.ts_y_origin, "ts-y", T_INT, + 0, GCTileStipYOrigin }, + { (char *)&GCV.font, "font", T_FONT, + 0, GCFont }, + { (char *)&GCV.subwindow_mode, "subwindow-mode", T_SYM, + Subwin_Mode_Syms, GCSubwindowMode }, + { (char *)&GCV.graphics_exposures, "exposures", T_BOOL, + 0, GCGraphicsExposures }, + { (char *)&GCV.clip_x_origin, "clip-x", T_INT, + 0, GCClipXOrigin }, + { (char *)&GCV.clip_y_origin, "clip-y", T_INT, + 0, GCClipYOrigin }, + { (char *)&GCV.clip_mask, "clip-mask", T_PIXMAP, + 0, GCClipMask }, + { (char *)&GCV.dash_offset, "dash-offset", T_INT, + 0, GCDashOffset }, + { (char *)&GCV.dashes, "dashes", T_CHAR, + 0, GCDashList }, + {0, 0, T_NONE, 0, 0 } +}; +int GC_Size = sizeof GC_Rec / sizeof (RECORD); + +GEOMETRY GEO; +RECORD Geometry_Rec[] = { + { (char *)&GEO.root, "root", T_WINDOW, 0, 0 }, + { (char *)&GEO.x, "x", T_INT, 0, 0 }, + { (char *)&GEO.y, "y", T_INT, 0, 0 }, + { (char *)&GEO.width, "width", T_INT, 0, 0 }, + { (char *)&GEO.height, "height", T_INT, 0, 0 }, + { (char *)&GEO.border_width, "border-width", T_INT, 0, 0 }, + { (char *)&GEO.depth, "depth", T_INT, 0, 0 }, + {0, 0, T_NONE, 0, 0 } +}; +int Geometry_Size = sizeof Geometry_Rec / sizeof (RECORD); + +XWindowAttributes WA; +RECORD Win_Attr_Rec[] = { + { (char *)&WA.x, "x", T_INT, + 0, 0 }, + { (char *)&WA.y, "y", T_INT, + 0, 0 }, + { (char *)&WA.width, "width", T_INT, + 0, 0 }, + { (char *)&WA.height, "height", T_INT, + 0, 0 }, + { (char *)&WA.border_width, "border-width", T_INT, + 0, 0 }, + { (char *)&WA.depth, "depth", T_INT, + 0, 0 }, + { (char *)&WA.visual, "visual", T_NONE, + 0, 0 }, + { (char *)&WA.root, "root", T_WINDOW, + 0, 0 }, +#if defined(__cplusplus) || defined(c_plusplus) + { (char *)&WA.c_class, "class", T_SYM, +#else + { (char *)&WA.class, "class", T_SYM, +#endif + Class_Syms, 0 }, + { (char *)&WA.bit_gravity, "bit-gravity", T_SYM, + Bit_Grav_Syms, 0 }, + { (char *)&WA.win_gravity, "gravity", T_SYM, + Grav_Syms, 0 }, + { (char *)&WA.backing_store, "backing-store", T_SYM, + Backing_Store_Syms, 0 }, + { (char *)&WA.backing_planes, "backing-planes", T_PIXEL, + 0, 0 }, + { (char *)&WA.backing_pixel, "backing-pixel", T_PIXEL, + 0, 0 }, + { (char *)&WA.save_under, "save-under", T_BOOL, + 0, 0 }, + { (char *)&WA.colormap , "colormap", T_COLORMAP, + 0, 0 }, + { (char *)&WA.map_installed, "map-installed", T_BOOL, + 0, 0 }, + { (char *)&WA.map_state, "map-state", T_SYM, + Map_State_Syms, 0 }, + { (char *)&WA.all_event_masks, "all-event-masks", T_MASK, + Event_Syms, 0 }, + { (char *)&WA.your_event_mask, "your-event-mask", T_MASK, + Event_Syms, 0 }, + { (char *)&WA.do_not_propagate_mask, "do-not-propagate-mask", T_MASK, + Event_Syms, 0 }, + { (char *)&WA.override_redirect, "override-redirect", T_BOOL, + 0, 0 }, + { (char *)&WA.screen, "screen", T_NONE, + 0, 0 }, + {0, 0, T_NONE, 0, 0 } +}; +int Win_Attr_Size = sizeof Win_Attr_Rec / sizeof (RECORD); + +XFontStruct FI; +RECORD Font_Info_Rec[] = { + { (char *)&FI.direction, "direction", T_SYM, + Direction_Syms, 0 }, + { (char *)&FI.min_char_or_byte2, "min-byte2", T_INT, + 0, 0 }, + { (char *)&FI.max_char_or_byte2, "max-byte2", T_INT, + 0, 0 }, + { (char *)&FI.min_byte1, "min-byte1", T_INT, + 0, 0 }, + { (char *)&FI.max_byte1, "max-byte1", T_INT, + 0, 0 }, + { (char *)&FI.all_chars_exist, "all-chars-exist?", T_BOOL, + 0, 0 }, + { (char *)&FI.default_char, "default-char", T_INT, + 0, 0 }, + { (char *)&FI.ascent, "ascent", T_INT, + 0, 0 }, + { (char *)&FI.descent, "descent", T_INT, + 0, 0 }, + {0, 0, T_NONE, 0, 0 } +}; +int Font_Info_Size = sizeof Font_Info_Rec / sizeof (RECORD); + +XCharStruct CI; +RECORD Char_Info_Rec[] = { + { (char *)&CI.lbearing, "lbearing", T_SHORT, 0, 0 }, + { (char *)&CI.rbearing, "rbearing", T_SHORT, 0, 0 }, + { (char *)&CI.width, "width", T_SHORT, 0, 0 }, + { (char *)&CI.ascent, "ascent", T_SHORT, 0, 0 }, + { (char *)&CI.descent, "descent", T_SHORT, 0, 0 }, + { (char *)&CI.attributes, "attributes", T_SHORT, 0, 0 }, + {0, 0, T_NONE, 0, 0 } +}; +int Char_Info_Size = sizeof Char_Info_Rec / sizeof (RECORD); + +XWMHints WMH; +RECORD Wm_Hints_Rec[] = { + { (char *)&WMH.input, "input?", T_BOOL, + 0, InputHint }, + { (char *)&WMH.initial_state, "initial-state", T_SYM, + Initial_State_Syms, StateHint }, + { (char *)&WMH.icon_pixmap, "icon-pixmap", T_PIXMAP, + 0, IconPixmapHint }, + { (char *)&WMH.icon_window, "icon-window", T_WINDOW, + 0, IconWindowHint }, + { (char *)&WMH.icon_x, "icon-x", T_INT, + 0, IconPositionHint }, + { (char *)&WMH.icon_y, "icon-y", T_INT, + 0, IconPositionHint }, + { (char *)&WMH.icon_mask, "icon-mask", T_PIXMAP, + 0, IconMaskHint }, + { (char *)&WMH.window_group, "window-group", T_WINDOW, + 0, WindowGroupHint }, + {0, 0, T_NONE, 0, 0 } +}; +int Wm_Hints_Size = sizeof Wm_Hints_Rec / sizeof (RECORD); + +XSizeHints SZH; +RECORD Size_Hints_Rec[] = { + { (char *)&SZH.x, "x", T_INT, 0, PPosition }, + { (char *)&SZH.y, "y", T_INT, 0, PPosition }, + { (char *)&SZH.width, "width", T_INT, 0, PSize }, + { (char *)&SZH.height, "height", T_INT, 0, PSize }, + { (char *)&SZH.x, "x", T_INT, 0, USPosition }, + { (char *)&SZH.y, "y", T_INT, 0, USPosition }, + { (char *)&SZH.width, "width", T_INT, 0, USSize }, + { (char *)&SZH.height, "height", T_INT, 0, USSize }, + { (char *)&SZH.min_width, "min-width", T_INT, 0, PMinSize }, + { (char *)&SZH.min_height, "min-height", T_INT, 0, PMinSize }, + { (char *)&SZH.max_width, "max-width", T_INT, 0, PMaxSize }, + { (char *)&SZH.max_height, "max-height", T_INT, 0, PMaxSize }, + { (char *)&SZH.width_inc, "width-inc", T_INT, 0, PResizeInc }, + { (char *)&SZH.height_inc, "height-inc", T_INT, 0, PResizeInc }, + { (char *)&SZH.min_aspect.x, "min-aspect-x", T_INT, 0, PAspect }, + { (char *)&SZH.min_aspect.y, "min-aspect-y", T_INT, 0, PAspect }, + { (char *)&SZH.max_aspect.x, "max-aspect-x", T_INT, 0, PAspect }, + { (char *)&SZH.max_aspect.y, "max-aspect-y", T_INT, 0, PAspect }, + { (char *)&SZH.base_width, "base-width", T_INT, 0, PBaseSize }, + { (char *)&SZH.base_height, "base-height", T_INT, 0, PBaseSize }, + { (char *)&SZH.win_gravity, "gravity", T_SYM, Grav_Syms, + PWinGravity }, + {0, 0, T_NONE, 0, 0 } +}; +int Size_Hints_Size = sizeof Size_Hints_Rec / sizeof (RECORD); + +unsigned long Vector_To_Record (v, len, sym, rp) Object v, sym; + register RECORD *rp; { + register Object *p; + unsigned long mask = 0; + + Check_Type (v, T_Vector); + p = VECTOR(v)->data; + if (VECTOR(v)->size != len && !EQ(p[0], sym)) + Primitive_Error ("invalid argument"); + for ( ; rp->slot; rp++) { + ++p; + if (rp->type == T_NONE || Nullp (*p)) + continue; + switch (rp->type) { + case T_INT: + *(int *)rp->slot = Get_Integer (*p); break; + case T_SHORT: + *(short *)rp->slot = Get_Integer (*p); break; + case T_CHAR: + *(char *)rp->slot = Get_Integer (*p); break; + case T_PIXEL: + *(unsigned long *)rp->slot = Get_Pixel (*p); break; + case T_BACKGROUND: + if (EQ(*p, Sym_None)) + *(Pixmap *)rp->slot = None; + else if (EQ(*p, Sym_Parent_Relative)) + *(Pixmap *)rp->slot = ParentRelative; + else + *(Pixmap *)rp->slot = Get_Pixmap (*p); + break; + case T_BORDER: + if (EQ(*p, Sym_Copy_From_Parent)) { + *(Pixmap *)rp->slot = CopyFromParent; + break; + } + /* fall through */ + case T_PIXMAP: + *(Pixmap *)rp->slot = Get_Pixmap (*p); break; + case T_BOOL: + Check_Type (*p, T_Boolean); + *(Bool *)rp->slot = (Bool)(FIXNUM(*p)); + break; + case T_FONT: + *(Font *)rp->slot = Get_Font (*p); + break; + case T_COLORMAP: + *(Colormap *)rp->slot = Get_Colormap (*p); break; + case T_CURSOR: + *(Cursor *)rp->slot = Get_Cursor (*p); + break; + case T_WINDOW: + break; + case T_MASK: + *(long *)rp->slot = Symbols_To_Bits (*p, 1, rp->syms); + break; + case T_SYM: + *(int *)rp->slot = (int)Symbols_To_Bits (*p, 0, rp->syms); + break; + default: + Panic ("vector->record"); + } + mask |= rp->mask; + } + return mask; +} + +Object Record_To_Vector (rp, len, sym, dpy, flags) Object sym; + register RECORD *rp; Display *dpy; unsigned long flags; { + register i; + Object v, x; + GC_Node2; + + v = Null; + GC_Link2 (sym, v); + v = Make_Vector (len, Null); + VECTOR(v)->data[0] = sym; + for (i = 1; rp->slot; i++, rp++) { + if (rp->type == T_NONE) + continue; + if (rp->mask && !(flags & rp->mask)) + continue; + x = Null; + switch (rp->type) { + case T_INT: + x = Make_Integer (*(int *)rp->slot); break; + case T_SHORT: + x = Make_Integer (*(short *)rp->slot); break; + case T_CHAR: + x = Make_Integer (*(char *)rp->slot); break; + case T_PIXEL: + x = Make_Pixel (*(unsigned long *)rp->slot); break; + case T_PIXMAP: + if (*(unsigned long *)rp->slot == ~0L) + x = Sym_None; + else + x = Make_Pixmap_Foreign (dpy, *(Pixmap *)rp->slot); + break; + case T_FONT: + if (*(unsigned long *)rp->slot == ~0L) + x = Sym_None; + else { + register XFontStruct *info; + Disable_Interrupts; + info = XQueryFont (dpy, *(Font *)rp->slot); + Enable_Interrupts; + x = Make_Font_Foreign (dpy, False, *(Font *)rp->slot, info); + } + break; + case T_BOOL: + x = *(Bool *)rp->slot ? True : False; break; + case T_COLORMAP: + x = Make_Colormap (0, dpy, *(Colormap *)rp->slot); break; + case T_WINDOW: + x = Make_Window (0, dpy, *(Window *)rp->slot); break; + case T_MASK: + x = Bits_To_Symbols (*(long *)rp->slot, 1, rp->syms); + break; + case T_SYM: + x = Bits_To_Symbols ((unsigned long)*(int *)rp->slot, 0, rp->syms); + break; + default: + Panic ("record->vector"); + } + VECTOR(v)->data[i] = x; + } + GC_Unlink; + return v; +} + +SYMDESCR Func_Syms[] = { + { "clear", GXclear }, + { "and", GXand }, + { "and-reverse", GXandReverse }, + { "copy", GXcopy }, + { "and-inverted", GXandInverted }, + { "no-op", GXnoop }, + { "xor", GXxor }, + { "or", GXor }, + { "nor", GXnor }, + { "equiv", GXequiv }, + { "invert", GXinvert }, + { "or-reverse", GXorReverse }, + { "copy-inverted", GXcopyInverted }, + { "or-inverted", GXorInverted }, + { "nand", GXnand }, + { "set", GXset }, + { 0, 0 } +}; + +SYMDESCR Bit_Grav_Syms[] = { + { "forget", ForgetGravity }, + { "north-west", NorthWestGravity }, + { "north", NorthGravity }, + { "north-east", NorthEastGravity }, + { "west", WestGravity }, + { "center", CenterGravity }, + { "east", EastGravity }, + { "south-west", SouthWestGravity }, + { "south", SouthGravity }, + { "south-east", SouthEastGravity }, + { "static", StaticGravity }, + { 0, 0 } +}; + +SYMDESCR Grav_Syms[] = { + { "unmap", UnmapGravity }, + { "north-west", NorthWestGravity }, + { "north", NorthGravity }, + { "north-east", NorthEastGravity }, + { "west", WestGravity }, + { "center", CenterGravity }, + { "east", EastGravity }, + { "south-west", SouthWestGravity }, + { "south", SouthGravity }, + { "south-east", SouthEastGravity }, + { "static", StaticGravity }, + { 0, 0 } +}; + +SYMDESCR Backing_Store_Syms[] = { + { "not-useful", NotUseful }, + { "when-mapped", WhenMapped }, + { "always", Always }, + { 0, 0 } +}; + +SYMDESCR Stack_Mode_Syms[] = { + { "above", Above }, + { "below", Below }, + { "top-if", TopIf }, + { "bottom-if", BottomIf }, + { "opposite", Opposite }, + { 0, 0 } +}; + +SYMDESCR Line_Style_Syms[] = { + { "solid", LineSolid }, + { "dash", LineOnOffDash }, + { "double-dash", LineDoubleDash }, + { 0, 0 } +}; + +SYMDESCR Cap_Style_Syms[] = { + { "not-last", CapNotLast }, + { "butt", CapButt }, + { "round", CapRound }, + { "projecting", CapProjecting }, + { 0, 0 } +}; + +SYMDESCR Join_Style_Syms[] = { + { "miter", JoinMiter }, + { "round", JoinRound }, + { "bevel", JoinBevel }, + { 0, 0 } +}; + +SYMDESCR Fill_Style_Syms[] = { + { "solid", FillSolid }, + { "tiled", FillTiled }, + { "stippled", FillStippled }, + { "opaque-stippled", FillOpaqueStippled }, + { 0, 0 } +}; + +SYMDESCR Fill_Rule_Syms[] = { + { "even-odd", EvenOddRule }, + { "winding", WindingRule }, + { 0, 0 } +}; + +SYMDESCR Arc_Mode_Syms[] = { + { "chord", ArcChord }, + { "pie-slice", ArcPieSlice }, + { 0, 0 } +}; + +SYMDESCR Subwin_Mode_Syms[] = { + { "clip-by-children", ClipByChildren }, + { "include-inferiors", IncludeInferiors }, + { 0, 0 } +}; + +SYMDESCR Class_Syms[] = { + { "input-output", InputOutput }, + { "input-only", InputOnly }, + { 0, 0 } +}; + +SYMDESCR Map_State_Syms[] = { + { "unmapped", IsUnmapped }, + { "unviewable", IsUnviewable }, + { "viewable", IsViewable }, + { 0, 0 } +}; + +SYMDESCR State_Syms[] = { + { "shift", ShiftMask }, + { "lock", LockMask }, + { "control", ControlMask }, + { "mod1", Mod1Mask }, + { "mod2", Mod2Mask }, + { "mod3", Mod3Mask }, + { "mod4", Mod4Mask }, + { "mod5", Mod5Mask }, + { "button1", Button1Mask }, + { "button2", Button2Mask }, + { "button3", Button3Mask }, + { "button4", Button4Mask }, + { "button5", Button5Mask }, + { "any-modifier", AnyModifier }, + { 0, 0 } +}; + +SYMDESCR Button_Syms[] = { + { "any-button", AnyButton }, + { "button1", Button1 }, + { "button2", Button2 }, + { "button3", Button3 }, + { "button4", Button4 }, + { "button5", Button5 }, + { 0, 0 } +}; + +SYMDESCR Cross_Mode_Syms[] = { + { "normal", NotifyNormal }, + { "grab", NotifyGrab }, + { "ungrab", NotifyUngrab }, + { 0, 0 } +}; + +SYMDESCR Cross_Detail_Syms[] = { + { "ancestor", NotifyAncestor }, + { "virtual", NotifyVirtual }, + { "inferior", NotifyInferior }, + { "nonlinear", NotifyNonlinear }, + { "nonlinear-virtual", NotifyNonlinearVirtual }, + { 0, 0 } +}; + +SYMDESCR Focus_Detail_Syms[] = { + { "ancestor", NotifyAncestor }, + { "virtual", NotifyVirtual }, + { "inferior", NotifyInferior }, + { "nonlinear", NotifyNonlinear }, + { "nonlinear-virtual", NotifyNonlinearVirtual }, + { "pointer", NotifyPointer }, + { "pointer-root", NotifyPointerRoot }, + { "none", NotifyDetailNone }, + { 0, 0 } +}; + +SYMDESCR Visibility_Syms[] = { + { "unobscured", VisibilityUnobscured }, + { "partially-obscured", VisibilityPartiallyObscured }, + { "fully-obscured", VisibilityFullyObscured }, + { 0, 0 } +}; + +SYMDESCR Place_Syms[] = { + { "top", PlaceOnTop }, + { "bottom", PlaceOnBottom }, + { 0, 0 } +}; + +SYMDESCR Prop_Syms[] = { + { "new-value", PropertyNewValue }, + { "deleted", PropertyDelete }, + { 0, 0 } +}; + +SYMDESCR Mapping_Syms[] = { + { "modifier", MappingModifier }, + { "keyboard", MappingKeyboard }, + { "pointer", MappingPointer }, + { 0, 0 } +}; + +SYMDESCR Direction_Syms[] = { + { "left-to-right", FontLeftToRight }, + { "right-to-left", FontRightToLeft }, + { 0, 0 } +}; + +SYMDESCR Polyshape_Syms[] = { + { "complex", Complex }, + { "non-convex", Nonconvex }, + { "convex", Convex }, + { 0, 0 } +}; + +SYMDESCR Propmode_Syms[] = { + { "replace", PropModeReplace }, + { "prepend", PropModePrepend }, + { "append", PropModeAppend }, + { 0, 0 } +}; + +SYMDESCR Grabstatus_Syms[] = { + { "success", Success }, + { "not-viewable", GrabNotViewable }, + { "already-grabbed", AlreadyGrabbed }, + { "frozen", GrabFrozen }, + { "invalid-time", GrabInvalidTime }, + { 0, 0 } +}; + +SYMDESCR Bitmapstatus_Syms[] = { + { "success", BitmapSuccess }, + { "open-failed", BitmapOpenFailed }, + { "file-invalid", BitmapFileInvalid }, + { "no-memory", BitmapNoMemory }, + { 0, 0 } +}; + +SYMDESCR Circulate_Syms[] = { + { "raise-lowest", RaiseLowest }, + { "lower-highest", LowerHighest }, + { 0, 0 } +}; + +SYMDESCR Allow_Events_Syms[] = { + { "async-pointer", AsyncPointer }, + { "sync-pointer", SyncPointer }, + { "replay-pointer", ReplayPointer }, + { "async-keyboard", AsyncKeyboard }, + { "sync-keyboard", SyncKeyboard }, + { "replay-keyboard", ReplayKeyboard }, + { "async-both", AsyncBoth }, + { "sync-both", SyncBoth }, + { 0, 0 } +}; + +SYMDESCR Revert_Syms[] = { + { "none", RevertToNone }, + { "pointer-root", RevertToPointerRoot }, + { "parent", RevertToParent }, + { 0, 0 } +}; + +SYMDESCR Shape_Syms[] = { + { "cursor", CursorShape }, + { "tile", TileShape }, + { "stipple", StippleShape }, + { 0, 0 } +}; + +SYMDESCR Initial_State_Syms[] = { + { "dont-care", DontCareState }, + { "normal", NormalState }, + { "zoom", ZoomState }, + { "iconic", IconicState }, + { "inactive", InactiveState }, + { 0, 0 } +}; + +SYMDESCR Ordering_Syms[] = { + { "unsorted", Unsorted }, + { "y-sorted", YSorted }, + { "yx-sorted", YXSorted }, + { "yx-banded", YXBanded }, + { 0, 0 } +}; + +SYMDESCR Byte_Order_Syms[] = { + { "lsb-first", LSBFirst }, + { "msb-first", MSBFirst }, + { 0, 0 } +}; + +SYMDESCR Saveset_Syms[] = { + { "insert", SetModeInsert }, + { "delete", SetModeDelete }, + { 0, 0 } +}; + +SYMDESCR Closemode_Syms[] = { + { "destroy-all", DestroyAll }, + { "retain-permanent", RetainPermanent }, + { "retain-temporary", RetainTemporary }, + { 0, 0 } +}; + +SYMDESCR Event_Syms[] = { + { "key-press", KeyPressMask }, + { "key-release", KeyReleaseMask }, + { "button-press", ButtonPressMask }, + { "button-release", ButtonReleaseMask }, + { "enter-window", EnterWindowMask }, + { "leave-window", LeaveWindowMask }, + { "pointer-motion", PointerMotionMask }, + { "pointer-motion-hint", PointerMotionHintMask }, + { "button-1-motion", Button1MotionMask }, + { "button-2-motion", Button2MotionMask }, + { "button-3-motion", Button3MotionMask }, + { "button-4-motion", Button4MotionMask }, + { "button-5-motion", Button5MotionMask }, + { "button-motion", ButtonMotionMask }, + { "keymap-state", KeymapStateMask }, + { "exposure", ExposureMask }, + { "visibility-change", VisibilityChangeMask }, + { "structure-notify", StructureNotifyMask }, + { "resize-redirect", ResizeRedirectMask }, + { "substructure-notify", SubstructureNotifyMask }, + { "substructure-redirect", SubstructureRedirectMask }, + { "focus-change", FocusChangeMask }, + { "property-change", PropertyChangeMask }, + { "colormap-change", ColormapChangeMask }, + { "owner-grab-button", OwnerGrabButtonMask }, + { "all-events", ~(unsigned long)0 }, + { 0, 0 } +}; + +SYMDESCR Error_Syms[] = { + { "bad-request", BadRequest }, + { "bad-value", BadValue }, + { "bad-window", BadWindow }, + { "bad-pixmap", BadPixmap }, + { "bad-atom", BadAtom }, + { "bad-cursor", BadCursor }, + { "bad-font", BadFont }, + { "bad-match", BadMatch }, + { "bad-drawable", BadDrawable }, + { "bad-access", BadAccess }, + { "bad-alloc", BadAlloc }, + { "bad-color", BadColor }, + { "bad-gcontext", BadGC }, + { "bad-id-choice", BadIDChoice }, + { "bad-name", BadName }, + { "bad-length", BadLength }, + { "bad-implementation", BadImplementation }, + { 0, 0 } +}; + +static Init_Record (rec, size, name, var) RECORD *rec; char *name; + Object *var; { + Object list, tail, cell; + register i; + char buf[128]; + GC_Node2; + + GC_Link2 (list, tail); + for (list = tail = Null, i = 1; i < size; tail = cell, i++, rec++) { + cell = Intern (rec->name); + cell = Cons (cell, Make_Integer (i)); + cell = Cons (cell, Null); + if (Nullp (list)) + list = cell; + else + P_Set_Cdr (tail, cell); + } + sprintf (buf, "%s-slots", name); + Define_Variable (var, buf, list); + GC_Unlink; +} + +elk_init_xlib_type () { + Init_Record (Set_Attr_Rec, Set_Attr_Size, "set-window-attributes", + &Set_Attr_Slots); + Init_Record (Conf_Rec, Conf_Size, "window-configuration", &Conf_Slots); + Init_Record (GC_Rec, GC_Size, "gcontext", &GC_Slots); + Init_Record (Geometry_Rec, Geometry_Size, "geometry", &Geometry_Slots); + Init_Record (Win_Attr_Rec, Win_Attr_Size, "get-window-attributes", + &Win_Attr_Slots); + Init_Record (Font_Info_Rec, Font_Info_Size, "font-info", &Font_Info_Slots); + Init_Record (Char_Info_Rec, Char_Info_Size, "char-info", &Char_Info_Slots); + Init_Record (Wm_Hints_Rec, Wm_Hints_Size, "wm-hints", &Wm_Hints_Slots); + Init_Record (Size_Hints_Rec, Size_Hints_Size, "size-hints", + &Size_Hints_Slots); + Define_Symbol (&Sym_Parent_Relative, "parent-relative"); + Define_Symbol (&Sym_Copy_From_Parent, "copy-from-parent"); +} diff --git a/lib/xlib/util.c b/lib/xlib/util.c new file mode 100644 index 0000000..4107cad --- /dev/null +++ b/lib/xlib/util.c @@ -0,0 +1,54 @@ +#include "xlib.h" + +static Object P_Get_Default (d, program, option) Object d, program, option; { + register char *ret; + + Check_Type (d, T_Display); + if (ret = XGetDefault (DISPLAY(d)->dpy, Get_Strsym (program), + Get_Strsym (option))) + return Make_String (ret, strlen (ret)); + return False; +} + +static Object P_Resource_Manager_String (d) Object d; { + register char *ret; + + Check_Type (d, T_Display); + ret = XResourceManagerString (DISPLAY(d)->dpy); + return ret ? Make_String (ret, strlen (ret)) : False; +} + +static Object P_Parse_Geometry (string) Object string; { + Object ret, t; + register mask; + int x, y; + unsigned w, h; + + mask = XParseGeometry (Get_Strsym (string), &x, &y, &w, &h); + t = ret = P_Make_List (Make_Integer (6), False); + if (mask & XNegative) Car (t) = True; t = Cdr (t); + if (mask & YNegative) Car (t) = True; t = Cdr (t); + if (mask & XValue) Car (t) = Make_Integer (x); t = Cdr (t); + if (mask & YValue) Car (t) = Make_Integer (y); t = Cdr (t); + if (mask & WidthValue) Car (t) = Make_Unsigned (w); t = Cdr (t); + if (mask & HeightValue) Car (t) = Make_Unsigned (h); + return ret; +} + +static Object P_Parse_Color (d, cmap, spec) Object d, cmap, spec; { + XColor ret; + + Check_Type (d, T_Display); + if (XParseColor (DISPLAY(d)->dpy, Get_Colormap (cmap), Get_Strsym (spec), + &ret)) + return Make_Color (ret.red, ret.green, ret.blue); + return False; +} + +elk_init_xlib_util () { + Define_Primitive (P_Get_Default, "get-default", 3, 3, EVAL); + Define_Primitive (P_Resource_Manager_String, + "resource-manager-string", 1, 1, EVAL); + Define_Primitive (P_Parse_Geometry, "parse-geometry", 1, 1, EVAL); + Define_Primitive (P_Parse_Color, "parse-color", 3, 3, EVAL); +} diff --git a/lib/xlib/window.c b/lib/xlib/window.c new file mode 100644 index 0000000..de02e8d --- /dev/null +++ b/lib/xlib/window.c @@ -0,0 +1,262 @@ +#include "xlib.h" + +static Object Sym_Set_Attr, Sym_Get_Attr, Sym_Geo; +Object Sym_Conf; + +Generic_Predicate (Window) + +Generic_Equal_Dpy (Window, WINDOW, win) + +Generic_Print (Window, "#[window %lu]", WINDOW(x)->win) + +Generic_Get_Display (Window, WINDOW) + +Object Make_Window (finalize, dpy, win) Display *dpy; Window win; { + Object w; + + if (win == None) + return Sym_None; + if (win == PointerRoot) + return Intern ("pointer-root"); + w = Find_Object (T_Window, (GENERIC)dpy, Match_X_Obj, win); + if (Nullp (w)) { + w = Alloc_Object (sizeof (struct S_Window), T_Window, 0); + WINDOW(w)->tag = Null; + WINDOW(w)->win = win; + WINDOW(w)->dpy = dpy; + WINDOW(w)->free = 0; + WINDOW(w)->finalize = finalize; + Register_Object (w, (GENERIC)dpy, finalize ? P_Destroy_Window : + (PFO)0, 0); + } + return w; +} + +Window Get_Window (w) Object w; { + if (EQ(w, Sym_None)) + return None; + Check_Type (w, T_Window); + return WINDOW(w)->win; +} + +Drawable Get_Drawable (d, dpyp) Object d; Display **dpyp; { + if (TYPE(d) == T_Window) { + *dpyp = WINDOW(d)->dpy; + return (Drawable)WINDOW(d)->win; + } else if (TYPE(d) == T_Pixmap) { + *dpyp = PIXMAP(d)->dpy; + return (Drawable)PIXMAP(d)->pm; + } + Wrong_Type_Combination (d, "drawable"); + /*NOTREACHED*/ +} + +static Object P_Create_Window (parent, x, y, width, height, border_width, attr) + Object parent, x, y, width, height, border_width, attr; { + unsigned long mask; + Window win; + + Check_Type (parent, T_Window); + mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec); + if ((win = XCreateWindow (WINDOW(parent)->dpy, WINDOW(parent)->win, + Get_Integer (x), Get_Integer (y), Get_Integer (width), + Get_Integer (height), Get_Integer (border_width), + CopyFromParent, CopyFromParent, CopyFromParent, mask, &SWA)) == 0) + Primitive_Error ("cannot create window"); + return Make_Window (1, WINDOW(parent)->dpy, win); +} + +static Object P_Configure_Window (w, conf) Object w, conf; { + unsigned long mask; + + Check_Type (w, T_Window); + mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec); + XConfigureWindow (WINDOW(w)->dpy, WINDOW(w)->win, mask, &WC); + return Void; +} + +static Object P_Change_Window_Attributes (w, attr) Object w, attr; { + unsigned long mask; + + Check_Type (w, T_Window); + mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec); + XChangeWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, mask, &SWA); + return Void; +} + +static Object P_Get_Window_Attributes (w) Object w; { + Check_Type (w, T_Window); + XGetWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, &WA); + return Record_To_Vector (Win_Attr_Rec, Win_Attr_Size, Sym_Get_Attr, + WINDOW(w)->dpy, ~0L); +} + +static Object P_Get_Geometry (d) Object d; { + Display *dpy; + Drawable dr = Get_Drawable (d, &dpy); + + /* GEO.width, GEO.height, etc. should really be unsigned, not int. + */ + XGetGeometry (dpy, dr, &GEO.root, &GEO.x, &GEO.y, (unsigned *)&GEO.width, + (unsigned *)&GEO.height, (unsigned *)&GEO.border_width, + (unsigned *)&GEO.depth); + return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L); +} + +static Object P_Map_Window (w) Object w; { + Check_Type (w, T_Window); + XMapWindow (WINDOW(w)->dpy, WINDOW(w)->win); + return Void; +} + +static Object P_Unmap_Window (w) Object w; { + Check_Type (w, T_Window); + XUnmapWindow (WINDOW(w)->dpy, WINDOW(w)->win); + return Void; +} + +Object P_Destroy_Window (w) Object w; { + Check_Type (w, T_Window); + if (!WINDOW(w)->free) + XDestroyWindow (WINDOW(w)->dpy, WINDOW(w)->win); + Deregister_Object (w); + WINDOW(w)->free = 1; + return Void; +} + +static Object P_Destroy_Subwindows (w) Object w; { + Check_Type (w, T_Window); + XDestroySubwindows (WINDOW(w)->dpy, WINDOW(w)->win); + return Void; +} + +static Object P_Map_Subwindows (w) Object w; { + Check_Type (w, T_Window); + XMapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win); + return Void; +} + +static Object P_Unmap_Subwindows (w) Object w; { + Check_Type (w, T_Window); + XUnmapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win); + return Void; +} + +static Object P_Circulate_Subwindows (w, dir) Object w, dir; { + Check_Type (w, T_Window); + XCirculateSubwindows (WINDOW(w)->dpy, WINDOW(w)->win, + Symbols_To_Bits (dir, 0, Circulate_Syms)); + return Void; +} + +static Object P_Query_Tree (w) Object w; { + Window root, parent, *children; + Display *dpy; + int i; + unsigned n; + Object v, ret; + GC_Node2; + + Check_Type (w, T_Window); + dpy = WINDOW(w)->dpy; + Disable_Interrupts; + XQueryTree (dpy, WINDOW(w)->win, &root, &parent, &children, &n); + Enable_Interrupts; + v = ret = Null; + GC_Link2 (v, ret); + v = Make_Window (0, dpy, root); + ret = Cons (v, Null); + v = Make_Window (0, dpy, parent); + ret = Cons (v, ret); + v = Make_Vector (n, Null); + for (i = 0; i < n; i++) { + Object x; + + x = Make_Window (0, dpy, children[i]); + VECTOR(v)->data[i] = x; + } + ret = Cons (v, ret); + GC_Unlink; + return ret; +} + +static Object P_Translate_Coordinates (src, x, y, dst) Object src, x, y, dst; { + int rx, ry; + Window child; + Object l, t, z; + GC_Node3; + + Check_Type (src, T_Window); + Check_Type (dst, T_Window); + if (!XTranslateCoordinates (WINDOW(src)->dpy, WINDOW(src)->win, + WINDOW(dst)->win, Get_Integer (x), Get_Integer (y), &rx, &ry, + &child)) + return False; + l = t = P_Make_List (Make_Integer (3), Null); + GC_Link3 (l, t, dst); + Car (t) = Make_Integer (rx); t = Cdr (t); + Car (t) = Make_Integer (ry), t = Cdr (t); + z = Make_Window (0, WINDOW(dst)->dpy, child); + Car (t) = z; + GC_Unlink; + return l; +} + +static Object P_Query_Pointer (win) Object win; { + Object l, t, z; + Bool ret; + Window root, child; + int r_x, r_y, x, y; + unsigned int mask; + GC_Node3; + + Check_Type (win, T_Window); + ret = XQueryPointer (WINDOW(win)->dpy, WINDOW(win)->win, &root, &child, + &r_x, &r_y, &x, &y, &mask); + t = l = P_Make_List (Make_Integer (8), Null); + GC_Link3 (l, t, win); + Car (t) = Make_Integer (x); t = Cdr (t); + Car (t) = Make_Integer (y); t = Cdr (t); + Car (t) = ret ? True : False; t = Cdr (t); + z = Make_Window (0, WINDOW(win)->dpy, root); + Car (t) = z; t = Cdr (t); + Car (t) = Make_Integer (r_x); t = Cdr (t); + Car (t) = Make_Integer (r_y); t = Cdr (t); + z = Make_Window (0, WINDOW(win)->dpy, child); + Car (t) = z; t = Cdr (t); + z = Bits_To_Symbols ((unsigned long)mask, 1, State_Syms); + Car (t) = z; + GC_Unlink; + return l; +} + +elk_init_xlib_window () { + Define_Symbol (&Sym_Set_Attr, "set-window-attributes"); + Define_Symbol (&Sym_Get_Attr, "get-window-attributes"); + Define_Symbol (&Sym_Conf, "window-configuration"); + Define_Symbol (&Sym_Geo, "geometry"); + Generic_Define (Window, "window", "window?"); + Define_Primitive (P_Window_Display, "window-display", 1, 1, EVAL); + Define_Primitive (P_Create_Window, + "xlib-create-window", 7, 7, EVAL); + Define_Primitive (P_Configure_Window, + "xlib-configure-window", 2, 2, EVAL); + Define_Primitive (P_Change_Window_Attributes, + "xlib-change-window-attributes", 2, 2, EVAL); + Define_Primitive (P_Get_Window_Attributes, + "xlib-get-window-attributes", 1, 1, EVAL); + Define_Primitive (P_Get_Geometry, "xlib-get-geometry",1, 1, EVAL); + Define_Primitive (P_Map_Window, "map-window", 1, 1, EVAL); + Define_Primitive (P_Unmap_Window, "unmap-window", 1, 1, EVAL); + Define_Primitive (P_Circulate_Subwindows, + "circulate-subwindows", 2, 2, EVAL); + Define_Primitive (P_Destroy_Window, "destroy-window", 1, 1, EVAL); + Define_Primitive (P_Destroy_Subwindows, + "destroy-subwindows", 1, 1, EVAL); + Define_Primitive (P_Map_Subwindows, "map-subwindows", 1, 1, EVAL); + Define_Primitive (P_Unmap_Subwindows, "unmap-subwindows", 1, 1, EVAL); + Define_Primitive (P_Query_Tree, "query-tree", 1, 1, EVAL); + Define_Primitive (P_Translate_Coordinates, + "translate-coordinates", 4, 4, EVAL); + Define_Primitive (P_Query_Pointer, "query-pointer", 1, 1, EVAL); +} diff --git a/lib/xlib/wm.c b/lib/xlib/wm.c new file mode 100644 index 0000000..e26e963 --- /dev/null +++ b/lib/xlib/wm.c @@ -0,0 +1,172 @@ +#include "xlib.h" + +static Object Sym_Pointer_Root; + +static Object P_Reparent_Window (w, parent, x, y) Object w, parent, x, y; { + Check_Type (w, T_Window); + Check_Type (parent, T_Window); + XReparentWindow (WINDOW(w)->dpy, WINDOW(w)->win, WINDOW(parent)->win, + Get_Integer (x), Get_Integer (y)); + return Void; +} + +static Object P_Install_Colormap (c) Object c; { + Check_Type (c, T_Colormap); + XInstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm); + return Void; +} + +static Object P_Uninstall_Colormap (c) Object c; { + Check_Type (c, T_Colormap); + XUninstallColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm); + return Void; +} + +static Object P_List_Installed_Colormaps (w) Object w; { + int i, n; + Colormap *ret; + Object v; + GC_Node; + + Check_Type (w, T_Window); + ret = XListInstalledColormaps (WINDOW(w)->dpy, WINDOW(w)->win, &n); + v = Make_Vector (n, Null); + GC_Link (v); + for (i = 0; i < n; i++) { + Object c; + + c = Make_Colormap (0, WINDOW(w)->dpy, ret[i]); + VECTOR(v)->data[i] = c; + } + XFree ((char *)ret); + GC_Unlink; + return v; +} + +static Object P_Set_Input_Focus (d, win, revert_to, time) Object d, win, + revert_to, time; { + Window focus = PointerRoot; + + Check_Type (d, T_Display); + if (!EQ(win, Sym_Pointer_Root)) + focus = Get_Window (win); + XSetInputFocus (DISPLAY(d)->dpy, focus, Symbols_To_Bits (revert_to, 0, + Revert_Syms), Get_Time (time)); + return Void; +} + +static Object P_Input_Focus (d) Object d; { + Window win; + int revert_to; + Object ret, x; + GC_Node; + + Check_Type (d, T_Display); + XGetInputFocus (DISPLAY(d)->dpy, &win, &revert_to); + ret = Cons (Null, Null); + GC_Link (ret); + x = Make_Window (0, DISPLAY(d)->dpy, win); + Car (ret) = x; + x = Bits_To_Symbols ((unsigned long)revert_to, 0, Revert_Syms); + Cdr (ret) = x; + GC_Unlink; + return ret; +} + +static Object P_General_Warp_Pointer (dpy, dst, dstx, dsty, src, srcx, srcy, + srcw, srch) Object dpy, dst, dstx, dsty, src, srcx, srcy, srcw, srch; { + Check_Type (dpy, T_Display); + XWarpPointer (DISPLAY(dpy)->dpy, Get_Window (src), Get_Window (dst), + Get_Integer (srcx), Get_Integer (srcy), Get_Integer (srcw), + Get_Integer (srch), Get_Integer (dstx), Get_Integer (dsty)); + return Void; +} + +static Object P_Bell (argc, argv) Object *argv; { + register percent = 0; + + Check_Type (argv[0], T_Display); + if (argc == 2) { + percent = Get_Integer (argv[1]); + if (percent < -100 || percent > 100) + Range_Error (argv[1]); + } + XBell (DISPLAY(argv[0])->dpy, percent); + return Void; +} + +static Object P_Set_Access_Control (dpy, on) Object dpy, on; { + Check_Type (dpy, T_Display); + Check_Type (on, T_Boolean); + XSetAccessControl (DISPLAY(dpy)->dpy, EQ(on, True)); + return Void; +} + +static Object P_Change_Save_Set (win, mode) Object win, mode; { + Check_Type (win, T_Window); + XChangeSaveSet (WINDOW(win)->dpy, WINDOW(win)->win, + Symbols_To_Bits (mode, 0, Saveset_Syms)); + return Void; +} + +static Object P_Set_Close_Down_Mode (dpy, mode) Object dpy, mode; { + Check_Type (dpy, T_Display); + XSetCloseDownMode (DISPLAY(dpy)->dpy, + Symbols_To_Bits (mode, 0, Closemode_Syms)); + return Void; +} + +static Object P_Get_Pointer_Mapping (dpy) Object dpy; { + unsigned char map[256]; + register i, n; + Object ret; + + Check_Type (dpy, T_Display); + n = XGetPointerMapping (DISPLAY(dpy)->dpy, map, 256); + ret = Make_Vector (n, Null); + for (i = 0; i < n; i++) + VECTOR(ret)->data[i] = Make_Integer (map[i]); + return ret; +} + +static Object P_Set_Pointer_Mapping (dpy, map) Object dpy, map; { + register i, n; + register unsigned char *p; + Object ret; + Alloca_Begin; + + Check_Type (dpy, T_Display); + Check_Type (map, T_Vector); + n = VECTOR(map)->size; + Alloca (p, unsigned char*, n); + for (i = 0; i < n; i++) + p[i] = Get_Integer (VECTOR(map)->data[i]); + ret = XSetPointerMapping (DISPLAY(dpy)->dpy, p, n) == MappingSuccess ? + True : False; + Alloca_End; + return ret; +} + +elk_init_xlib_wm () { + Define_Primitive (P_Reparent_Window, "reparent-window", 4, 4, EVAL); + Define_Primitive (P_Install_Colormap, "install-colormap", 1, 1, EVAL); + Define_Primitive (P_Uninstall_Colormap, + "uninstall-colormap", 1, 1, EVAL); + Define_Primitive (P_List_Installed_Colormaps, + "list-installed-colormaps", 1, 1, EVAL); + Define_Primitive (P_Set_Input_Focus, "set-input-focus", 4, 4, EVAL); + Define_Primitive (P_Input_Focus, "input-focus", 1, 1, EVAL); + Define_Primitive (P_General_Warp_Pointer, + "general-warp-pointer", 9, 9, EVAL); + Define_Primitive (P_Bell, "bell", 1, 2, VARARGS); + Define_Primitive (P_Set_Access_Control, + "set-access-control", 2, 2, EVAL); + Define_Primitive (P_Change_Save_Set, "change-save-set", 2, 2, EVAL); + Define_Primitive (P_Set_Close_Down_Mode, + "set-close-down-mode", 2, 2, EVAL); + Define_Primitive (P_Get_Pointer_Mapping, + "get-pointer-mapping", 1, 1, EVAL); + Define_Primitive (P_Set_Pointer_Mapping, + "set-pointer-mapping", 2, 2, EVAL); + Define_Symbol(&Sym_Pointer_Root, "pointer-root"); +} diff --git a/lib/xlib/xlib.h b/lib/xlib/xlib.h new file mode 100644 index 0000000..41b5958 --- /dev/null +++ b/lib/xlib/xlib.h @@ -0,0 +1,287 @@ +#include +#include +#include + +#undef True +#undef False + +#ifndef NeedFunctionPrototypes /* Kludge */ + #error "X11 Release 3 (or earlier) no longer supported" +#endif + +#if XlibSpecificationRelease >= 5 +# define XLIB_RELEASE_5_OR_LATER +#endif + +#if XlibSpecificationRelease >= 6 +# define XLIB_RELEASE_6_OR_LATER +#endif + +#include "scheme.h" + +extern int T_Display; +extern int T_Gc; +extern int T_Pixel; +extern int T_Pixmap; +extern int T_Window; +extern int T_Font; +extern int T_Colormap; +extern int T_Color; +extern int T_Cursor; +extern int T_Atom; + +#define DISPLAY(x) ((struct S_Display *)POINTER(x)) +#define GCONTEXT(x) ((struct S_Gc *)POINTER(x)) +#define PIXEL(x) ((struct S_Pixel *)POINTER(x)) +#define PIXMAP(x) ((struct S_Pixmap *)POINTER(x)) +#define WINDOW(x) ((struct S_Window *)POINTER(x)) +#define FONT(x) ((struct S_Font *)POINTER(x)) +#define COLORMAP(x) ((struct S_Colormap *)POINTER(x)) +#define COLOR(x) ((struct S_Color *)POINTER(x)) +#define CURSOR(x) ((struct S_Cursor *)POINTER(x)) +#define ATOM(x) ((struct S_Atom *)POINTER(x)) + +struct S_Display { + Object after; + Display *dpy; + char free; +}; + +struct S_Gc { + Object tag; + GC gc; + Display *dpy; + char free; +}; + +struct S_Pixel { + Object tag; + unsigned long pix; +}; + +struct S_Pixmap { + Object tag; + Pixmap pm; + Display *dpy; + char free; +}; + +struct S_Window { + Object tag; + Window win; + Display *dpy; + char free; + char finalize; +}; + +struct S_Font { + Object name; + Font id; + XFontStruct *info; + Display *dpy; +}; + +struct S_Colormap { + Object tag; + Colormap cm; + Display *dpy; + char free; +}; + +struct S_Color { + Object tag; + XColor c; +}; + +struct S_Cursor { + Object tag; + Cursor cursor; + Display *dpy; + char free; +}; + +struct S_Atom { + Object tag; + Atom atom; +}; + +enum Type { + T_NONE, + T_INT, T_CHAR, T_PIXEL, T_PIXMAP, T_BOOL, T_FONT, T_COLORMAP, T_CURSOR, + T_WINDOW, T_MASK, T_SYM, T_SHORT, T_BACKGROUND, T_BORDER +}; + +typedef struct { + char *slot; + char *name; + enum Type type; + SYMDESCR *syms; + int mask; +} RECORD; + +typedef struct { + Window root; + int x, y, width, height, border_width, depth; +} GEOMETRY; + +C_LINKAGE_BEGIN + +extern Colormap Get_Colormap P_((Object)); +extern Cursor Get_Cursor P_((Object)); +extern Drawable Get_Drawable P_((Object, Display**)); +extern Font Get_Font P_((Object)); +extern int Get_Screen_Number P_((Display*, Object)); +extern Object Get_Event_Args P_((XEvent*)); +extern Pixmap Get_Pixmap P_((Object)); +extern Time Get_Time P_((Object)); +extern Window Get_Window P_((Object)); +extern XColor *Get_Color P_((Object)); +extern unsigned long Get_Pixel P_((Object)); +extern void Destroy_Event_Args P_((Object)); +extern int Encode_Event P_((Object)); +extern int Match_X_Obj P_((ELLIPSIS)); +extern void Open_Font_Maybe P_((Object)); +extern Object Make_Atom P_((Atom)); +extern Object Make_Color P_((unsigned int, unsigned int, unsigned int)); +extern Object Make_Colormap P_((int, Display*, Colormap)); +extern Object Make_Cursor P_((Display*, Cursor)); +extern Object Make_Cursor_Foreign P_((Display*, Cursor)); +extern Object Make_Display P_((int, Display*)); +extern Object Make_Font P_((Display*, Object, Font, XFontStruct*)); +extern Object Make_Font_Foreign P_((Display*, Object, Font, XFontStruct*)); +extern Object Make_Gc P_((int, Display*, GC)); +extern Object Make_Pixel P_((unsigned long)); +extern Object Make_Pixmap P_((Display*, Pixmap)); +extern Object Make_Pixmap_Foreign P_((Display*, Pixmap)); +extern Object Make_Window P_((int, Display*, Window)); +extern Object P_Close_Display P_((Object)); +extern Object P_Close_Font P_((Object)); +extern Object P_Destroy_Window P_((Object)); +extern Object P_Free_Colormap P_((Object)); +extern Object P_Free_Cursor P_((Object)); +extern Object P_Free_Gc P_((Object)); +extern Object P_Free_Pixmap P_((Object)); +extern Object P_Window_Unique_Id P_((Object)); +extern Object Record_To_Vector + P_((RECORD*, int, Object, Display*, unsigned long)); +extern unsigned long Vector_To_Record P_((Object, int, Object, RECORD*)); + +C_LINKAGE_END + +extern XSetWindowAttributes SWA; +extern XWindowChanges WC; +extern XGCValues GCV; +extern GEOMETRY GEO; +extern XWindowAttributes WA; +extern XFontStruct FI; +extern XCharStruct CI; +extern XWMHints WMH; +extern XSizeHints SZH; + +extern Set_Attr_Size, Conf_Size, GC_Size, Geometry_Size, Win_Attr_Size, + Font_Info_Size, Char_Info_Size, Wm_Hints_Size, Size_Hints_Size; +extern RECORD Set_Attr_Rec[], Conf_Rec[], GC_Rec[], Geometry_Rec[], + Win_Attr_Rec[], Font_Info_Rec[], Char_Info_Rec[], Wm_Hints_Rec[], + Size_Hints_Rec[]; + +extern SYMDESCR Func_Syms[], Bit_Grav_Syms[], Event_Syms[], Error_Syms[], + Grav_Syms[], Backing_Store_Syms[], Class_Syms[], Stack_Mode_Syms[], + Line_Style_Syms[], State_Syms[], Cap_Style_Syms[], Join_Style_Syms[], + Map_State_Syms[], Fill_Style_Syms[], Fill_Rule_Syms[], Arc_Mode_Syms[], + Subwin_Mode_Syms[], Button_Syms[], Cross_Mode_Syms[], Cross_Detail_Syms[], + Focus_Detail_Syms[], Place_Syms[], Visibility_Syms[], Prop_Syms[], + Mapping_Syms[], Direction_Syms[], Shape_Syms[], Propmode_Syms[], + Grabstatus_Syms[], Allow_Events_Syms[], Revert_Syms[], Polyshape_Syms[], + Initial_State_Syms[], Bitmapstatus_Syms[], Circulate_Syms[], + Ordering_Syms[], Byte_Order_Syms[], Saveset_Syms[], Closemode_Syms[]; + +extern Object Sym_None, Sym_Now, Sym_Char_Info, Sym_Conf; + + +#if __STDC__ || defined(ANSI_CPP) +# define conc(a,b) a##b +# define conc3(a,b,c) a##b##c +#else +# define _identity(x) x +# define conc(a,b) _identity(a)b +# define conc3(a,b,c) conc(conc(a,b),c) +#endif + + +/* Generic_Predicate (Pixmap) generates: + * + * int T_Pixmap; + * + * static Object P_Pixmapp (x) Object x; { + * return TYPE(x) == T_Pixmap ? True : False; + * } + */ +#define Generic_Predicate(type) int conc(T_,type);\ +\ +static Object conc3(P_,type,p) (x) Object x; {\ + return TYPE(x) == conc(T_,type) ? True : False;\ +} + +/* Generic_Equal (Pixmap, PIXMAP, pm) generates: + * + * static Pixmap_Equal (x, y) Object x, y; { + * return PIXMAP(x)->pm == PIXMAP(y)->field + * && !PIXMAP(x)->free && !PIXMAP(y)->free; + * } + */ +#define Generic_Equal(type,cast,field) static conc(type,_Equal) (x, y)\ + Object x, y; {\ + return cast(x)->field == cast(y)->field\ + && !cast(x)->free && !cast(y)->free;\ +} + +/* Same as above, but doesn't check for ->free: + */ +#define Generic_Simple_Equal(type,cast,field) static conc(type,_Equal) (x, y)\ + Object x, y; {\ + return cast(x)->field == cast(y)->field;\ +} + +/* Same as above, but also checks ->dpy + */ +#define Generic_Equal_Dpy(type,cast,field) static conc(type,_Equal)\ + (x, y)\ + Object x, y; {\ + return cast(x)->field == cast(y)->field && cast(x)->dpy == cast(y)->dpy\ + && !cast(x)->free && !cast(y)->free;\ +} + +/* Generic_Print (Pixmap, "#[pixmap %u]", PIXMAP(x)->pm) generates: + * + * static Pixmap_Print (x, port, raw, depth, len) Object x, port; { + * Printf (port, "#[pixmap %u]", PIXMAP(x)->pm); + * } + */ +#define Generic_Print(type,fmt,how) static conc(type,_Print)\ + (x, port, raw, depth, len) Object x, port; {\ + Printf (port, fmt, (unsigned)how);\ +} + +/* Generic_Define (Pixmap, "pixmap", "pixmap?") generates: + * + * T_Pixmap = Define_Type (0, "pixmap", NOFUNC, sizeof (struct S_Pixmap), + * Pixmap_Equal, Pixmap_Equal, Pixmap_Print, NOFUNC); + * Define_Primitive (P_Pixmapp, "pixmap?", 1, 1, EVAL); + */ +#define Generic_Define(type,name,pred) conc(T_,type) =\ + Define_Type (0, name, NOFUNC, sizeof (struct conc(S_,type)),\ + conc(type,_Equal), conc(type,_Equal), conc(type,_Print), NOFUNC);\ + Define_Primitive (conc3(P_,type,p), pred, 1, 1, EVAL); + +/* Generic_Get_Display (Pixmap, PIXMAP) generates: + * + * static Object P_Pixmap_Display (x) Object x; { + * Check_Type (x, T_Pixmap); + * return Make_Display (PIXMAP(x)->dpy); + * } + */ +#define Generic_Get_Display(type,cast) static Object conc3(P_,type,_Display)\ + (x) Object x; {\ + Check_Type (x, conc(T_,type));\ + return Make_Display (0, cast(x)->dpy);\ +} diff --git a/lib/xm/ALIASES b/lib/xm/ALIASES new file mode 100644 index 0000000..8717840 --- /dev/null +++ b/lib/xm/ALIASES @@ -0,0 +1,11 @@ +;;; Map widget names that are longer than 12 chars to shorter names +;;; to satisfy stupid System V restriction +;;; (12 chars widget name + '.o' == 14 chars) + +(set! widget-aliases + '((bulletin-board . bulletin-brd) + (cascade-button . cascade-btn) + (file-selection . file-selectn) + (scrolled-window . scrolled-win) + (selection-box . selectn-box) + (toggle-button . toggle-btn))) diff --git a/lib/xm/Makefile b/lib/xm/Makefile new file mode 100644 index 0000000..cd1a7d3 --- /dev/null +++ b/lib/xm/Makefile @@ -0,0 +1,24 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../../config/system ../../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + +lint: Makefile.local + $(MAKE) -f Makefile.local lint + +clean: Makefile.local + $(MAKE) -f Makefile.local clean + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/lib/xm/arrow-button.d b/lib/xm/arrow-button.d new file mode 100644 index 0000000..fc3ca22 --- /dev/null +++ b/lib/xm/arrow-button.d @@ -0,0 +1,14 @@ +;;; -*-Scheme-*- + +(define-widget-type 'arrowbutton '("ArrowB.h" "ArrowBG.h")) + +(define-widget-class 'arrow-button 'xmArrowButtonWidgetClass) +(define-widget-class 'arrow-button-gadget 'xmArrowButtonGadgetClass) + +(define-callback 'arrow-button 'activateCallback #t) +(define-callback 'arrow-button 'armCallback #t) +(define-callback 'arrow-button 'disarmCallback #t) + +(define-callback 'arrow-button-gadget 'activateCallback #t) +(define-callback 'arrow-button-gadget 'armCallback #t) +(define-callback 'arrow-button-gadget 'disarmCallback #t) diff --git a/lib/xm/build b/lib/xm/build new file mode 100755 index 0000000..af54e31 --- /dev/null +++ b/lib/xm/build @@ -0,0 +1,131 @@ +. ../../config/system +. ../../config/site + +sys_incl="$x11_incl $motif_incl" + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +CC= ${cc-cc} +CFLAGS= $cflags $obj_cflags $motif_cflags +LINTFLAGS= $lintflags +SCMFLAGS= -p .:../../scm:../xt + +INC= ../../include + +H= \$(INC)/compat.h\\ + \$(INC)/config.h\\ + \$(INC)/cstring.h\\ + \$(INC)/exception.h\\ + \$(INC)/extern.h\\ + \$(INC)/funcproto.h\\ + \$(INC)/gc.h\\ + \$(INC)/misc.h\\ + \$(INC)/object.h\\ + \$(INC)/param.h\\ + \$(INC)/stkmem.h\\ + \$(INC)/type.h\\ + ../xlib/xlib.h\\ + ../xt/xt.h + +O= arrow-button.o\\ + bulletin-brd.o\\ + cascade-btn.o\\ + command.o\\ + drawing-area.o\\ + drawn-button.o\\ + file-selectn.o\\ + form.o\\ + frame.o\\ + label.o\\ + list.o\\ + main-window.o\\ + message-box.o\\ + paned-window.o\\ + push-button.o\\ + row-column.o\\ + scale.o\\ + scroll-bar.o\\ + scrolled-win.o\\ + selectn-box.o\\ + separator.o\\ + shell.o\\ + support.o\\ + text.o\\ + toggle-btn.o + +WIDGET_SET= xm + +.SUFFIXES: .d .c .o + +.c.o: + \$(CC) \$(CFLAGS) -I\$(INC) -I../xlib $sys_incl -c \$< + ../../scripts/makedl \$@ \$@ + +.d.c: + ../../src/scheme \$(SCMFLAGS) -l mkwidget.scm \$< \$@ \$(WIDGET_SET) + +.d.o: + ../../src/scheme \$(SCMFLAGS) -l mkwidget.scm \$< \$*.c \$(WIDGET_SET) + \$(CC) \$(CFLAGS) -I\$(INC) -I../xlib $sys_incl -c \$*.c + ../../scripts/makedl \$@ \$@ + +all: \$(O) + +arrow-button.o: \$(H) arrow-button.d +bulletin-brd.o: \$(H) bulletin-brd.d +cascade-btn.o: \$(H) cascade-btn.d +command.o: \$(H) command.d +drawing-area.o: \$(H) drawing-area.d +drawn-button.o: \$(H) drawn-button.d +file-selectn.o: \$(H) file-selectn.d +form.o: \$(H) form.d +frame.o: \$(H) frame.d +label.o: \$(H) label.d +list.o: \$(H) list.d +main-window.o: \$(H) main-window.d +message-box.o: \$(H) message-box.d +paned-window.o: \$(H) paned-window.d +push-button.o: \$(H) push-button.d +row-column.o: \$(H) row-column.d +scale.o: \$(H) scale.d +scroll-bar.o: \$(H) scroll-bar.d +scrolled-win.o: \$(H) scrolled-win.d +selectn-box.o: \$(H) selectn-box.d +separator.o: \$(H) separator.d +shell.o: \$(H) shell.d +support.o: \$(H) support.d +text.o: \$(H) text.d +toggle-btn.o: \$(H) toggle-btn.d + +install: \$(O) + -@if [ ! -d $install_dir/runtime ]; then \\ + echo mkdir $install_dir/runtime; \\ + mkdir $install_dir/runtime; \\ + fi + -@if [ ! -d $install_dir/runtime/obj ]; then \\ + echo mkdir $install_dir/runtime/obj; \\ + mkdir $install_dir/runtime/obj; \\ + fi + -@if [ ! -d $install_dir/runtime/obj/xm ]; then \\ + echo mkdir $install_dir/runtime/obj/xm; \\ + mkdir $install_dir/runtime/obj/xm; \\ + fi + @for i in \$(O) ALIASES ;\\ + do \\ + echo cp \$\$i $install_dir/runtime/obj/xm; \\ + cp \$\$i $install_dir/runtime/obj/xm; \\ + done + +lint: + lint \$(LINTFLAGS) -I\$(INC) -I../xlib $sys_incl *.c + +clean: + rm -f *.o *.c core + +distclean: + rm -f *.o *.c core lint.out Makefile.local +EOT diff --git a/lib/xm/bulletin-brd.d b/lib/xm/bulletin-brd.d new file mode 100644 index 0000000..a486e5a --- /dev/null +++ b/lib/xm/bulletin-brd.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'bulletinboard "BulletinB.h") + +(define-widget-class 'bulletin-board 'xmBulletinBoardWidgetClass) diff --git a/lib/xm/cascade-btn.d b/lib/xm/cascade-btn.d new file mode 100644 index 0000000..b72d418 --- /dev/null +++ b/lib/xm/cascade-btn.d @@ -0,0 +1,12 @@ +;;; -*-Scheme-*- + +(define-widget-type 'cascadebutton '("CascadeB.h" "CascadeBG.h")) + +(define-widget-class 'cascade-button 'xmCascadeButtonWidgetClass) +(define-widget-class 'cascade-button-gadget 'xmCascadeButtonGadgetClass) + +(define-callback 'cascade-button 'activateCallback #t) +(define-callback 'cascade-button 'cascadingCallback #t) + +(define-callback 'cascade-button-gadget 'activateCallback #t) +(define-callback 'cascade-button-gadget 'cascadingCallback #t) diff --git a/lib/xm/command.d b/lib/xm/command.d new file mode 100644 index 0000000..47f3810 --- /dev/null +++ b/lib/xm/command.d @@ -0,0 +1,14 @@ +;;; -*-Scheme-*- + +(define-widget-type 'command "Command.h") + +(define-widget-class 'command 'xmCommandWidgetClass) + +(define-callback 'command 'commandChangedCallback #t) +(define-callback 'command 'commandEnteredCallback #t) + +(define command-callback->scheme +" return Get_Selection_CB ((XmCommandCallbackStruct *)x);") + +(c->scheme 'callback:command-commandChangedCallback command-callback->scheme) +(c->scheme 'callback:command-commandEnteredCallback command-callback->scheme) diff --git a/lib/xm/drawing-area.d b/lib/xm/drawing-area.d new file mode 100644 index 0000000..c8f45b2 --- /dev/null +++ b/lib/xm/drawing-area.d @@ -0,0 +1,9 @@ +;;; -*-Scheme-*- + +(define-widget-type 'drawingarea "DrawingA.h") + +(define-widget-class 'drawing-area 'xmDrawingAreaWidgetClass) + +(define-callback 'drawing-area 'exposeCallback #t) +(define-callback 'drawing-area 'inputCallback #t) +(define-callback 'drawing-area 'resizeCallback #t) diff --git a/lib/xm/drawn-button.d b/lib/xm/drawn-button.d new file mode 100644 index 0000000..770e82d --- /dev/null +++ b/lib/xm/drawn-button.d @@ -0,0 +1,11 @@ +;;; -*-Scheme-*- + +(define-widget-type 'drawnbutton "DrawnB.h") + +(define-widget-class 'drawn-button 'xmDrawnButtonWidgetClass) + +(define-callback 'drawn-button 'activateCallback #t) +(define-callback 'drawn-button 'armCallback #t) +(define-callback 'drawn-button 'disarmCallback #t) +(define-callback 'drawn-button 'exposeCallback #t) +(define-callback 'drawn-button 'resizeCallback #t) diff --git a/lib/xm/file-selectn.d b/lib/xm/file-selectn.d new file mode 100644 index 0000000..2205682 --- /dev/null +++ b/lib/xm/file-selectn.d @@ -0,0 +1,11 @@ +;;; -*-Scheme-*- + +(define-widget-type 'fileselection "FileSB.h") + +(define-widget-class 'file-selection 'xmFileSelectionBoxWidgetClass) + +(define-callback 'file-selection 'applyCallback #t) +(define-callback 'file-selection 'cancelCallback #t) +(define-callback 'file-selection 'noMatchCallback #t) +(define-callback 'file-selection 'okCallback #t) +(define-callback 'file-selection 'helpCallback #t) diff --git a/lib/xm/form.d b/lib/xm/form.d new file mode 100644 index 0000000..31b0911 --- /dev/null +++ b/lib/xm/form.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'form "Form.h") + +(define-widget-class 'form 'xmFormWidgetClass) diff --git a/lib/xm/frame.d b/lib/xm/frame.d new file mode 100644 index 0000000..6de17b6 --- /dev/null +++ b/lib/xm/frame.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'frame "Frame.h") + +(define-widget-class 'frame 'xmFrameWidgetClass) diff --git a/lib/xm/label.d b/lib/xm/label.d new file mode 100644 index 0000000..1f4e6b4 --- /dev/null +++ b/lib/xm/label.d @@ -0,0 +1,6 @@ +;;; -*-Scheme-*- + +(define-widget-type 'label '("Label.h" "LabelG.h")) + +(define-widget-class 'label 'xmLabelWidgetClass) +(define-widget-class 'label-gadget 'xmLabelGadgetClass) diff --git a/lib/xm/list.d b/lib/xm/list.d new file mode 100644 index 0000000..0e3752d --- /dev/null +++ b/lib/xm/list.d @@ -0,0 +1,75 @@ +;;; -*-Scheme-*- + +(define-widget-type 'list "List.h") + +(define-widget-class 'list 'xmListWidgetClass) + +(prolog + +"static Object String_Table_To_Scheme (tab, len) XmString *tab; { + Object ret, tail; + char *text; + GC_Node2; + + tail = ret = P_Make_List (Make_Integer (len), Null); + GC_Link2 (ret, tail); + for ( ; len > 0; len--, tail = Cdr (tail)) { + if (!XmStringGetLtoR (*tab++, XmSTRING_DEFAULT_CHARSET, &text)) + text = \"\"; + Car (tail) = Make_String (text, strlen (text)); + } + GC_Unlink; + return ret; +}") + +(prolog + +"static SYMDESCR Type_Syms[] = { + { \"initial\", XmINITIAL }, + { \"modification\", XmMODIFICATION }, + { \"addition\", XmADDITION }, + { 0, 0} +};") + +(prolog + +"static Object Get_List_CB (p) XmListCallbackStruct *p; { + Object ret, s; + char *text; + GC_Node2; + + if (!XmStringGetLtoR (p->item, XmSTRING_DEFAULT_CHARSET, &text)) + text = \"\"; + ret = s = Make_String (text, strlen (text)); + GC_Link2 (ret, s); + ret = Cons (ret, Null); + if (p->reason == XmCR_MULTIPLE_SELECT + || p->reason == XmCR_EXTENDED_SELECT) { + s = String_Table_To_Scheme (p->selected_items, p->selected_item_count); + ret = Cons (s, ret); + s = Bits_To_Symbols ((unsigned long)p->selection_type, 0, Type_Syms); + ret = Cons (s, ret); + } else { + ret = Cons (Make_Integer (p->item_position), ret); + } + s = Get_Any_CB ((XmAnyCallbackStruct *)p); + ret = Cons (Cdr (s), ret); + ret = Cons (Car (s), ret); + GC_Unlink; + return ret; +}") + +(define-callback 'list 'browseSelectionCallback #t) +(define-callback 'list 'defaultActionCallback #t) +(define-callback 'list 'extendedSelectionCallback #t) +(define-callback 'list 'multipleSelectionCallback #t) +(define-callback 'list 'singleSelectionCallback #t) + +(define list-callback->scheme +" return Get_List_CB ((XmListCallbackStruct *)x);") + +(c->scheme 'callback:list-browseSelectionCallback list-callback->scheme) +(c->scheme 'callback:list-defaultActionCallback list-callback->scheme) +(c->scheme 'callback:list-extendedSelectionCallback list-callback->scheme) +(c->scheme 'callback:list-multipleSelectionCallback list-callback->scheme) +(c->scheme 'callback:list-singleSelectionCallback list-callback->scheme) diff --git a/lib/xm/main-window.d b/lib/xm/main-window.d new file mode 100644 index 0000000..3aafdef --- /dev/null +++ b/lib/xm/main-window.d @@ -0,0 +1,5 @@ +;;; -*-Scheme-*- + +(define-widget-type 'mainwindow "MainW.h") + +(define-widget-class 'main-window 'xmMainWindowWidgetClass) diff --git a/lib/xm/message-box.d b/lib/xm/message-box.d new file mode 100644 index 0000000..1287c6d --- /dev/null +++ b/lib/xm/message-box.d @@ -0,0 +1,31 @@ +;;; -*-Scheme-*- + +(define-widget-type 'messagebox "MessageB.h") + +(prolog + +"static SYMDESCR Type_Syms[] = { + { \"dialog-error\", XmDIALOG_ERROR }, + { \"dialog-information\", XmDIALOG_INFORMATION }, + { \"dialog-message\", XmDIALOG_MESSAGE }, + { \"dialog-question\", XmDIALOG_QUESTION }, + { \"dialog-warning\", XmDIALOG_WARNING }, + { \"dialog-working\", XmDIALOG_WORKING }, + { 0, 0} +};") + +(define-widget-class 'message-box 'xmMessageBoxWidgetClass) + +(define-callback 'message-box 'cancelCallback #t) +(define-callback 'message-box 'okCallback #t) + +(define scheme->dialog-type +" return (XtArgVal)Symbols_To_Bits (x, 0, Type_Syms);") + +(define message-box-callback->scheme +" return Get_Any_CB ((XmAnyCallbackStruct *)x);") + +(scheme->c 'message-box-dialogType scheme->dialog-type) + +(c->scheme 'callback:message-box-cancelCallback message-box-callback->scheme) +(c->scheme 'callback:message-box-okCallback message-box-callback->scheme) diff --git a/lib/xm/paned-window.d b/lib/xm/paned-window.d new file mode 100644 index 0000000..14d147f --- /dev/null +++ b/lib/xm/paned-window.d @@ -0,0 +1,9 @@ +;;; -*-Scheme-*- + +(define-widget-type 'panedwindow "PanedW.h") + +(prolog "extern WidgetClass xmSashWidgetClass;") + +(define-widget-class 'paned-window 'xmPanedWindowWidgetClass) + +(define-widget-class 'sash 'xmSashWidgetClass) diff --git a/lib/xm/push-button.d b/lib/xm/push-button.d new file mode 100644 index 0000000..a5122db --- /dev/null +++ b/lib/xm/push-button.d @@ -0,0 +1,14 @@ +;;; -*-Scheme-*- + +(define-widget-type 'pushbutton '("PushB.h" "PushBG.h")) + +(define-widget-class 'push-button 'xmPushButtonWidgetClass) +(define-widget-class 'push-button-gadget 'xmPushButtonGadgetClass) + +(define-callback 'push-button 'activateCallback #t) +(define-callback 'push-button 'armCallback #t) +(define-callback 'push-button 'disarmCallback #t) + +(define-callback 'push-button-gadget 'activateCallback #t) +(define-callback 'push-button-gadget 'armCallback #t) +(define-callback 'push-button-gadget 'disarmCallback #t) diff --git a/lib/xm/row-column.d b/lib/xm/row-column.d new file mode 100644 index 0000000..83520a5 --- /dev/null +++ b/lib/xm/row-column.d @@ -0,0 +1,101 @@ +;;; -*-Scheme-*- + +(define-widget-type 'rowcolumn "RowColumn.h") + +(prolog + +"static SYMDESCR Type_Syms[] = { + { \"work-area\", XmWORK_AREA }, + { \"menu-bar\", XmMENU_BAR }, + { \"menu-pulldown\", XmMENU_PULLDOWN }, + { \"menu-popup\", XmMENU_POPUP }, + { \"menu-option\", XmMENU_OPTION }, + { 0, 0} +};") + +(define-widget-class 'row-column 'xmRowColumnWidgetClass) + +(prolog + +"static void Post_Handler (w, client_data, event, unused) Widget w; + XtPointer client_data; XEvent *event; Boolean *unused; { + unsigned int b; + Arg a; + XButtonPressedEvent *ep = (XButtonPressedEvent *)event; + Widget popup = (Widget)client_data; + + XtSetArg (a, XmNwhichButton, &b); + XtGetValues (popup, &a, 1); + if (ep->button != b) + return; + XmMenuPosition (popup, ep); + XtManageChild (popup); +}") + +(prolog + +"static Object Get_Row_Column_CB (p) XmRowColumnCallbackStruct *p; { + Object ret, s; + GC_Node2; + + ret = s = Make_Widget_Foreign (p->widget); + GC_Link2 (ret, s); + ret = Cons (ret, Null); + s = Get_Any_CB ((XmAnyCallbackStruct *)p); + ret = Cons (Cdr (s), ret); + ret = Cons (Car (s), ret); + GC_Unlink; + return ret; +}") + +(define-primitive 'popup-menu-attach-to! '(m w) +" XtPointer client_data; + Arg a; + Check_Widget_Class (m, xmRowColumnWidgetClass); + Check_Widget (w); + XtSetArg (a, XmNuserData, &client_data); + XtGetValues (WIDGET(w)->widget, &a, 1); + if (client_data) + XtRemoveEventHandler (WIDGET(w)->widget, ButtonPressMask, 0, + Post_Handler, client_data); + client_data = (XtPointer)WIDGET(m)->widget; + XtAddEventHandler (WIDGET(w)->widget, ButtonPressMask, 0, + Post_Handler, client_data); + client_data = (XtPointer)WIDGET(m)->widget; + XtSetValues (WIDGET(w)->widget, &a, 1); + return Void;") + +(define-callback 'row-column 'entryCallback #t) + +(define row-column-callback->scheme +" return Get_Row_Column_CB ((XmRowColumnCallbackStruct *)x);") + +(c->scheme 'callback:row-column-entryCallback row-column-callback->scheme) + +(define scheme->row-column-type +" return (XtArgVal)Symbols_To_Bits (x, 0, Type_Syms);") + +;;; whichButton resource is declared with a type of XtRWhichButton +;;; instead of XtRUnsignedInt. Argh! + +(define scheme->which-button +" return (XtArgVal)Get_Integer (x);") + +(define which-button->scheme +" return Make_Integer (x);") + +;;; entryClass is declared as int! Bletch! + +(define scheme->entry-class +" Check_Type (x, T_Class); return (XtArgVal)CLASS(x)->wclass;") + +(define entry-class->scheme +" return Make_Widget_Class ((WidgetClass)x);") + +(scheme->c 'row-column-rowColumnType scheme->row-column-type) + +(scheme->c 'row-column-whichButton scheme->which-button) +(c->scheme 'row-column-whichButton which-button->scheme) + +(scheme->c 'row-column-entryClass scheme->entry-class) +(c->scheme 'row-column-entryClass entry-class->scheme) diff --git a/lib/xm/scale.d b/lib/xm/scale.d new file mode 100644 index 0000000..00bed5e --- /dev/null +++ b/lib/xm/scale.d @@ -0,0 +1,37 @@ +;;; -*-Scheme-*- + +(define-widget-type 'scale "Scale.h") + +(define-widget-class 'scale 'xmScaleWidgetClass) + +(prolog + +"static Object Get_Scale_CB (p) XmScaleCallbackStruct *p; { + Object ret, s; + extern SYMDESCR Reason_Syms[]; + GC_Node2; + + ret = s = Make_Integer (p->value); + GC_Link2 (ret, s); + ret = Cons (ret, Null); +#ifdef SCALE_WIDGET_WORKS /* It doesn't. */ + s = Get_Any_CB ((XmAnyCallbackStruct *)p); +#else + s = Intern (\"event-goes-here-when-Xm-is-fixed\"); + s = Cons (s, Null); + s = Cons (Bits_To_Symbols ((unsigned long)p->reason, 0, Reason_Syms), s); +#endif + ret = Cons (Cdr (s), ret); + ret = Cons (Car (s), ret); + GC_Unlink; + return ret; +}") + +(define-callback 'scale 'dragCallback #t) +(define-callback 'scale 'valueChangedCallback #t) + +(define scale-callback->scheme +" return Get_Scale_CB ((XmScaleCallbackStruct *)x);") + +(c->scheme 'callback:scale-dragCallback scale-callback->scheme) +(c->scheme 'callback:scale-valueChangedCallback scale-callback->scheme) diff --git a/lib/xm/scroll-bar.d b/lib/xm/scroll-bar.d new file mode 100644 index 0000000..64e7fc9 --- /dev/null +++ b/lib/xm/scroll-bar.d @@ -0,0 +1,45 @@ +;;; -*-Scheme-*- + +(define-widget-type 'scrollbar "ScrollBar.h") + +(define-widget-class 'scroll-bar 'xmScrollBarWidgetClass) + +(prolog + +"static Object Get_Scrollbar_CB (p) XmScrollBarCallbackStruct *p; { + Object ret, s; + GC_Node2; + + ret = s = Cons (Make_Integer (p->pixel), Null); + GC_Link2 (ret, s); + ret = Cons (Make_Integer (p->value), ret); + s = Get_Any_CB ((XmAnyCallbackStruct *)p); + ret = Cons (Cdr (s), ret); + ret = Cons (Car (s), ret); + GC_Unlink; + return ret; +}") + +(define-callback 'scroll-bar 'decrementCallback #t) +(define-callback 'scroll-bar 'incrementCallback #t) +(define-callback 'scroll-bar 'pageDecrementCallback #t) +(define-callback 'scroll-bar 'pageIncrementCallback #t) +(define-callback 'scroll-bar 'dragCallback #t) +(define-callback 'scroll-bar 'toTopCallback #t) +(define-callback 'scroll-bar 'toBottomCallback #t) +(define-callback 'scroll-bar 'valueChangedCallback #t) + +(define scrollbar-callback->scheme +" return Get_Scrollbar_CB ((XmScrollBarCallbackStruct *)x);") + +(c->scheme 'callback:scroll-bar-decrementCallback scrollbar-callback->scheme) +(c->scheme 'callback:scroll-bar-incrementCallback scrollbar-callback->scheme) +(c->scheme 'callback:scroll-bar-pageDecrementCallback + scrollbar-callback->scheme) +(c->scheme 'callback:scroll-bar-pageIncrementCallback + scrollbar-callback->scheme) +(c->scheme 'callback:scroll-bar-dragCallback scrollbar-callback->scheme) +(c->scheme 'callback:scroll-bar-toTopCallback scrollbar-callback->scheme) +(c->scheme 'callback:scroll-bar-toBottomCallback scrollbar-callback->scheme) +(c->scheme 'callback:scroll-bar-valueChangedCallback + scrollbar-callback->scheme) diff --git a/lib/xm/scrolled-win.d b/lib/xm/scrolled-win.d new file mode 100644 index 0000000..5e80973 --- /dev/null +++ b/lib/xm/scrolled-win.d @@ -0,0 +1,30 @@ +;;; -*-Scheme-*- + +(define-widget-type 'scrolledwindow "ScrolledW.h") + +(prolog + +;;; Before the converter for scrollingPolicy was introduced (which wasn't +;;; even necessary), the one provided by Xm was called and people were using +;;; "AUTOMATIC" and "APPLICATION_DEFINED". Everything was fine. +;;; +;;; After the converter was introduced, code was required to use 'automatic +;;; and 'application-defined instead. Thus the change broke existing code. +;;; +;;; As a temporary solution, I'm now adding AUTOMATIC etc. to the list of +;;; legal values, but clearly some kind of concept is needed here... + +"static SYMDESCR Scrolling_Syms[] = { + { \"automatic\", XmAUTOMATIC }, + { \"application-defined\", XmAPPLICATION_DEFINED }, + { \"AUTOMATIC\", XmAUTOMATIC }, /* see above */ + { \"APPLICATION_DEFINED\", XmAPPLICATION_DEFINED }, + { \"application_defined\", XmAPPLICATION_DEFINED }, + { 0, 0} +};") + +(define-widget-class 'scrolled-window 'xmScrolledWindowWidgetClass) + +(scheme->c 'scrollingPolicy +" if (TYPE(x) == T_String) x = P_String_To_Symbol(x); + return (XtArgVal)Symbols_To_Bits (x, 0, Scrolling_Syms);") diff --git a/lib/xm/selectn-box.d b/lib/xm/selectn-box.d new file mode 100644 index 0000000..de253fd --- /dev/null +++ b/lib/xm/selectn-box.d @@ -0,0 +1,25 @@ +;;; -*-Scheme-*- + +(define-widget-type 'selectionbox "SelectioB.h") + +(prolog + +"static SYMDESCR Type_Syms[] = { + { \"dialog-prompt\", XmDIALOG_PROMPT }, + { \"dialog-selection\", XmDIALOG_SELECTION }, + { \"dialog-work-area\", XmDIALOG_WORK_AREA }, + { 0, 0} +};") + +(define-widget-class 'selection-box 'xmSelectionBoxWidgetClass) + +(define scheme->dialog-type +" return (XtArgVal)Symbols_To_Bits (x, 0, Type_Syms);") + +(scheme->c 'selection-box-dialogType scheme->dialog-type) + +(define-callback 'selection-box 'applyCallback #t) +(define-callback 'selection-box 'cancelCallback #t) +(define-callback 'selection-box 'noMatchCallback #t) +(define-callback 'selection-box 'okCallback #t) +(define-callback 'selection-box 'helpCallback #t) diff --git a/lib/xm/separator.d b/lib/xm/separator.d new file mode 100644 index 0000000..94fa4ee --- /dev/null +++ b/lib/xm/separator.d @@ -0,0 +1,6 @@ +;;; -*-Scheme-*- + +(define-widget-type 'separator '("Separator.h" "SeparatoG.h")) + +(define-widget-class 'separator 'xmSeparatorWidgetClass) +(define-widget-class 'separator-gadget 'xmSeparatorGadgetClass) diff --git a/lib/xm/shell.d b/lib/xm/shell.d new file mode 100644 index 0000000..ddb3ce6 --- /dev/null +++ b/lib/xm/shell.d @@ -0,0 +1,16 @@ +;;; -*-Scheme-*- + +(define-widget-type 'shell '(DialogS.h MenuShell.h)) + +(define-widget-class 'shell 'shellWidgetClass) +(define-widget-class 'override-shell 'overrideShellWidgetClass) +(define-widget-class 'wm-shell 'wmShellWidgetClass) +(define-widget-class 'vendor-shell 'vendorShellWidgetClass) +(define-widget-class 'transient-shell 'transientShellWidgetClass) +(define-widget-class 'toplevel-shell 'topLevelShellWidgetClass) +(define-widget-class 'application-shell 'applicationShellWidgetClass) + +(define-widget-class 'dialog-shell 'xmDialogShellWidgetClass) + +(define-widget-class 'menu-shell 'xmMenuShellWidgetClass + '(width Width Dimension) '(height Height Dimension)) diff --git a/lib/xm/support.d b/lib/xm/support.d new file mode 100644 index 0000000..621770f --- /dev/null +++ b/lib/xm/support.d @@ -0,0 +1,261 @@ +;;; -*-Scheme-*- +;;; +;;; Used as container for random stuff + +(define-widget-type 'support "") ; No include file + +(prolog + +"SYMDESCR Reason_Syms[] = { + { \"none\", XmCR_NONE }, + { \"help\", XmCR_HELP }, + { \"value-changed\", XmCR_VALUE_CHANGED }, + { \"increment\", XmCR_INCREMENT }, + { \"decrement\", XmCR_DECREMENT }, + { \"page-increment\", XmCR_PAGE_INCREMENT }, + { \"page-decrement\", XmCR_PAGE_DECREMENT }, + { \"to-top\", XmCR_TO_TOP }, + { \"to-bottom\", XmCR_TO_BOTTOM }, + { \"drag\", XmCR_DRAG }, + { \"activate\", XmCR_ACTIVATE }, + { \"arm\", XmCR_ARM }, + { \"disarm\", XmCR_DISARM }, + { \"map\", XmCR_MAP }, + { \"unmap\", XmCR_UNMAP }, + { \"focus\", XmCR_FOCUS }, + { \"losing-focus\", XmCR_LOSING_FOCUS }, + { \"modifying-text-value\", XmCR_MODIFYING_TEXT_VALUE },") + +(prolog +" { \"moving-insert-cursor\", XmCR_MOVING_INSERT_CURSOR }, + { \"execute\", XmCR_EXECUTE }, + { \"single-select\", XmCR_SINGLE_SELECT }, + { \"multiple-select\", XmCR_MULTIPLE_SELECT }, + { \"extended-select\", XmCR_EXTENDED_SELECT }, + { \"browse-select\", XmCR_BROWSE_SELECT }, + { \"default-action\", XmCR_DEFAULT_ACTION }, + { \"clipboard-data-request\", XmCR_CLIPBOARD_DATA_REQUEST }, + { \"clipboard-data-delete\", XmCR_CLIPBOARD_DATA_DELETE }, + { \"cascading\", XmCR_CASCADING }, + { \"ok\", XmCR_OK }, + { \"cancel\", XmCR_CANCEL }, + { \"apply\", XmCR_APPLY }, + { \"no-match\", XmCR_NO_MATCH }, + { \"command-entered\", XmCR_COMMAND_ENTERED }, + { \"command-changed\", XmCR_COMMAND_CHANGED }, + { \"expose\", XmCR_EXPOSE }, + { \"resize\", XmCR_RESIZE }, + { \"input\", XmCR_INPUT }, + { 0, 0 } +};") + +(prolog + +"Object Get_Any_CB (p) XmAnyCallbackStruct *p; { + Object args, ret; + GC_Node2; + + args = ret = Null; + GC_Link2 (ret, args); + if (p->event) { + args = Get_Event_Args (p->event); + ret = Copy_List (args); + Destroy_Event_Args (args); + } + ret = Cons (Bits_To_Symbols ((unsigned long)p->reason, 0, Reason_Syms), + ret); + GC_Unlink; + return ret; +}") + +(prolog + +"Object Get_Selection_CB (p) XmSelectionBoxCallbackStruct *p; { + Object ret, s; + char *text; + GC_Node2; + + if (!XmStringGetLtoR (p->value, XmSTRING_DEFAULT_CHARSET, &text)) + text = \"\"; + ret = s = Make_String (text, strlen (text)); + GC_Link2 (ret, s); + ret = Cons (ret, Null); + s = Get_Any_CB ((XmAnyCallbackStruct *)p); + ret = Cons (Cdr (s), ret); + ret = Cons (Car (s), ret); + GC_Unlink; + return ret; +}") + +(prolog + +"static XtArgVal Scheme_To_String_Table (x) Object x; { + Object t; + char *s; + XmString *tab; + int i = 0; + Alloca_Begin; + + tab = (XmString *)XtMalloc (Get_Integer (P_Length (x)) + * sizeof (XmString)); + /* tab is never freed since the converter must return a new address + * each time it is called. + */ + for (t = x; TYPE(t) == T_Pair; t = Cdr (t)) { + Get_Strsym_Stack (Car (t), s); + tab[i++] = XmStringCreate (s, XmSTRING_DEFAULT_CHARSET); + } + Alloca_End; + return (XtArgVal)tab; +}") + + +(define-primitive 'update-display '(w) +" Check_Widget (w); + XmUpdateDisplay (WIDGET(w)->widget); + return Void;") + + +;;; Converters + +(define keysym->scheme +" return Make_Char ((int)x);") + +(define scheme->keysym +" Check_Type (x, T_Character); return (XtArgVal)CHAR(x);") + +(define position->scheme +" return Make_Integer (*(Position *)&x);") + +(define scheme->position +" return (XtArgVal)Get_Integer (x);") + +(define dimension->scheme +" return Make_Integer (*(Dimension *)&x);") + +(define scheme->dimension +" return (XtArgVal)Get_Unsigned (x);") + +(define int->scheme +" return Make_Integer (*(int *)&x);") + +(define scheme->int +" return (XtArgVal)Get_Integer (x);") + +(define window->scheme +" return Make_Widget_Foreign ((Widget)x);") + +(define scheme->window +" Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;") + +(define scheme->scrollbar +" extern WidgetClass xmScrollBarWidgetClass; + Check_Widget_Class (x, xmScrollBarWidgetClass); + return (XtArgVal)WIDGET(x)->widget;") + +(define selection-callback->scheme +" return Get_Selection_CB ((XmSelectionBoxCallbackStruct *)x);") + +(define help-callback->scheme +" return Get_Any_CB ((XmAnyCallbackStruct *)x);") + +(define button-callback->scheme +" return Get_Any_CB ((XmAnyCallbackStruct *)x);") + +(define event-callback->scheme +" return Get_Any_CB ((XmAnyCallbackStruct *)x);") + +(define xm-string->scheme +" char *text; + if (!XmStringGetLtoR ((XmString)x, XmSTRING_DEFAULT_CHARSET, &text)) + text = \"\"; + return Make_String (text, strlen (text));") + +(define scheme->xm-string +" char *s; + XtArgVal ret; + Alloca_Begin; + Get_Strsym_Stack (x, s); + ret = (XtArgVal)XmStringCreateLtoR (s, XmSTRING_DEFAULT_CHARSET); + Alloca_End; + return ret;") + +(define scheme->xm-string-table +" return Scheme_To_String_Table (x);") + +(c->scheme 'KeySym keysym->scheme) +(scheme->c 'KeySym scheme->keysym) + +(c->scheme 'HorizontalPosition position->scheme) +(c->scheme 'VerticalPosition position->scheme) +(c->scheme 'HorizontalDimension dimension->scheme) +(c->scheme 'VerticalDimension dimension->scheme) +(c->scheme 'HorizontalInt int->scheme) ; Sigh. Why don't they just +(c->scheme 'VerticalInt int->scheme) ; use plain old Int?? +(scheme->c 'HorizontalPosition scheme->position) +(scheme->c 'VerticalPosition scheme->position) +(scheme->c 'HorizontalDimension scheme->dimension) +(scheme->c 'VerticalDimension scheme->dimension) +(scheme->c 'HorizontalInt scheme->int) +(scheme->c 'VerticalInt scheme->int) + +(c->scheme 'ShellHorizPos position->scheme) +(c->scheme 'ShellVertPos position->scheme) +(c->scheme 'ShellHorizDim dimension->scheme) +(c->scheme 'ShellVertDim dimension->scheme) +(scheme->c 'ShellHorizPos scheme->position) +(scheme->c 'ShellVertPos scheme->position) +(scheme->c 'ShellHorizDim scheme->dimension) +(scheme->c 'ShellVertDim scheme->dimension) + +(c->scheme 'horizontalScrollBar window->scheme) ; Some classes have resources +(c->scheme 'verticalScrollBar window->scheme) ; of type window instead of +(c->scheme 'workWindow window->scheme) ; widget. What a crock! +(c->scheme 'commandWindow window->scheme) +(c->scheme 'menuBar window->scheme) +(c->scheme 'subMenuId window->scheme) +(c->scheme 'menuHistory window->scheme) +(c->scheme 'menuHelpWidget window->scheme) +(c->scheme 'bottomWidget window->scheme) +(c->scheme 'leftWidget window->scheme) +(c->scheme 'rightWidget window->scheme) +(c->scheme 'topWidget window->scheme) + +(scheme->c 'horizontalScrollBar scheme->scrollbar) +(scheme->c 'verticalScrollBar scheme->scrollbar) +(scheme->c 'workWindow scheme->window) +(scheme->c 'commandWindow scheme->window) +(scheme->c 'menuBar scheme->window) +(scheme->c 'subMenuId scheme->window) +(scheme->c 'menuHistory scheme->window) +(scheme->c 'menuHelpWidget scheme->window) +(scheme->c 'bottomWidget scheme->window) +(scheme->c 'leftWidget scheme->window) +(scheme->c 'rightWidget scheme->window) +(scheme->c 'topWidget scheme->window) + +(c->scheme 'callback:applyCallback selection-callback->scheme) +(c->scheme 'callback:cancelCallback selection-callback->scheme) +(c->scheme 'callback:noMatchCallback selection-callback->scheme) +(c->scheme 'callback:okCallback selection-callback->scheme) + +(c->scheme 'callback:helpCallback help-callback->scheme) + +(c->scheme 'callback:activateCallback button-callback->scheme) +(c->scheme 'callback:armCallback button-callback->scheme) +(c->scheme 'callback:disarmCallback button-callback->scheme) +(c->scheme 'callback:cascadingCallback button-callback->scheme) + +(c->scheme 'callback:exposeCallback event-callback->scheme) +(c->scheme 'callback:inputCallback event-callback->scheme) +(c->scheme 'callback:resizeCallback event-callback->scheme) + +(c->scheme 'XmString xm-string->scheme) +(scheme->c 'XmString scheme->xm-string) +(scheme->c 'XmStringTable scheme->xm-string-table) + +;;; Classes for which no .d-file exists: + +(define-widget-class 'primitive 'xmPrimitiveWidgetClass) + +(define-widget-class 'manager 'xmManagerWidgetClass) diff --git a/lib/xm/text.d b/lib/xm/text.d new file mode 100644 index 0000000..fd59db5 --- /dev/null +++ b/lib/xm/text.d @@ -0,0 +1,23 @@ +;;; -*-Scheme-*- + +(define-widget-type 'text "Text.h") + +(define-widget-class 'text 'xmTextWidgetClass + '(pendingDelete PendingDelete Boolean) + '(selectThreshold SelectThreshold Int) + '(blinkRate BlinkRate Int) + '(columns Columns Short) + '(cursorPositionVisible CursorPositionVisible Boolean) + '(fontList FontList FontList) + '(resizeHeight ResizeHeight Boolean) + '(resizeWidth ResizeWidth Boolean) + '(rows Rows Short) + '(wordWrap WordWrap Boolean)) + +(define-callback 'text 'activateCallback #t) +(define-callback 'text 'valueChangedCallback #t) + +(define text-callback->scheme +" return Get_Any_CB ((XmAnyCallbackStruct *)x);") + +(c->scheme 'callback:text-valueChangedCallback text-callback->scheme) diff --git a/lib/xm/toggle-btn.d b/lib/xm/toggle-btn.d new file mode 100644 index 0000000..7bcc06a --- /dev/null +++ b/lib/xm/toggle-btn.d @@ -0,0 +1,25 @@ +;;; -*-Scheme-*- + +(define-widget-type 'togglebutton '("ToggleB.h" "ToggleBG.h")) + +(define-widget-class 'toggle-button 'xmToggleButtonWidgetClass) +(define-widget-class 'toggle-button-gadget 'xmToggleButtonGadgetClass) + +(define-callback 'toggle-button 'armCallback #t) +(define-callback 'toggle-button 'disarmCallback #t) +(define-callback 'toggle-button 'valueChangedCallback #t) + +(define-callback 'toggle-button-gadget 'armCallback #t) +(define-callback 'toggle-button-gadget 'disarmCallback #t) +(define-callback 'toggle-button-gadget 'valueChangedCallback #t) + +;;; Ignore the `set' field in all callback structs (can do a get-values +;;; on the widget passed to the callback function). + +(define toggle-button-callback->scheme +" return Get_Any_CB ((XmAnyCallbackStruct *)x);") + +(c->scheme 'callback:toggle-button-valueChangedCallback + toggle-button-callback->scheme) +(c->scheme 'callback:toggle-button-gadget-valueChangedCallback + toggle-button-callback->scheme) diff --git a/lib/xm/xt/Makefile b/lib/xm/xt/Makefile new file mode 100644 index 0000000..b844913 --- /dev/null +++ b/lib/xm/xt/Makefile @@ -0,0 +1,24 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../../../config/system ../../../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + +lint: Makefile.local + $(MAKE) -f Makefile.local lint + +clean: Makefile.local + $(MAKE) -f Makefile.local clean + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/lib/xm/xt/build b/lib/xm/xt/build new file mode 100755 index 0000000..5f05e2f --- /dev/null +++ b/lib/xm/xt/build @@ -0,0 +1,69 @@ +. ../../../config/system +. ../../../config/site + +# In HP-UX, the Motif libraries must be linked with xt-motif.o instead +# of placing them into the load-libraries (I don't know why): + +if [ _$load_obj = _shl ]; then + motif_link_libs="$libxmotif" +else + motif_link_libs= +fi + + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +CC= ${cc-cc} +CFLAGS= $cflags $obj_cflags +LINTFLAGS= $lintflags + +XTDIR= ../../xt + +O= \$(XTDIR)/accelerator.o\\ + \$(XTDIR)/action.o\\ + \$(XTDIR)/callback.o\\ + \$(XTDIR)/class.o\\ + \$(XTDIR)/classname.o\\ + \$(XTDIR)/context.o\\ + \$(XTDIR)/converter.o\\ + \$(XTDIR)/error.o\\ + \$(XTDIR)/function.o\\ + \$(XTDIR)/identifier.o\\ + \$(XTDIR)/init.o\\ + \$(XTDIR)/objects.o\\ + \$(XTDIR)/popup.o\\ + \$(XTDIR)/resource.o\\ + \$(XTDIR)/translation.o\\ + \$(XTDIR)/widget.o + +.c.o: + @echo "" + @echo === Must make files in \$(XTDIR) first\! === + @echo "" + +xt-motif.pre: \$(O) ../../xlib/xlib.pre + ../../../scripts/makedl \$@ \$(O) ../../xlib/*.o $motif_link_libs + +install: xt-motif.pre + -@if [ ! -d $install_dir/runtime ]; then \\ + echo mkdir $install_dir/runtime; \\ + mkdir $install_dir/runtime; \\ + fi + -@if [ ! -d $install_dir/runtime/obj ]; then \\ + echo mkdir $install_dir/runtime/obj; \\ + mkdir $install_dir/runtime/obj; \\ + fi + cp xt-motif.pre $install_dir/runtime/obj/xt-motif.o + +lint: + +clean: + rm -f *.o xt-motif.pre core + +distclean: + rm -f *.o xt-motif.pre core Makefile.local +EOT diff --git a/lib/xt/MISSING b/lib/xt/MISSING new file mode 100644 index 0000000..b5df48e --- /dev/null +++ b/lib/xt/MISSING @@ -0,0 +1,55 @@ +Subresources cannot be read by means of get-values. + +Callbacks *must* return; e.g. a (reset) from within a callback is +not allowed. This is a bug in Xt. + +Xt doesn't notice when ports that have been registered as input source +with context-add-input are closed. In this case, the select() fails. + +error.c: Warning msg handler is now part of application context + +Missing: + + keycode translators + case converters + shared graphics contexts + selections + + 2. + XtScreen + XtDisplayOfObject + XtScreenOfObject + XtWindowOfObject + + 7. + XtAddGrab + XtRemoveGrab + XtGrabKey + XtUngrabKey + XtGrabKeyboard + XtUngrabKeyboard + XtGrabButton + XtUngrabButton + XtGrabPointer + XtUngrabPointer + XtSetKeyboardFocus + XtCallAcceptFocus + XtAppPending + XtAppPeekEvent, XtAppNextEvent, XtAppProcessEvent, XtDispatchEvent (?) + Xt{Add,Remove,Insert}EventHandler (?) + Xt{Add,Remove,Insert}RawEventHandler (?) + XtBuildEventMask (?) + + 9. + XtGetSubresources (?) + XtGetApplicationResources + XtGetSubvalues, XtSetSubvalues (?) + + 10. + XtAppAddActionHook (?) + XtRemoveActionHook (?) + + 11. + XtAppSetSelectionTimeout + XtAppGetSelectionTimeout + XtSetWMColormapWindows diff --git a/lib/xt/Makefile b/lib/xt/Makefile new file mode 100644 index 0000000..cd1a7d3 --- /dev/null +++ b/lib/xt/Makefile @@ -0,0 +1,24 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../../config/system ../../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + +lint: Makefile.local + $(MAKE) -f Makefile.local lint + +clean: Makefile.local + $(MAKE) -f Makefile.local clean + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/lib/xt/accelerator.c b/lib/xt/accelerator.c new file mode 100644 index 0000000..3af2294 --- /dev/null +++ b/lib/xt/accelerator.c @@ -0,0 +1,35 @@ +#include "xt.h" + +XtAccelerators Get_Accelerators (a) Object a; { + register char *s; + XtAccelerators ret; + Alloca_Begin; + + Get_Strsym_Stack (a, s); + if ((ret = XtParseAcceleratorTable (s)) == 0) + Primitive_Error ("bad accelerator table: ~s", a); + Alloca_End; + return ret; +} + +static Object P_Install_Accelerators (dst, src) Object dst, src; { + Check_Widget (dst); + Check_Widget (src); + XtInstallAccelerators (WIDGET(dst)->widget, WIDGET(src)->widget); + return Void; +} + +static Object P_Install_All_Accelerators (dst, src) Object dst, src; { + Check_Widget (dst); + Check_Widget (src); + XtInstallAllAccelerators (WIDGET(dst)->widget, WIDGET(src)->widget); + return Void; + +} + +elk_init_xt_accelerator () { + Define_Primitive (P_Install_Accelerators, + "install-accelerators", 2, 2, EVAL); + Define_Primitive (P_Install_All_Accelerators, + "install-all-accelerators", 2, 2, EVAL); +} diff --git a/lib/xt/action.c b/lib/xt/action.c new file mode 100644 index 0000000..2f363d5 --- /dev/null +++ b/lib/xt/action.c @@ -0,0 +1,80 @@ +#include "xt.h" + +typedef struct action { + char *name; + int num; + XtAppContext con; + struct action *next; +} ACTION; + +ACTION *actions; + +/*ARGSUSED*/ +static void Dummy_Action (w, ep, argv, argc) Widget w; XEvent *ep; + String *argv; int *argc; { +} + +void Action_Hook (w, client_data, name, ep, argv, argc) + Widget w; XtPointer client_data; char *name; XEvent *ep; + char **argv; int *argc; { + ACTION *ap; + Object args, params, tail; + register i; + GC_Node3; + + for (ap = actions; ap; ap = ap->next) { + if (strcmp (ap->name, name)) + continue; + args = params = tail = Null; + GC_Link3 (args, params, tail); + params = P_Make_List (Make_Integer (*argc), Null); + for (i = 0, tail = params; i < *argc; tail = Cdr (tail), i++) { + Object tmp; + + tmp = Make_String (argv[i], strlen (argv[i])); + Car (tail) = tmp; + } + args = Cons (params, Null); + params = Get_Event_Args (ep); + args = Cons (Copy_List (params), args); + Destroy_Event_Args (params); + args = Cons (Make_Widget_Foreign (w), args); + (void)Funcall (Get_Function (ap->num), args, 0); + GC_Unlink; + } +} + +static Object P_Context_Add_Action (c, s, p) Object c, s, p; { + ACTION *ap; + XtActionsRec a; + + Check_Context (c); + Check_Procedure (p); + ap = (ACTION *)XtMalloc (sizeof (ACTION)); + ap->num = Register_Function (p); + ap->name = XtNewString (Get_Strsym (s)); + ap->con = CONTEXT(c)->context; + ap->next = actions; + actions = ap; + a.string = ap->name; + a.proc = (XtActionProc)Dummy_Action; + XtAppAddActions (ap->con, &a, 1); + return Void; +} + +void Free_Actions (con) XtAppContext con; { + register ACTION *p, **pp; + + for (pp = &actions; p = *pp; ) { + if (p->con == con) { + Deregister_Function (p->num); + XtFree (p->name); + *pp = p->next; + XtFree ((char *)p); + } else pp = &p->next; + } +} + +elk_init_xt_action () { + Define_Primitive (P_Context_Add_Action, "context-add-action", 3, 3, EVAL); +} diff --git a/lib/xt/build b/lib/xt/build new file mode 100755 index 0000000..09f65b8 --- /dev/null +++ b/lib/xt/build @@ -0,0 +1,118 @@ +. ../../config/system +. ../../config/site + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +CC= ${cc-cc} +CFLAGS= $cflags $obj_cflags +LINTFLAGS= $lintflags + +INC= ../../include + +H= \$(INC)/compat.h\\ + \$(INC)/config.h\\ + \$(INC)/cstring.h\\ + \$(INC)/exception.h\\ + \$(INC)/extern.h\\ + \$(INC)/funcproto.h\\ + \$(INC)/gc.h\\ + \$(INC)/misc.h\\ + \$(INC)/object.h\\ + \$(INC)/param.h\\ + \$(INC)/stkmem.h\\ + \$(INC)/type.h\\ + ../xlib/xlib.h\\ + xt.h + +C= accelerator.c\\ + action.c\\ + callback.c\\ + class.c\\ + classname.c\\ + context.c\\ + converter.c\\ + error.c\\ + function.c\\ + identifier.c\\ + init.c\\ + objects.c\\ + popup.c\\ + resource.c\\ + translation.c\\ + widget.c + +O= accelerator.o\\ + action.o\\ + callback.o\\ + class.o\\ + classname.o\\ + context.o\\ + converter.o\\ + error.o\\ + function.o\\ + identifier.o\\ + init.o\\ + objects.o\\ + popup.o\\ + resource.o\\ + translation.o\\ + widget.o + +all: \$(O) xt.pre + +.c.o: + \$(CC) \$(CFLAGS) -I\$(INC) -I../xlib $x11_incl -c \$< + +accelerator.o: \$(H) accelerator.c +action.o: \$(H) action.c +callback.o: \$(H) callback.c +class.o: \$(H) class.c +classname.o: \$(H) classname.c +context.o: \$(H) context.c +converter.o: \$(H) converter.c +error.o: \$(H) error.c +function.o: \$(H) function.c +identifier.o: \$(H) identifier.c +init.o: \$(H) init.c +objects.o: \$(H) objects.c +popup.o: \$(H) popup.c +resource.o: \$(H) resource.c +translation.o: \$(H) translation.c +widget.o: \$(H) widget.c + +xt.pre: \$(O) ../xlib/xlib.pre + ../../scripts/makedl \$@ \$(O) ../xlib/*.o + +install: xt.pre + -@if [ ! -d $install_dir/runtime ]; then \\ + echo mkdir $install_dir/runtime; \\ + mkdir $install_dir/runtime; \\ + fi + -@if [ ! -d $install_dir/runtime/obj ]; then \\ + echo mkdir $install_dir/runtime/obj; \\ + mkdir $install_dir/runtime/obj; \\ + fi + cp xt.pre $install_dir/runtime/obj/xt.o + -@if [ ! -d $install_dir/include ]; then \\ + echo mkdir $install_dir/include; \\ + mkdir $install_dir/include; \\ + fi + -@if [ ! -d $install_dir/include/extensions ]; then \\ + echo mkdir $install_dir/include/extensions; \\ + mkdir $install_dir/include/extensions; \\ + fi + cp xt.h $install_dir/include/extensions + +lint: + lint \$(LINTFLAGS) -I\$(INC) -I../xlib $x11_incl \$(C) + +clean: + rm -f *.o xt.pre core + +distclean: + rm -f *.o xt.pre core lint.out Makefile.local +EOT diff --git a/lib/xt/callback.c b/lib/xt/callback.c new file mode 100644 index 0000000..63ccdcf --- /dev/null +++ b/lib/xt/callback.c @@ -0,0 +1,129 @@ +#include "xt.h" + +typedef struct { + PFX2S converter; + int num; +} CLIENT_DATA; + +Object Get_Callbackfun (c) XtPointer c; { + register CLIENT_DATA *cd = (CLIENT_DATA *)c; + return cd ? Get_Function (cd->num) : False; +} + +static void Callback_Proc (w, client_data, call_data) Widget w; + XtPointer client_data, call_data; { + register CLIENT_DATA *cd = (CLIENT_DATA *)client_data; + Object args; + GC_Node; + + args = Null; + GC_Link (args); + if (cd->converter) + args = Cons ((cd->converter)((XtArgVal)call_data), args); + args = Cons (Make_Widget_Foreign (w), args); + GC_Unlink; + (void)Funcall (Get_Callbackfun (client_data), args, 0); +} + +/*ARGSUSED*/ +void Destroy_Callback_Proc (w, client_data, call_data) Widget w; + XtPointer client_data, call_data; { + Object x; + + x = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w); + if (Nullp (x) || WIDGET(x)->free) + return; + WIDGET(x)->free = 1; + Remove_All_Callbacks (w); + Deregister_Object (x); +} + +/* The code assumes that callbacks are called in the order they + * have been added. The Destroy_Callback_Proc() must always be + * the last callback in the destroy callback list of each widget. + * + * When the destroy callback list of a widget is modified + * (via P_Add_Callbacks or P_Set_Values), Fiddle_Destroy_Callback() + * must be called to remove the Destroy_Callback_Proc() and put + * it back to the end of the callback list. + */ +void Fiddle_Destroy_Callback (w) Widget w; { + XtRemoveCallback (w, XtNdestroyCallback, Destroy_Callback_Proc, + (XtPointer)0); + XtAddCallback (w, XtNdestroyCallback, Destroy_Callback_Proc, (XtPointer)0); +} + +void Check_Callback_List (x) Object x; { + Object tail; + + Check_List (x); + for (tail = x; !Nullp (tail); tail = Cdr (tail)) + Check_Procedure (Car (tail)); +} + +static Object P_Add_Callbacks (w, name, cbl) Object w, name, cbl; { + register char *s; + register n; + XtCallbackList callbacks; + Alloca_Begin; + + Check_Widget (w); + Check_Callback_List (cbl); + s = Get_Strsym (name); + Make_Resource_Name (s); + n = Fast_Length (cbl); + Alloca (callbacks, XtCallbackRec*, (n+1) * sizeof (XtCallbackRec)); + callbacks[n].callback = 0; + callbacks[n].closure = 0; + Fill_Callbacks (cbl, callbacks, n, + Find_Callback_Converter (XtClass (WIDGET(w)->widget), s, name)); + XtAddCallbacks (WIDGET(w)->widget, s, callbacks); + if (streq (s, XtNdestroyCallback)) + Fiddle_Destroy_Callback (WIDGET(w)->widget); + Alloca_End; + return Void; +} + +void Fill_Callbacks (src, dst, n, conv) Object src; XtCallbackList dst; + register n; PFX2S conv; { + register CLIENT_DATA *cd; + register i, j; + Object tail; + + for (i = 0, tail = src; i < n; i++, tail = Cdr (tail)) { + j = Register_Function (Car (tail)); + cd = (CLIENT_DATA *)XtMalloc (sizeof (CLIENT_DATA)); + cd->converter = conv; + cd->num = j; + dst[i].callback = (XtCallbackProc)Callback_Proc; + dst[i].closure = (XtPointer)cd; + } +} + +Remove_All_Callbacks (w) Widget w; { + Arg a[1]; + XtCallbackList c; + XtResource *r; + int nr, nc; + register i, j; + + Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc); + for (j = 0; j < nr; j++) { + if (streq (r[j].resource_type, XtRCallback)) { + XtSetArg (a[0], r[j].resource_name, &c); + XtGetValues (w, a, 1); + for (i = 0; c[i].callback; i++) { + register CLIENT_DATA *cd = (CLIENT_DATA *)c[i].closure; + if (c[i].callback == (XtCallbackProc)Callback_Proc && cd) { + Deregister_Function (cd->num); + XtFree ((char *)cd); + } + } + } + } + XtFree ((char *)r); +} + +elk_init_xt_callback () { + Define_Primitive (P_Add_Callbacks, "add-callbacks", 3, 3, EVAL); +} diff --git a/lib/xt/class.c b/lib/xt/class.c new file mode 100644 index 0000000..c696087 --- /dev/null +++ b/lib/xt/class.c @@ -0,0 +1,211 @@ +#include "xt.h" + +#define MAX_CLASS 128 +#define MAX_CALLBACK_PER_CLASS 10 + +typedef struct { + char *name; + int has_arg; +} CALLBACK_INFO; + +typedef struct { + WidgetClass class; + char *name; + CALLBACK_INFO cb[MAX_CALLBACK_PER_CLASS], *cblast; + XtResourceList sub_resources; + int num_resources; +} CLASS_INFO; + +static CLASS_INFO ctab[MAX_CLASS], *clast = ctab; + +Generic_Predicate (Class) + +Generic_Simple_Equal (Class, CLASS, wclass) + +Generic_Print (Class, "#[class %s]", CLASS(x)->name) + +Object Make_Class (class, name) WidgetClass class; char *name; { + Object c; + + c = Find_Object (T_Class, (GENERIC)0, Match_Xt_Obj, class); + if (Nullp (c)) { + c = Alloc_Object (sizeof (struct S_Class), T_Class, 0); + CLASS(c)->tag = Null; + CLASS(c)->wclass = class; + CLASS(c)->name = name; + Register_Object (c, (GENERIC)0, (PFO)0, 0); + /* See comment in Define_Class below */ + XtInitializeWidgetClass (class); + } + return c; +} + +Object Make_Widget_Class (class) WidgetClass class; { + register CLASS_INFO *p; + + for (p = ctab; p < clast; p++) + if (p->class == class) + return Make_Class (class, p->name); + Primitive_Error ("undefined widget class ~s", Xt_Class_Name (class)); + /*NOTREACHED*/ +} + +static Object P_Find_Class (name) Object name; { + register CLASS_INFO *p; + register char *s = Get_Strsym (name); + + for (p = ctab; p < clast; p++) { + if (streq (p->name, s)) + return Make_Class (p->class, p->name); + } + Primitive_Error ("no such widget class: ~s", name); + /*NOTREACHED*/ +} + +static Object P_Class_Existsp (name) Object name; { + register CLASS_INFO *p; + register char *s = Get_Strsym (name); + + for (p = ctab; p < clast; p++) { + if (streq (p->name, s)) + return True; + } + return False; +} + +char *Class_Name (class) WidgetClass class; { + register CLASS_INFO *p; + + for (p = ctab; p < clast && p->class != class; p++) + ; + if (p == clast) + return "unknown"; + return p->name; +} + +void Get_Sub_Resource_List (class, rp, np) WidgetClass class; + XtResourceList *rp; Cardinal *np; { + register CLASS_INFO *p; + + for (p = ctab; p < clast && p->class != class; p++) + ; + if (p == clast) + Primitive_Error ("undefined widget class ~s", Xt_Class_Name (class)); + *np = p->num_resources; + *rp = p->sub_resources; +} + +static Object P_Class_Resources (c) Object c; { + Check_Type (c, T_Class); + return Get_Resources (CLASS(c)->wclass, XtGetResourceList, 1); +} + +static Object P_Class_Constraint_Resources (c) Object c; { + Check_Type (c, T_Class); + return Get_Resources (CLASS(c)->wclass, XtGetConstraintResourceList, 1); +} + +static Object P_Class_Sub_Resources (c) Object c; { + Check_Type (c, T_Class); + return Get_Resources (CLASS(c)->wclass, Get_Sub_Resource_List, 0); +} + +void Define_Class (name, class, r, nr) char *name; WidgetClass class; + XtResourceList r; { + Set_Error_Tag ("define-class"); + if (clast == ctab+MAX_CLASS) + Primitive_Error ("too many widget classes"); + /* + * The next line should read: + * XtInitializeWidgetClass (class); + * However, there is a bug in Motif 1.1.4 that causes an application + * to drop core if the row-column widget class is initialized before + * the first vendor-shell widget has been created. + * Thus, we can't initialize any classes at this point; we will do + * it in Make_Class above instead. + * This essentially causes a class to be initialized the first time + * it is used. + */ + clast->name = name; + clast->class = class; + clast->cb[0].name = XtNdestroyCallback; + clast->cb[0].has_arg = 0; + clast->cblast = clast->cb+1; + clast->sub_resources = r; + clast->num_resources = nr; + clast++; +} + +void Define_Callback (cl, s, has_arg) char *cl, *s; { + register CLASS_INFO *p; + + Set_Error_Tag ("define-callback"); + for (p = ctab; p < clast; p++) + if (streq (p->name, cl)) { + if (p->cblast == p->cb+MAX_CALLBACK_PER_CLASS) + Primitive_Error ("too many callbacks for this class"); + p->cblast->name = s; + p->cblast->has_arg = has_arg; + p->cblast++; + return; + } + Primitive_Error ("undefined class"); +} + +PFX2S Find_Callback_Converter (c, name, sname) WidgetClass c; char *name; + Object sname; { + register CLASS_INFO *p; + register CALLBACK_INFO *q; + PFX2S conv; + + for (p = ctab; p < clast; p++) + if (p->class == c) { + for (q = p->cb; q < p->cblast; q++) + if (streq (q->name, name)) { + if (q->has_arg) { + char s1[128], s2[128], msg[256]; + + /* First look for a class specific converter + * then for a general one. Callback converters + * have a prefix "callback:" to avoid name conflicts + * with converters for normal resources. + */ + sprintf (s1, "callback:%s-%s", p->name, name); + conv = Find_Converter_To_Scheme (s1); + if (conv == 0) { + sprintf(s2, "callback:%s", name); + conv = Find_Converter_To_Scheme (s2); + if (conv == 0) { + sprintf (msg, + "no callback converter for %s or %s", + s1, s2, name); + Primitive_Error (msg); + } + } + return conv; + } else return (PFX2S)0; + } + Primitive_Error ("no such callback: ~s", sname); + } + Primitive_Error ("undefined widget class ~s", Xt_Class_Name (c)); + /*NOTREACHED*/ +} + +elk_init_xt_class () { + Generic_Define (Class, "class", "class?"); + Define_Primitive (P_Find_Class, "find-class", 1, 1, EVAL); + Define_Primitive (P_Class_Resources, "class-resources", 1, 1, EVAL); + Define_Primitive (P_Class_Constraint_Resources, + "class-constraint-resources", 1, 1, EVAL); + Define_Primitive (P_Class_Sub_Resources, + "class-sub-resources", 1, 1, EVAL); + Define_Primitive (P_Class_Existsp, "class-exists?", 1, 1, EVAL); + /* + * Doesn't work with Motif-1.1.0: + * + Define_Class ("simple", simpleWidgetClass, (XtResourceList)0, 0); + */ + Define_Class ("core", widgetClass, (XtResourceList)0, 0); + Define_Class ("constraint", constraintWidgetClass, (XtResourceList)0, 0); + Define_Class ("composite", compositeWidgetClass, (XtResourceList)0, 0); +} diff --git a/lib/xt/classname.c b/lib/xt/classname.c new file mode 100644 index 0000000..a7f733d --- /dev/null +++ b/lib/xt/classname.c @@ -0,0 +1,9 @@ +#include "xt.h" + +#include +#include + +Object Xt_Class_Name (class) WidgetClass class; { + return Make_String (class->core_class.class_name, + strlen (class->core_class.class_name)); +} diff --git a/lib/xt/context.c b/lib/xt/context.c new file mode 100644 index 0000000..6990ff4 --- /dev/null +++ b/lib/xt/context.c @@ -0,0 +1,283 @@ +#include "xt.h" + +static SYMDESCR XtIM_Syms[] = { + { "x-event", XtIMXEvent }, + { "timer", XtIMTimer }, + { "alternate-input", XtIMAlternateInput }, + { 0, 0 } +}; + +static SYMDESCR XtInputMask_Syms[] = { + { "read", XtInputReadMask }, + { "write", XtInputWriteMask }, + { "exception", XtInputExceptMask }, + { 0, 0 } +}; + +static Object P_Destroy_Context(); + +Generic_Predicate (Context) + +Generic_Equal (Context, CONTEXT, context) + +Generic_Print (Context, "#[context %lu]", POINTER(x)) + +static Object Internal_Make_Context (finalize, context) XtAppContext context; { + Object c; + + c = Find_Object (T_Context, (GENERIC)0, Match_Xt_Obj, context); + if (Nullp (c)) { + c = Alloc_Object (sizeof (struct S_Context), T_Context, 0); + CONTEXT(c)->tag = Null; + CONTEXT(c)->context = context; + CONTEXT(c)->free = 0; + Register_Object (c, (GENERIC)0, + finalize ? P_Destroy_Context : (PFO)0, 1); + XtAppSetWarningHandler (context, Xt_Warning); + XtAppAddActionHook (context, (XtActionHookProc)Action_Hook, + (XtPointer)0); + } + return c; +} + +/* Backwards compatibility: */ +Object Make_Context (context) XtAppContext context; { + return Internal_Make_Context (1, context); +} + +Object Make_Context_Foreign (context) XtAppContext context; { + return Internal_Make_Context (0, context); +} + +void Check_Context (c) Object c; { + Check_Type (c, T_Context); + if (CONTEXT(c)->free) + Primitive_Error ("invalid context: ~s", c); +} + +static Object P_Create_Context () { + return Make_Context (XtCreateApplicationContext ()); +} + +static Object P_Destroy_Context (c) Object c; { + Check_Context (c); + Free_Actions (CONTEXT(c)->context); + XtDestroyApplicationContext (CONTEXT(c)->context); + CONTEXT(c)->free = 1; + Deregister_Object (c); + return Void; +} + +static Object P_Initialize_Display (c, d, name, class) + Object c, d, name, class; { + register char *sn = 0, *sc = "", *sd = 0; + Display *dpy; + extern char **Argv; + extern First_Arg, Argc; + int argc = Argc - First_Arg + 1; + + Argv[First_Arg-1] = "elk"; + Check_Context (c); + if (!EQ(name, False)) + sn = Get_Strsym (name); + if (!EQ(class, False)) + sc = Get_Strsym (class); + if (TYPE(d) == T_Display) { + XtDisplayInitialize (CONTEXT(c)->context, DISPLAY(d)->dpy, + sn, sc, (XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]); + Argc = First_Arg + argc; + return Void; + } + if (!EQ(d, False)) + sd = Get_Strsym (d); + dpy = XtOpenDisplay (CONTEXT(c)->context, sd, sn, sc, + (XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]); + Argc = First_Arg + argc - 1; + if (dpy == 0) + if (sd) + Primitive_Error ("cannot open display ~s", d); + else + Primitive_Error ("cannot open display"); + return Make_Display (0, dpy); +} + +/* Due to a bug in Xt this function drops core when invoked with a + * display not owned by Xt. + */ +static Object P_Display_To_Context (d) Object d; { + Check_Type (d, T_Display); + return + Make_Context_Foreign (XtDisplayToApplicationContext (DISPLAY(d)->dpy)); +} + +static Object P_Set_Context_Fallback_Resources (argc, argv) Object *argv; { + register char **p = 0; + register i; + struct S_String *sp; + Object con; + + con = argv[0]; + Check_Context (con); + if (argc > 1) { + argv++; argc--; + p = (char **)XtMalloc ((argc+1) * sizeof (char *)); + for (i = 0; i < argc; i++) { + Check_Type (argv[i], T_String); + sp = STRING(argv[i]); + p[i] = XtMalloc (sp->size + 1); + bcopy (sp->data, p[i], sp->size); + p[i][sp->size] = 0; + } + p[i] = 0; + } + XtAppSetFallbackResources (CONTEXT(con)->context, p); + return Void; +} + +static Object P_Context_Main_Loop (c) Object c; { + Check_Context (c); + XtAppMainLoop (CONTEXT(c)->context); + /*NOTREACHED*/ +} + +static Object P_Context_Pending (c) Object c; { + Check_Context (c); + return Bits_To_Symbols ((unsigned long)XtAppPending (CONTEXT(c)->context), + 1, XtIM_Syms); +} + +static Object P_Context_Process_Event (argc, argv) Object *argv; { + XtInputMask mask = XtIMAll; + + Check_Context (argv[0]); + if (argc == 2) + mask = (XtInputMask)Symbols_To_Bits (argv[1], 1, XtIM_Syms); + XtAppProcessEvent (CONTEXT(argv[0])->context, mask); + return Void; +} + +static Boolean Work_Proc (client_data) XtPointer client_data; { + Object ret; + + ret = Funcall (Get_Function ((int)client_data), Null, 0); + if (Truep (ret)) + Deregister_Function ((int)client_data); + return Truep (ret); +} + +static Object P_Context_Add_Work_Proc (c, p) Object c, p; { + XtWorkProcId id; + register i; + + Check_Context (c); + Check_Procedure (p); + i = Register_Function (p); + id = XtAppAddWorkProc (CONTEXT(c)->context, Work_Proc, (XtPointer)i); + return Make_Id ('w', (XtPointer)id, i); +} + +static Object P_Remove_Work_Proc (id) Object id; { + XtRemoveWorkProc ((XtWorkProcId)Use_Id (id, 'w')); + Deregister_Function (IDENTIFIER(id)->num); + return Void; +} + +static void Timeout_Proc (client_data, id) + XtPointer client_data; XtIntervalId *id; { + Object proc, args; + register i = (int)client_data; + + args = Cons (Make_Id ('t', (XtPointer)*id, i), Null); + proc = Get_Function (i); + Deregister_Function (i); + (void)Funcall (proc, args, 0); +} + +static Object P_Context_Add_Timeout (c, n, p) Object c, n, p; { + XtIntervalId id; + register i; + + Check_Context (c); + Check_Procedure (p); + i = Register_Function (p); + id = XtAppAddTimeOut (CONTEXT(c)->context, (unsigned long)Get_Long (n), + Timeout_Proc, (XtPointer)i); + return Make_Id ('t', (XtPointer)id, i); +} + +static Object P_Remove_Timeout (id) Object id; { + XtRemoveTimeOut ((XtIntervalId)Use_Id (id, 't')); + Deregister_Function (IDENTIFIER(id)->num); + return Void; +} + +/*ARGSUSED*/ +static void Input_Proc (client_data, src, id) XtPointer client_data; int *src; + XtInputId *id; { + Object p, args; + GC_Node2; + + p = Get_Function ((int)client_data); + args = Null; + GC_Link2 (p, args); + args = Cons (Make_Id ('i', (XtPointer)*id, (int)client_data), Null); + args = Cons (Car (p), args); + GC_Unlink; + (void)Funcall (Cdr (p), args, 0); +} + +static Object P_Context_Add_Input (argc, argv) Object *argv; { + Object c, src, p; + XtInputId id; + XtInputMask m; + register i; + + c = argv[0], src = argv[1], p = argv[2]; + Check_Context (c); + Check_Procedure (p); + Check_Type (src, T_Port); + if (!(PORT(src)->flags & P_OPEN)) + Primitive_Error ("port has been closed: ~s", src); + if (PORT(src)->flags & P_STRING) + Primitive_Error ("invalid port: ~s", src); + if (argc == 4) { + m = Symbols_To_Bits (argv[3], 1, XtInputMask_Syms); + } else { + switch (PORT(src)->flags & (P_INPUT|P_BIDIR)) { + case 0: m = XtInputWriteMask; break; + case P_INPUT: m = XtInputReadMask; break; + default: m = XtInputReadMask|XtInputWriteMask; break; + } + } + i = Register_Function (Cons (src, p)); + id = XtAppAddInput (CONTEXT(c)->context, fileno (PORT(src)->file), + (XtPointer)m, Input_Proc, (XtPointer)i); + return Make_Id ('i', (XtPointer)id, i); +} + +static Object P_Remove_Input (id) Object id; { + XtRemoveInput ((XtInputId)Use_Id (id, 'i')); + Deregister_Function (IDENTIFIER(id)->num); + return Void; +} + +elk_init_xt_context () { + Generic_Define (Context, "context", "context?"); + Define_Primitive (P_Create_Context, "create-context", 0, 0, EVAL); + Define_Primitive (P_Destroy_Context, "destroy-context", 1, 1, EVAL); + Define_Primitive (P_Initialize_Display, "initialize-display", 4, 4, EVAL); + Define_Primitive (P_Display_To_Context, "display->context", 1, 1, EVAL); + Define_Primitive (P_Set_Context_Fallback_Resources, + "set-context-fallback-resources!", 1, MANY, VARARGS); + Define_Primitive (P_Context_Main_Loop, "context-main-loop", 1, 1, EVAL); + Define_Primitive (P_Context_Pending, "context-pending", 1, 1, EVAL); + Define_Primitive (P_Context_Process_Event, + "context-process-event", 1, 2, VARARGS); + Define_Primitive (P_Context_Add_Work_Proc, + "context-add-work-proc", 2, 2, EVAL); + Define_Primitive (P_Remove_Work_Proc, "remove-work-proc", 1, 1, EVAL); + Define_Primitive (P_Context_Add_Timeout,"context-add-timeout",3, 3, EVAL); + Define_Primitive (P_Remove_Timeout, "remove-timeout", 1, 1, EVAL); + Define_Primitive (P_Context_Add_Input, "context-add-input",3, 4, VARARGS); + Define_Primitive (P_Remove_Input, "remove-input", 1, 1, EVAL); +} diff --git a/lib/xt/converter.c b/lib/xt/converter.c new file mode 100644 index 0000000..8ac35c9 --- /dev/null +++ b/lib/xt/converter.c @@ -0,0 +1,50 @@ +#include "xt.h" + +#define MAX_CONVERTER 512 + +typedef struct { + char *name; + int scheme_to_c; + PFX2S to_scheme; + PFS2X to_c; +} CONVERTER; + +static CONVERTER ctab[MAX_CONVERTER], *clast = ctab; + +void Define_Converter_To_Scheme (name, c) char *name; PFX2S c; { + Set_Error_Tag ("c->scheme"); + if (clast == ctab+MAX_CONVERTER) + Primitive_Error ("too many converters"); + clast->name = name; + clast->scheme_to_c = 0; + clast->to_scheme = c; + clast++; +} + +void Define_Converter_To_C (name, c) char *name; PFS2X c; { + Set_Error_Tag ("scheme->c"); + if (clast == ctab+MAX_CONVERTER) + Primitive_Error ("too many converters"); + clast->name = name; + clast->scheme_to_c = 1; + clast->to_c = c; + clast++; +} + +PFX2S Find_Converter_To_Scheme (name) char *name; { + register CONVERTER *p; + + for (p = ctab; p < clast; p++) + if (!p->scheme_to_c && streq (p->name, name)) + return p->to_scheme; + return 0; +} + +PFS2X Find_Converter_To_C (name) char *name; { + register CONVERTER *p; + + for (p = ctab; p < clast; p++) + if (p->scheme_to_c && streq (p->name, name)) + return p->to_c; + return 0; +} diff --git a/lib/xt/error.c b/lib/xt/error.c new file mode 100644 index 0000000..3c2626b --- /dev/null +++ b/lib/xt/error.c @@ -0,0 +1,19 @@ +#include "xt.h" + +static Object V_Xt_Warning_Handler; + +void Xt_Warning (msg) char *msg; { + Object args, fun; + + args = Cons (Make_String (msg, strlen (msg)), Null); + fun = Var_Get (V_Xt_Warning_Handler); + if (TYPE(fun) == T_Compound) + (void)Funcall (fun, args, 0); + Format (Curr_Output_Port, msg, strlen (msg), 0, (Object *)0); + (void)P_Newline (0, (Object *)0); +} + +elk_init_xt_error () { + Define_Variable (&V_Xt_Warning_Handler, "xt-warning-handler", Null); + XtSetWarningHandler (Xt_Warning); +} diff --git a/lib/xt/function.c b/lib/xt/function.c new file mode 100644 index 0000000..5507049 --- /dev/null +++ b/lib/xt/function.c @@ -0,0 +1,37 @@ +#include "xt.h" + +static max_functions = 512; +static Object Functions; + +int Register_Function (x) Object x; { + register i; + Object v; + GC_Node; + + for (i = 0; i < max_functions; i++) + if (Nullp (VECTOR(Functions)->data[i])) break; + if (i == max_functions) { + max_functions *= 2; + GC_Link (x); + v = Make_Vector (max_functions, Null); + GC_Unlink; + bcopy ((char *)VECTOR(Functions)->data, (char *)VECTOR(v)->data, + i * sizeof (Object)); + Functions = v; + } + VECTOR(Functions)->data[i] = x; + return i; +} + +Object Get_Function (i) int i; { + return VECTOR(Functions)->data[i]; +} + +void Deregister_Function (i) int i; { + VECTOR(Functions)->data[i] = Null; +} + +elk_init_xt_function () { + Functions = Make_Vector (max_functions, Null); + Global_GC_Link (Functions); +} diff --git a/lib/xt/identifier.c b/lib/xt/identifier.c new file mode 100644 index 0000000..15ff42c --- /dev/null +++ b/lib/xt/identifier.c @@ -0,0 +1,40 @@ + +#include "xt.h" + +Generic_Predicate (Identifier) + +static Identifier_Equal (x, y) Object x, y; { + register struct S_Identifier *p = IDENTIFIER(x), *q = IDENTIFIER(y); + return p->type == q->type && p->val == q->val && !p->free && !q->free; +} + +Generic_Print (Identifier, "#[identifier %lu]", POINTER(x)) + +Object Make_Id (type, val, num) XtPointer val; { + Object i; + + i = Find_Object (T_Identifier, (GENERIC)0, Match_Xt_Obj, type, val); + if (Nullp (i)) { + i = Alloc_Object (sizeof (struct S_Identifier), T_Identifier, 0); + IDENTIFIER(i)->tag = Null; + IDENTIFIER(i)->type = type; + IDENTIFIER(i)->val = val; + IDENTIFIER(i)->num = num; + IDENTIFIER(i)->free = 0; + Register_Object (i, (GENERIC)0, (PFO)0, 0); + } + return i; +} + +XtPointer Use_Id (x, type) Object x; { + Check_Type (x, T_Identifier); + if (IDENTIFIER(x)->type != type || IDENTIFIER(x)->free) + Primitive_Error ("invalid identifier"); + IDENTIFIER(x)->free = 1; + Deregister_Object (x); + return IDENTIFIER(x)->val; +} + +elk_init_xt_identifier () { + Generic_Define (Identifier, "identifier", "identifier?"); +} diff --git a/lib/xt/init.c b/lib/xt/init.c new file mode 100644 index 0000000..42e6ba7 --- /dev/null +++ b/lib/xt/init.c @@ -0,0 +1,47 @@ +#include "xt.h" + +static Object P_Xt_Release_4_Or_Laterp () { + return True; +} + +static Object P_Xt_Release_5_Or_Laterp () { +#ifdef XT_RELEASE_5_OR_LATER + return True; +#else + return False; +#endif +} + +static Object P_Xt_Release_6_Or_Laterp () { +#ifdef XT_RELEASE_6_OR_LATER + return True; +#else + return False; +#endif +} + +extern WidgetClass vendorShellWidgetClass; + +/* The reference to vendorShellWidgetClass is required to make sure + * that the linker pulls the vendor shell definition from libXaw, + * not from libXt. It's passed to a dummy function to make sure that + * it isn't removed by the optimizer. + */ + +static dummy (w) WidgetClass w; { +} + +elk_init_xt_init () { + extern WidgetClass vendorShellWidgetClass; + + dummy(vendorShellWidgetClass); + + Define_Primitive (P_Xt_Release_4_Or_Laterp, "xt-release-4-or-later?", + 0, 0, EVAL); + Define_Primitive (P_Xt_Release_5_Or_Laterp, "xt-release-5-or-later?", + 0, 0, EVAL); + Define_Primitive (P_Xt_Release_6_Or_Laterp, "xt-release-6-or-later?", + 0, 0, EVAL); + XtToolkitInitialize (); + P_Provide (Intern ("xt.o")); +} diff --git a/lib/xt/mkwidget.scm b/lib/xt/mkwidget.scm new file mode 100644 index 0000000..10ff0e3 --- /dev/null +++ b/lib/xt/mkwidget.scm @@ -0,0 +1,197 @@ +;;; -*-Scheme-*- + +(define type-name #f) + +(define classes '()) +(define callbacks '()) +(define primitives '()) +(define converters '()) + +(define f) + +(define (check-string proc x name) + (if (not (memq (type x) '(symbol string))) + (error proc (format #f "~s must be string or symbol" name)))) + +(define (define-widget-type name include) + (if type-name + (error 'define-widget-type "must be called once")) + (check-string 'define-widget-type name 'name) + (if (pair? include) + (for-each + (lambda (i) (check-string 'define-widget-type i 'include)) include) + (check-string 'define-widget-type include 'include)) + (set! type-name name) + (format f "#include \"../xt/xt.h\"~%") + (case widget-set + (xm + (format f "#include ~%"))) + (if (and (not (eqv? include "")) (not (null? include))) + (begin + (define dir) + (case widget-set + (xm + (set! dir "Xm")) + (xaw + (set! dir "X11/Xaw"))) + (if (pair? include) + (for-each + (lambda (i) + (if (char=? (string-ref (format #f "~a" i) 0) #\<) + (format f "#include ~a~%" i) + (format f "#include <~a/~a>~%" dir i))) + include) + (if (char=? (string-ref (format #f "~a" include) 0) #\<) + (format f "#include ~a~%" include) + (format f "#include <~a/~a>~%" dir include))))) + (newline f)) + +(define (prolog code) + (if (not type-name) + (error 'prolog "must define a widget-type first")) + (check-string 'prolog code 'code) + (display code f) + (format f "~%~%")) + +(define (define-callback class name has-arg?) + (check-string 'define-callback class 'class) + (check-string 'define-callback name 'name) + (if (not (boolean? has-arg?)) + (error 'define-callback "has-arg? must be boolean")) + (set! callbacks (cons (list class name has-arg?) callbacks))) + +(define (c->scheme name body) + (check-string 'c->scheme name 'name) + (define c-name (scheme-to-c-name name)) + (string-set! c-name 0 #\S) + (format f "static Object ~a (x) XtArgVal x; {~%" c-name) + (display body f) + (format f "~%}~%~%") + (define s + (format #f " Define_Converter_To_Scheme (\"~a\", ~a);~%" + name c-name)) + (set! converters (cons s converters))) + +(define (scheme->c name body) + (check-string 'scheme->c name 'name) + (define c-name (scheme-to-c-name name)) + (string-set! c-name 0 #\C) + (format f "static XtArgVal ~a (x) Object x; {~%" c-name) + (display body f) + (format f "~%}~%~%") + (define s + (format #f " Define_Converter_To_C (\"~a\", ~a);~%" + name c-name)) + (set! converters (cons s converters))) + +(define (define-primitive scheme-name args body) + (check-string 'define-primitive scheme-name 'scheme-name) + (if (not (pair? args)) + (error 'define-primitive "args must be a list")) + (define c-name (scheme-to-c-name scheme-name)) + (format f "static Object ~a (" c-name) + (do ((a args a)) ((null? a)) + (display (car a) f) + (set! a (cdr a)) + (if (not (null? a)) (display ", " f))) + (display ") " f) + (if (not (null? args)) + (begin + (display "Object " f) + (do ((a args a)) ((null? a)) + (display (car a) f) + (set! a (cdr a)) + (if (not (null? a)) (display ", " f))) + (display "; {" f))) + (newline f) + (display body f) + (format f "~%}~%~%") + (define s + (format #f " Define_Primitive (~a, \"~a\", ~a, ~a, EVAL);~%" + c-name scheme-name (length args) (length args))) + (set! primitives (cons s primitives))) + +;;; [missing conversion from -> to "to"] +(define (scheme-to-c-name s) + (if (symbol? s) + (set! s (symbol->string s))) + (define len (string-length s)) + (if (char=? (string-ref s (1- len)) #\?) + (string-set! s (1- len) #\p)) + (if (char=? (string-ref s (1- len)) #\!) + (set! len (1- len))) + (let loop ((ret "P") (i 0)) + (if (>= i len) + ret + (define next + (do ((j i (1+ j))) + ((or (= j len) (memq (string-ref s j) '(#\- #\:))) j))) + (loop (format #f "~a_~a~a" ret (char-upcase (string-ref s i)) + (substring s (1+ i) next)) (1+ next))))) + +(define (define-widget-class name class . sub-resources) + (check-string 'define-widget-class name 'name) + (check-string 'define-widget-class class 'class) + (set! classes (cons (list name class sub-resources) classes))) + +(define (filename-to-widget-name fn) + (let loop ((w widget-aliases)) + (cond + ((null? w) + fn) + ((eq? (cdar w) fn) + (caar w)) + (else + (loop (cdr w)))))) + +(define (feature-name fn) + (let ((i (substring? ".d" fn))) + (if (not i) + (error 'mkwidget "bad filename suffix in ~a (expected .d)" fn)) + (filename-to-widget-name (string->symbol (substring fn 0 i))))) + +(define widget-aliases) +(load 'ALIASES) + +(define args (command-line-args)) +(if (not (= (length args) 3)) + (error 'mkwidget "expected three arguments")) +(define widget-set (string->symbol (caddr args))) +(set! f (open-output-file (cadr args))) +(load (car args)) +(if (not type-name) + (error 'mkwidget "no widget type defined")) +(format f "elk_init_~a_~a () {~%" widget-set type-name) +(if (not (null? classes)) + (format f " XtResourceList r = 0;~%")) +(do ((c classes (cdr c))) ((null? c)) + (define cl (car c)) + (define res (caddr cl)) + (if (not (null? res)) + (begin + (format f + " r = (XtResourceList)XtMalloc (~a * sizeof (XtResource));~%" + (length res)) + (do ((r res (cdr r)) (num 0 (1+ num))) ((null? r)) + (define x (car r)) + (if (not (= (length x) 3)) + (error 'mkwidget "bad sub-resource declaration")) + (for-each + (lambda (r) + (if (not (memq (type r) '(symbol string))) + (error 'mkwidget "bad type in sub-resource declaration"))) + x) + (format f " r[~a].resource_name = \"~a\";~%" num (car x)) + (format f " r[~a].resource_class = \"~a\";~%" num (cadr x)) + (format f " r[~a].resource_type = \"~a\";~%" num (caddr x))))) + (format f " Define_Class (\"~a\", ~a, r, ~a);~%" (car cl) (cadr cl) + (length res))) +(do ((c callbacks (cdr c))) ((null? c)) + (define cb (car c)) + (format f " Define_Callback (\"~a\", \"~a\", ~a);~%" (car cb) (cadr cb) + (if (caddr cb) 1 0))) +(for-each (lambda (x) (display x f)) primitives) +(for-each (lambda (x) (display x f)) converters) +(format f " P_Provide(Intern(\"~a:~a.o\"));~%" widget-set + (feature-name (car args))) +(format f "}~%") diff --git a/lib/xt/objects.c b/lib/xt/objects.c new file mode 100644 index 0000000..db05124 --- /dev/null +++ b/lib/xt/objects.c @@ -0,0 +1,19 @@ +#include + +#include "xt.h" + +Match_Xt_Obj (x, v) Object x; va_list v; { + register type = TYPE(x); + + if (type == T_Context) { + return va_arg (v, XtAppContext) == CONTEXT(x)->context; + } else if (type == T_Class) { + return va_arg (v, WidgetClass) == CLASS(x)->wclass; + } else if (type == T_Widget) { + return va_arg (v, Widget) == WIDGET(x)->widget; + } else if (type == T_Identifier) { + return va_arg (v, int) == IDENTIFIER(x)->type + && va_arg (v, XtPointer) == IDENTIFIER(x)->val; + } else Panic ("Match_Xt_Obj"); + return 0; +} diff --git a/lib/xt/popup.c b/lib/xt/popup.c new file mode 100644 index 0000000..ddd44bf --- /dev/null +++ b/lib/xt/popup.c @@ -0,0 +1,52 @@ +#include "xt.h" + +static SYMDESCR Grab_Kind_Syms[] = { + { "grab-none", XtGrabNone }, + { "grab-nonexclusive", XtGrabNonexclusive }, + { "grab-exclusive", XtGrabExclusive }, + { 0, 0 } +}; + +static Object P_Create_Popup_Shell (argc, argv) Object *argv; { + ArgList a; + char *name = 0; + Object x, class, parent, ret; + Alloca_Begin; + + x = argv[0]; + if (TYPE(x) != T_Class) { + name = Get_Strsym (x); + argv++; argc--; + } + class = argv[0]; + parent = argv[1]; + Check_Type (class, T_Class); + Check_Widget (parent); + if (name == 0) + name = CLASS(class)->name; + Encode_Arglist (argc-2, argv+2, a, (Widget)0, CLASS(class)->wclass); + ret = Make_Widget (XtCreatePopupShell (name, CLASS(class)->wclass, + WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2)); + Alloca_End; + return ret; +} + +static Object P_Popup (shell, grab_kind) Object shell, grab_kind; { + Check_Widget (shell); + XtPopup (WIDGET(shell)->widget, Symbols_To_Bits (grab_kind, 0, + Grab_Kind_Syms)); + return Void; +} + +static Object P_Popdown (shell) Object shell; { + Check_Widget (shell); + XtPopdown (WIDGET(shell)->widget); + return Void; +} + +elk_init_xt_popup () { + Define_Primitive (P_Create_Popup_Shell, "create-popup-shell", + 2, MANY, VARARGS); + Define_Primitive (P_Popup, "popup", 2, 2, EVAL); + Define_Primitive (P_Popdown, "popdown", 1, 1, EVAL); +} diff --git a/lib/xt/resource.c b/lib/xt/resource.c new file mode 100644 index 0000000..bbf0992 --- /dev/null +++ b/lib/xt/resource.c @@ -0,0 +1,436 @@ +#include "xt.h" + +#include + +#define XtRChar "Char" +#define XtRGC "GC" +#define XtRBackingStore "BackingStore" + +#define T_Unknown -1 +#define T_String_Or_Symbol -2 +#define T_Callbacklist -3 +#define T_Float -4 +#define T_Backing_Store -5 +#define T_Dimension -6 +#define T_Translations -7 +#define T_Position -8 +#define T_Bitmap -9 +#define T_Cardinal -10 +#define T_Accelerators -11 + +static Resource_To_Scheme_Type (t) register char *t; { + if (streq (XtRAcceleratorTable, t)) + return T_Accelerators; + else if (streq (XtRBackingStore, t)) + return T_Backing_Store; + else if (streq (XtRBitmap, t)) + return T_Bitmap; + else if (streq (XtRBoolean, t)) + return T_Boolean; + else if (streq (XtRCallback, t)) + return T_Callbacklist; + else if (streq (XtRCardinal, t)) + return T_Cardinal; + else if (streq (XtRColormap, t)) + return T_Colormap; + else if (streq (XtRCursor, t)) + return T_Cursor; + else if (streq (XtRDimension, t)) + return T_Dimension; + else if (streq (XtRDisplay, t)) + return T_Display; + else if (streq (XtRFloat, t)) + return T_Float; + else if (streq (XtRFont, t)) + return T_Font; + else if (streq (XtRFontStruct, t)) + return T_Font; + else if (streq (XtRGC, t)) + return T_Gc; + else if (streq (XtRInt, t)) + return T_Fixnum; + else if (streq (XtRPixel, t)) + return T_Pixel; + else if (streq (XtRPixmap, t)) + return T_Pixmap; + else if (streq (XtRPosition, t)) + return T_Position; + else if (streq (XtRShort, t)) + return T_Fixnum; + else if (streq (XtRString, t)) + return T_String_Or_Symbol; + else if (streq (XtRTranslationTable, t)) + return T_Translations; + else if (streq (XtRUnsignedChar, t)) + return T_Character; + else if (streq (XtRChar, t)) + return T_Character; + else if (streq (XtRWidget, t)) + return T_Widget; + else if (streq (XtRWindow, t)) + return T_Window; + return T_Unknown; +} + +void Get_All_Resources (sub, w, c, rp, np, cp) Widget w; WidgetClass c; + XtResource **rp; int *np, *cp; { + XtResource *r, *sr, *cr; + int nr, snr = 0, cnr = 0; + + XtGetResourceList (c, &r, (Cardinal *)&nr); + if (sub) + Get_Sub_Resource_List (c, &sr, (Cardinal *)&snr); + if (w && XtParent (w)) + XtGetConstraintResourceList (XtClass (XtParent (w)), &cr, + (Cardinal *)&cnr); + *np = nr + snr + cnr; + *cp = cnr; + *rp = (XtResource *)XtMalloc (*np * sizeof (XtResource)); + bcopy ((char *)r, (char *)*rp, nr * sizeof (XtResource)); + XtFree ((char *)r); + if (snr) + bcopy ((char *)sr, (char *)(*rp + nr), snr * sizeof (XtResource)); + if (cnr) { + bcopy ((char *)cr, (char *)(*rp + nr+snr), cnr * sizeof (XtResource)); + XtFree ((char *)cr); + } +} + +void Convert_Args (ac, av, to, widget, class) Object *av; ArgList to; + Widget widget; WidgetClass class; { + register char *name, *res; + register i, j, k; + Object arg, val; + XtResource *r; + int nr, nc; + int st, dt; + char key[128]; + PFS2X converter; + char *stmp; + XrmValue src, dst; + Alloca_Begin; + + if (ac & 1) + Primitive_Error ("missing argument value"); + Get_All_Resources (1, widget, class, &r, &nr, &nc); + /* Note: + * `r' is not freed in case of error. + */ + for (i = k = 0; k < ac; i++, k++) { + arg = av[k]; + Get_Strsym_Stack (arg, name); + Make_Resource_Name (name); + for (j = 0; j < nr && !streq (name, r[j].resource_name); j++) + ; + if (j == nr) + Primitive_Error ("no such resource: ~s", arg); + if (streq (r[j].resource_class, XtCReadOnly)) + Primitive_Error ("resource is read-only: ~s", arg); + res = r[j].resource_name; + val = av[++k]; + st = TYPE(val); + dt = Resource_To_Scheme_Type (r[j].resource_type); + + /* First look for widget class specific converter for + * this resource, then look for a general converter + * (first try the name of the resource, then the type): + */ + if (widget && j >= nr-nc) + class = XtClass (XtParent (widget)); + sprintf (key, "%s-%s", Class_Name (class), name); + converter = Find_Converter_To_C (key); + if (converter || (converter = Find_Converter_To_C (res)) + || (converter = Find_Converter_To_C (r[j].resource_type))) { + XtArgVal ret = converter (val); + XtSetArg (to[i], res, ret); + } else if (dt == T_String_Or_Symbol) { + Get_Strsym_Stack (val, stmp); + XtSetArg (to[i], res, XtNewString (stmp)); /* Never freed! */ + } else if (dt == T_Callbacklist) { + int n; + XtCallbackList callbacks; + + Check_Callback_List (val); + n = Fast_Length (val); + callbacks = (XtCallbackRec *) /* Never freed! */ + XtMalloc ((n+1) * sizeof (XtCallbackRec)); + callbacks[n].callback = 0; + callbacks[n].closure = 0; + Fill_Callbacks (val, callbacks, n, + Find_Callback_Converter (class, name, arg)); + XtSetArg (to[i], res, callbacks); + } else if (dt == T_Float) { + float f = (float)Get_Double (val); + to[i].name = res; + bcopy ((char *)&f, (char *)&to[i].value, sizeof f); + } else if (dt == T_Dimension || dt == T_Position || dt == T_Cardinal + || dt == T_Fixnum) { + XtSetArg (to[i], res, Get_Integer (val)); + } else if (dt == T_Backing_Store) { + XtSetArg (to[i], res, Symbols_To_Bits (val, 0, + Backing_Store_Syms)); + } else if (dt == T_Translations) { + XtSetArg (to[i], res, Get_Translations (val)); + } else if (dt == T_Accelerators) { + XtSetArg (to[i], res, Get_Accelerators (val)); + } else if ((dt == T_Bitmap || dt == T_Pixmap) && EQ(val, Sym_None)) { + XtSetArg (to[i], res, None); + } else if (dt == T_Bitmap) { + /* Should check depth here (must be 1), but how? */ + XtSetArg (to[i], res, Get_Pixmap (val)); + } else { + if (st != dt) { + char msg[128]; + + /* Try to let XtConvert() do the conversion. + */ + if (widget && (st == T_String || st == T_Symbol)) { + Get_Strsym_Stack (val, stmp); + src.size = strlen (stmp); + src.addr = (caddr_t)stmp; + XtConvert (widget, (String)XtRString, &src, + r[j].resource_type, &dst); + if (dst.addr) { + if (dst.size == (sizeof (unsigned char))) { + XtSetArg (to[i], res, *(unsigned char *)dst.addr); + } else if (dst.size == sizeof (int)) { + XtSetArg (to[i], res, *(int *)dst.addr); + } else if (dst.size == sizeof (XtArgVal)) { + XtSetArg (to[i], res, *(XtArgVal *)dst.addr); + } else { + sprintf (msg, + "%s: converter for %s returned weird size %d", + name, r[j].resource_type, dst.size); + Primitive_Error (msg); + } + goto done; + } + } + sprintf (msg, "%s: can't convert %s ~s to %s", name, + Types[st].name, r[j].resource_type); + Primitive_Error (msg, val); + } + if (dt == T_Boolean) { + XtSetArg (to[i], res, EQ(val, True)); + } else if (dt == T_Colormap) { + XtSetArg (to[i], res, COLORMAP(val)->cm); + } else if (dt == T_Cursor) { + XtSetArg (to[i], res, CURSOR(val)->cursor); + } else if (dt == T_Display) { + XtSetArg (to[i], res, DISPLAY(val)->dpy); + } else if (dt == T_Font) { + Open_Font_Maybe (val); + if (streq (r[j].resource_type, XtRFontStruct)) + XtSetArg (to[i], res, FONT(val)->info); + else + XtSetArg (to[i], res, FONT(val)->id); + } else if (dt == T_Pixel) { + XtSetArg (to[i], res, PIXEL(val)->pix); + } else if (dt == T_Pixmap) { + XtSetArg (to[i], res, PIXMAP(val)->pm); + } else if (dt == T_Gc) { + XtSetArg (to[i], res, GCONTEXT(val)->gc); + } else if (dt == T_Character) { + XtSetArg (to[i], res, CHAR(val)); + } else if (dt == T_Widget) { + XtSetArg (to[i], res, WIDGET(val)->widget); + } else if (dt == T_Window) { + XtSetArg (to[i], res, WINDOW(val)->win); + } else Panic ("bad conversion type"); + } +done: ; + } + Alloca_End; + XtFree ((char *)r); +} + +Object Get_Values (w, ac, av) Widget w; Object *av; { + register char *name; + register i, j; + Object arg; + XtResource *r; + int nr, nc; + int t; + ArgList argl; + Object ret, tail; + Display *dpy; + char key[128]; + PFX2S converter; + Widget w2; + GC_Node2; + Alloca_Begin; + + Alloca (argl, Arg*, ac * sizeof (Arg)); + Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc); + /* Note: + * `r' is not freed in case of error. + */ + for (i = 0; i < ac; i++) { + XtArgVal argval; + + arg = av[i]; + Check_Type (arg, T_Symbol); + Get_Strsym_Stack (arg, name); + Make_Resource_Name (name); + for (j = 0; j < nr && !streq (name, r[j].resource_name); j++) + ; + if (j == nr) + Primitive_Error ("no such resource: ~s", arg); + argl[i].name = name; + Alloca (argval, XtArgVal, r[j].resource_size); + argl[i].value = argval; + } + XtGetValues (w, argl, (Cardinal)ac); + ret = tail = P_Make_List (Make_Integer (ac), Null); + GC_Link2 (ret, tail); + /* + * Display is needed for resources like cursor and pixmap. + * XtDisplayOfObject(w) is not necessarily the right one! + */ + dpy = XtDisplayOfObject (w); + for (i = 0; i < ac; i++, tail = Cdr (tail)) { + Object o; + XtArgVal val = argl[i].value; + for (j = 0; j < nr && !streq (argl[i].name, r[j].resource_name); j++) + ; + t = Resource_To_Scheme_Type (r[j].resource_type); + + /* Look for a widget class specific converter, then for a + * general converter (first try the resource name, then the type): + */ + w2 = (j >= nr-nc) ? XtParent (w) : w; + sprintf (key, "%s-%s", Class_Name (XtClass (w2)), argl[i].name); + converter = Find_Converter_To_Scheme (key); + + if (converter) { + o = converter (*(XtArgVal *)val); + } else if (converter = Find_Converter_To_Scheme (argl[i].name)) { + o = converter (*(XtArgVal *)val); + } else if (converter = Find_Converter_To_Scheme (r[j].resource_type)) { + o = converter (*(XtArgVal *)val); + } else if (t == T_String_Or_Symbol) { + char *s = *(char **)val; + + if (s == 0) s = ""; + o = Make_String (s, strlen (s)); + } else if (t == T_Callbacklist) { + register i, n; + Object ret, tail; + XtCallbackList callbacks = *(XtCallbackList *)val; + GC_Node; + + for (n = 0; callbacks[n].callback; n++) + ; + ret = tail = P_Make_List (Make_Integer (n), Null); + GC_Link2 (ret, tail); + for (i = 0; i < n; i++, tail = Cdr (tail)) + Car (tail) = Get_Callbackfun (callbacks[i].closure); + GC_Unlink; + o = ret; + } else if (t == T_Float) { + o = Make_Reduced_Flonum ((double)*(float *)val); + } else if (t == T_Backing_Store) { + o = Bits_To_Symbols ((unsigned long)*(int *)val, 0, + Backing_Store_Syms); + if (Nullp (o)) + Primitive_Error ("invalid backing-store (Xt bug)"); + } else if (t == T_Boolean) { + o = (Boolean)*(Boolean *)val ? True : False; + } else if (t == T_Colormap) { + o = Make_Colormap (0, dpy, *(Colormap *)val); + } else if (t == T_Cursor) { + o = Make_Cursor_Foreign (dpy, *(Cursor *)val); + } else if (t == T_Gc) { + o = Make_Gc (0, dpy, *(GC *)val); + } else if (t == T_Dimension) { + o = Make_Integer (*(Dimension *)val); + } else if (t == T_Position) { + o = Make_Integer (*(Position *)val); + } else if (t == T_Cardinal) { + o = Make_Unsigned (*(Cardinal *)val); + } else if (t == T_Fixnum) { + if (streq (r[j].resource_type, XtRInt)) + o = Make_Integer (*(int *)val); + else + o = Make_Integer (*(short *)val); + } else if (t == T_Display) { + o = Make_Display (0, dpy); + } else if (t == T_Font) { + if (streq (r[j].resource_type, XtRFontStruct)) { + o = Make_Font_Foreign (dpy, False, (Font)0, + *(XFontStruct **)val); + } else { + XFontStruct *info; + Disable_Interrupts; + info = XQueryFont (dpy, *(Font *)val); + Enable_Interrupts; + o = Make_Font_Foreign (dpy, False, *(Font *)val, info); + } + } else if (t == T_Pixel) { + o = Make_Pixel (*(unsigned long *)val); + } else if (t == T_Pixmap || t == T_Bitmap) { + o = Make_Pixmap_Foreign (dpy, *(Pixmap *)val); + } else if (t == T_Character) { + o = Make_Char (*(unsigned char *)val); + } else if (t == T_Widget) { + o = Make_Widget_Foreign (*(Widget *)val); + } else if (t == T_Window) { + o = Make_Window (0, dpy, *(Window *)val); + } else { + char s[128]; + + sprintf (s, "%s: no converter for %s", argl[i].name, + r[j].resource_type); + Primitive_Error (s); + } + Car (tail) = o; + } + XtFree ((char *)r); + GC_Unlink; + return ret; +} + +/* Convert `mapped-when-managed' to `mappedWhenManaged'. + */ +void Make_Resource_Name (s) register char *s; { + register char *p; + + for (p = s; *s; ) { + if (*s == '-') { + if (*++s) { + if (islower (*s)) + *s = toupper (*s); + *p++ = *s++; + } + } else *p++ = *s++; + } + *p = '\0'; +} + +Object Get_Resources (c, fun, freeit) WidgetClass c; void (*fun)(); { + XtResource *r; + register XtResource *p; + int nr; + Object ret, tail, tail2, x; + GC_Node3; + + fun (c, &r, &nr); + /* Note: + * `r' is not freed in case of error. + */ + ret = tail = tail2 = P_Make_List (Make_Integer (nr), Null); + GC_Link3 (ret, tail, tail2); + for (p = r; p < r+nr; p++, tail = Cdr (tail)) { + x = tail2 = P_Make_List (Make_Integer (3), Null); + Car (tail) = tail2 = x; + x = Intern (p->resource_name); + Car (tail2) = x; tail2 = Cdr (tail2); + x = Intern (p->resource_class); + Car (tail2) = x; tail2 = Cdr (tail2); + x = Intern (p->resource_type); + Car (tail2) = x; + } + GC_Unlink; + if (freeit) XtFree ((char *)r); + return ret; +} diff --git a/lib/xt/translation.c b/lib/xt/translation.c new file mode 100644 index 0000000..fb44d15 --- /dev/null +++ b/lib/xt/translation.c @@ -0,0 +1,57 @@ +#include "xt.h" + +XtTranslations Get_Translations (t) Object t; { + register char *s; + XtTranslations ret; + Alloca_Begin; + + Get_Strsym_Stack (t, s); + if ((ret = XtParseTranslationTable (s)) == 0) + Primitive_Error ("bad translation table: ~s", t); + Alloca_End; + return ret; +} + +static Object P_Augment_Translations (w, t) Object w, t; { + Check_Widget (w); + XtAugmentTranslations (WIDGET(w)->widget, Get_Translations (t)); + return Void; +} + +static Object P_Override_Translations (w, t) Object w, t; { + Check_Widget (w); + XtOverrideTranslations (WIDGET(w)->widget, Get_Translations (t)); + return Void; +} + +static Object P_Uninstall_Translations (w) Object w; { + Check_Widget (w); + XtUninstallTranslations (WIDGET(w)->widget); + return Void; +} + +/* Due to a bug in Xt these functions drop core when invoked with a + * display not owned by Xt. + */ +static Object P_Multi_Click_Time (d) Object d; { + Check_Type (d, T_Display); + return Make_Integer (XtGetMultiClickTime (DISPLAY(d)->dpy)); +} + +static Object P_Set_Multi_Click_Time (d, t) Object d, t; { + Check_Type (d, T_Display); + XtSetMultiClickTime (DISPLAY(d)->dpy, Get_Integer (t)); + return Void; +} + +elk_init_xt_translation () { + Define_Primitive (P_Augment_Translations, + "augment-translations", 2, 2, EVAL); + Define_Primitive (P_Override_Translations, + "override-translations", 2, 2, EVAL); + Define_Primitive (P_Uninstall_Translations, + "uninstall-translations", 1, 1, EVAL); + Define_Primitive (P_Multi_Click_Time, "multi-click-time", 1, 1, EVAL); + Define_Primitive (P_Set_Multi_Click_Time, + "set-multi-click-time!", 2, 2, EVAL); +} diff --git a/lib/xt/widget.c b/lib/xt/widget.c new file mode 100644 index 0000000..26e68b8 --- /dev/null +++ b/lib/xt/widget.c @@ -0,0 +1,353 @@ +#include "xt.h" + +extern void XtManageChildren(), XtUnmanageChildren(); + +static Object P_Destroy_Widget(); + +Generic_Predicate (Widget) + +Generic_Equal (Widget, WIDGET, widget) + +Generic_Print (Widget, "#[widget %lu]", POINTER(x)) + +static Object Internal_Make_Widget (finalize, widget) Widget widget; { + Object w; + + if (widget == 0) + return Sym_None; + w = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, widget); + if (Nullp (w)) { + w = Alloc_Object (sizeof (struct S_Widget), T_Widget, 0); + WIDGET(w)->tag = Null; + WIDGET(w)->widget = widget; + WIDGET(w)->free = 0; + XtAddCallback (widget, XtNdestroyCallback, Destroy_Callback_Proc, + (XtPointer)0); + Register_Object (w, (GENERIC)0, + finalize ? P_Destroy_Widget : (PFO)0, 0); + } + return w; +} + +/* Backwards compatibility: */ +Object Make_Widget (widget) Widget widget; { + return Internal_Make_Widget (1, widget); +} + +Object Make_Widget_Foreign (widget) Widget widget; { + return Internal_Make_Widget (0, widget); +} + +void Check_Widget (w) Object w; { + Check_Type (w, T_Widget); + if (WIDGET(w)->free) + Primitive_Error ("invalid widget: ~s", w); +} + +void Check_Widget_Class (w, class) Object w; WidgetClass class; { + Check_Widget (w); + if (XtClass (WIDGET(w)->widget) != class) + Primitive_Error ("widget not of expected class: ~s", w); +} + +static Object P_Destroy_Widget (w) Object w; { + Check_Widget (w); + XtDestroyWidget (WIDGET(w)->widget); + return Void; +} + +static Object P_Create_Shell (argc, argv) Object *argv; { + register char *sn = 0, *sc = 0; + ArgList a; + Object name, class, w, d, ret; + Alloca_Begin; + + name = argv[0], class = argv[1], w = argv[2], d = argv[3]; + if (!EQ(name, False)) + sn = Get_Strsym (name); + if (!EQ(class, False)) + sc = Get_Strsym (class); + Check_Type (w, T_Class); + Check_Type (d, T_Display); + Encode_Arglist (argc-4, argv+4, a, (Widget)0, CLASS(w)->wclass); + ret = Make_Widget (XtAppCreateShell (sn, sc, CLASS(w)->wclass, + DISPLAY(d)->dpy, a, (Cardinal)(argc-4)/2)); + Alloca_End; + return ret; +} + +static Object P_Create_Widget (argc, argv) Object *argv; { + ArgList a; + char *name = 0; + Object x, class, parent, ret; + Alloca_Begin; + + x = argv[0]; + if (TYPE(x) != T_Class) { + name = Get_Strsym (x); + argv++; argc--; + } + class = argv[0]; + parent = argv[1]; + Check_Type (class, T_Class); + Check_Widget (parent); + if (name == 0) + name = CLASS(class)->name; + Encode_Arglist (argc-2, argv+2, a, WIDGET(parent)->widget, + CLASS(class)->wclass); + ret = Make_Widget (XtCreateWidget ((String)name, CLASS(class)->wclass, + WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2)); + Alloca_End; + return ret; +} + +static Object P_Realize_Widget (w) Object w; { + Check_Widget (w); + XtRealizeWidget (WIDGET(w)->widget); + return Void; +} + +static Object P_Unrealize_Widget (w) Object w; { + Check_Widget (w); + XtUnrealizeWidget (WIDGET(w)->widget); + return Void; +} + +static Object P_Widget_Realizedp (w) Object w; { + Check_Widget (w); + return XtIsRealized (WIDGET(w)->widget) ? True : False; +} + +static Object P_Widget_Display (w) Object w; { + Check_Widget (w); + return Make_Display (0, XtDisplayOfObject (WIDGET(w)->widget)); +} + +static Object P_Widget_Parent (w) Object w; { + Check_Widget (w); + return Make_Widget_Foreign (XtParent (WIDGET(w)->widget)); +} + +static Object P_Widget_Name (w) Object w; { + char *s; + + Check_Widget (w); + s = XtName (WIDGET(w)->widget); + return Make_String (s, strlen (s)); +} + +static Object P_Widget_To_Window (w) Object w; { + Check_Widget (w); + return Make_Window (0, XtDisplayOfObject (WIDGET(w)->widget), + XtWindow (WIDGET(w)->widget)); +} + +static Object P_Widget_Compositep (w) Object w; { + Check_Widget (w); + return XtIsComposite (WIDGET(w)->widget) ? True : False; +} + +static Object Manage_Unmanage (children, f) Object children; void (*f)(); { + register i, n; + Widget *buf; + Object tail; + Alloca_Begin; + + Check_List (children); + n = Fast_Length (children); + Alloca (buf, Widget*, n * sizeof (Widget)); + for (i = 0, tail = children; i < n; i++, tail = Cdr (tail)) { + Object w; + + w = Car (tail); + Check_Widget (w); + buf[i] = WIDGET(w)->widget; + } + f (buf, n); + Alloca_End; + return Void; +} + +static Object P_Manage_Children (children) Object children; { + return Manage_Unmanage (children, XtManageChildren); +} + +static Object P_Unmanage_Children (children) Object children; { + return Manage_Unmanage (children, XtUnmanageChildren); +} + +static Object P_Widget_Managedp (w) Object w; { + Check_Widget (w); + return XtIsManaged (WIDGET(w)->widget) ? True : False; +} + +static Object P_Widget_Class (w) Object w; { + Check_Widget (w); + return Make_Widget_Class (XtClass (WIDGET(w)->widget)); +} + +static Object P_Widget_Superclass (w) Object w; { + Check_Widget (w); + if (XtClass (WIDGET(w)->widget) == widgetClass) + return Sym_None; + return Make_Widget_Class (XtSuperclass (WIDGET(w)->widget)); +} + +static Object P_Widget_Subclassp (w, c) Object w, c; { + Check_Widget (w); + Check_Type (c, T_Class); + return XtIsSubclass (WIDGET(w)->widget, CLASS(c)->wclass) ? True : False; +} + +static Object P_Set_Mapped_When_Managed (w, m) Object w, m; { + Check_Widget (w); + Check_Type (m, T_Boolean); + XtSetMappedWhenManaged (WIDGET(w)->widget, EQ(m, True)); + return Void; +} + +static Object P_Map_Widget (w) Object w; { + Check_Widget (w); + XtMapWidget (WIDGET(w)->widget); + return Void; +} + +static Object P_Unmap_Widget (w) Object w; { + Check_Widget (w); + XtUnmapWidget (WIDGET(w)->widget); + return Void; +} + +static Object P_Set_Values (argc, argv) Object *argv; { + ArgList a; + Widget w; + register i, n = (argc-1)/2; + Alloca_Begin; + + Check_Widget (argv[0]); + w = WIDGET(argv[0])->widget; + Encode_Arglist (argc-1, argv+1, a, w, XtClass (w)); + XtSetValues (w, a, (Cardinal)n); + for (i = 0; i < n; i++) + if (streq (a[i].name, XtNdestroyCallback)) + Fiddle_Destroy_Callback (w); + Alloca_End; + return Void; +} + +static Object P_Get_Values (argc, argv) Object *argv; { + Widget w; + + Check_Widget (argv[0]); + w = WIDGET(argv[0])->widget; + return Get_Values (w, argc-1, argv+1); +} + +static Object P_Widget_Context (w) Object w; { + Check_Widget (w); + return + Make_Context_Foreign (XtWidgetToApplicationContext (WIDGET(w)->widget)); +} + +static Object P_Set_Sensitive (w, s) Object w, s; { + Check_Widget (w); + Check_Type (s, T_Boolean); + XtSetSensitive (WIDGET(w)->widget, EQ(s, True)); + return Void; +} + +static Object P_Sensitivep (w) Object w; { + Check_Widget (w); + return XtIsSensitive (WIDGET(w)->widget) ? True : False; +} + +static Object P_Window_To_Widget (w) Object w; { + Check_Type (w, T_Window); + return Make_Widget_Foreign (XtWindowToWidget (WINDOW(w)->dpy, + WINDOW(w)->win)); +} + +static Object P_Name_To_Widget (root, name) Object root, name; { + register char *s; + + Check_Widget (root); + return Make_Widget_Foreign (XtNameToWidget (WIDGET(root)->widget, + Get_Strsym (name))); +} + +static Object P_Widget_Translate_Coordinates (w, x, y) Object w, x, y; { + Position root_x, root_y; + + Check_Widget (w); + XtTranslateCoords (WIDGET(w)->widget, Get_Integer (x), Get_Integer (y), + &root_x, &root_y); + return Cons (Make_Integer (root_x), Make_Integer (root_y)); +} + +/* The GC-visit function for widgets. Visit the children of composite + * widgets and all the parents of a widget. + * Based on code contributed by Ken Fox . + */ + +#include +#include +#include +#undef XtIsComposite + +static Widget_Visit (root, func) Object *root; int (*func)(); { + Object obj; + Widget w = WIDGET(*root)->widget; + + if (WIDGET(*root)->free == 0 && XtIsComposite (w)) { + int i; + CompositeRec *comp = (CompositeRec *)w; + + for (i = 0; i < comp->composite.num_children; i++) { + obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, + comp->composite.children[i]); + if (TYPE(obj) == T_Widget) + func (&obj); + } + while (w = XtParent (w)) { + obj = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w); + if (TYPE(obj) == T_Widget) + func (&obj); + } + } +} + +elk_init_xt_widget () { + T_Widget = Define_Type (0, "widget", NOFUNC, sizeof (struct S_Widget), + Widget_Equal, Widget_Equal, Widget_Print, Widget_Visit); + Define_Primitive (P_Widgetp, "widget?", 1, 1, EVAL); + Define_Primitive (P_Destroy_Widget, "destroy-widget", 1, 1, EVAL); + Define_Primitive (P_Create_Shell, "create-shell", 4, MANY, VARARGS); + Define_Primitive (P_Create_Widget, "create-widget", 2, MANY, VARARGS); + Define_Primitive (P_Realize_Widget, "realize-widget", 1, 1, EVAL); + Define_Primitive (P_Unrealize_Widget, "unrealize-widget", 1, 1, EVAL); + Define_Primitive (P_Widget_Realizedp, "widget-realized?", 1, 1, EVAL); + Define_Primitive (P_Widget_Display, "widget-display", 1, 1, EVAL); + Define_Primitive (P_Widget_Parent, "widget-parent", 1, 1, EVAL); + Define_Primitive (P_Widget_Name, "widget-name", 1, 1, EVAL); + Define_Primitive (P_Widget_To_Window, "widget->window", 1, 1, EVAL); + Define_Primitive (P_Widget_Compositep, "widget-composite?", 1, 1, EVAL); + Define_Primitive (P_Manage_Children, "manage-children", 1, 1, EVAL); + Define_Primitive (P_Unmanage_Children, "unmanage-children", 1, 1, EVAL); + Define_Primitive (P_Widget_Managedp, "widget-managed?", 1, 1, EVAL); + Define_Primitive (P_Widget_Class, "widget-class", 1, 1, EVAL); + Define_Primitive (P_Widget_Superclass, "widget-superclass", 1, 1, EVAL); + Define_Primitive (P_Widget_Subclassp, "widget-subclass?", 2, 2, EVAL); + Define_Primitive (P_Set_Mapped_When_Managed, + "set-mapped-when-managed!", 2, 2, EVAL); + Define_Primitive (P_Map_Widget, "map-widget", 1, 1, EVAL); + Define_Primitive (P_Unmap_Widget, "unmap-widget", 1, 1, EVAL); + Define_Primitive (P_Set_Values, "set-values!", 1, MANY, VARARGS); + Define_Primitive (P_Get_Values, "get-values", 1, MANY, VARARGS); + Define_Primitive (P_Widget_Context, "widget-context", 1, 1, EVAL); + Define_Primitive (P_Set_Sensitive, "set-sensitive!", 2, 2, EVAL); + Define_Primitive (P_Sensitivep, "widget-sensitive?", 1, 1, EVAL); + Define_Primitive (P_Window_To_Widget, "window->widget", 1, 1, EVAL); + Define_Primitive (P_Name_To_Widget, "name->widget", 2, 2, EVAL); + Define_Primitive (P_Widget_Translate_Coordinates, + "widget-translate-coordinates", 3, 3, EVAL); +} diff --git a/lib/xt/xt.h b/lib/xt/xt.h new file mode 100644 index 0000000..8d28a03 --- /dev/null +++ b/lib/xt/xt.h @@ -0,0 +1,119 @@ +#include "xlib.h" + +#define Object FOO +# include +# include +# include +#undef Object + +#if XtSpecificationRelease < 4 + #error "Xt Release 3 or earlier no longer supported" +#endif + +#if XtSpecificationRelease >= 5 +# define XT_RELEASE_5_OR_LATER +#endif + +#if XtSpecificationRelease >= 6 +# define XT_RELEASE_6_OR_LATER +#endif + +typedef XtArgVal (*PFS2X) P_((Object)); +typedef Object (*PFX2S) P_((XtArgVal)); + +extern int T_Context; +extern int T_Class; +extern int T_Widget; +extern int T_Identifier; + +#define CONTEXT(x) ((struct S_Context *)POINTER(x)) +#define CLASS(x) ((struct S_Class *)POINTER(x)) +#define WIDGET(x) ((struct S_Widget *)POINTER(x)) +#define IDENTIFIER(x) ((struct S_Identifier *)POINTER(x)) + +struct S_Context { + Object tag; + XtAppContext context; + char free; +}; + +struct S_Class { + Object tag; + WidgetClass wclass; + char *name; +}; + +struct S_Widget { + Object tag; + Widget widget; + char free; +}; + +struct S_Identifier { + Object tag; + char type; + XtPointer val; + int num; + char free; +}; + +extern WidgetClass widgetClass; /* The `core' class */ +extern WidgetClass constraintWidgetClass; +extern WidgetClass compositeWidgetClass; + +C_LINKAGE_BEGIN + +extern void Check_Callback_List P_((Object)); +extern void Check_Context P_((Object)); +extern void Check_Widget P_((Object)); +extern void Check_Widget_Class P_((Object, WidgetClass)); +extern void Convert_Args P_((int, Object*, ArgList, Widget, WidgetClass)); +extern void Define_Callback P_((char*, char*, int)); +extern void Define_Class + P_((char *, WidgetClass, XtResourceList, int)); +extern void Define_Converter_To_C P_((char*, PFS2X)); +extern void Define_Converter_To_Scheme P_((char*, PFX2S)); +extern void Fiddle_Destroy_Callback P_((Widget)); +extern void Fill_Callbacks P_((Object, XtCallbackList, int, PFX2S)); +extern void Free_Actions P_((XtAppContext)); +extern void Get_All_Resources + P_((int, Widget, WidgetClass, XtResource**, int*, int*)); +extern void Make_Resource_Name P_((char*)); +extern int Match_Xt_Obj P_((ELLIPSIS)); +extern Object Get_Callbackfun P_((XtPointer)); +extern Object Get_Function P_((int)); +extern Object Get_Resources + P_((WidgetClass, void (*)(WidgetClass, XtResourceList*, Cardinal*), int)); +extern Object Get_Values P_((Widget, int, Object*)); +extern Object Make_Class P_((WidgetClass, char*)); +extern Object Make_Context P_((XtAppContext)); +extern Object Make_Context_Foreign P_((XtAppContext)); +extern Object Make_Id P_((int, XtPointer, int)); +extern Object Make_Widget P_((Widget)); +extern Object Make_Widget_Foreign P_((Widget)); +extern Object Make_Widget_Class P_((WidgetClass)); +extern PFX2S Find_Callback_Converter P_((WidgetClass, char*, Object)); +extern PFX2S Find_Converter_To_Scheme P_((char*)); +extern PFS2X Find_Converter_To_C P_((char*)); +extern int Register_Function P_((Object)); +extern void Deregister_Function P_((int)); +extern XtAccelerators Get_Accelerators P_((Object)); +extern XtTranslations Get_Translations P_((Object)); +extern XtPointer Use_Id P_((Object, int)); +extern void Xt_Warning P_((char*)); +extern char *Class_Name P_((WidgetClass)); +extern void Action_Hook P_((Widget, XtPointer, char*, XEvent*, char**, int*)); +extern void Destroy_Callback_Proc P_((Widget, XtPointer, XtPointer)); +extern void Get_Sub_Resource_List P_((WidgetClass, XtResourceList*, Cardinal*)); +extern Object Xt_Class_Name P_((WidgetClass)); +extern Object Get_Selection_CB P_((ELLIPSIS)); /* xm/support.d */ +extern Object Get_Any_CB P_((ELLIPSIS)); /* xm/support.d */ + +C_LINKAGE_END + +#define Encode_Arglist(ac,av,to,widget,class) {\ + Alloca (to, Arg*, ((ac)+1)/2 * sizeof (Arg));\ + Convert_Args (ac, av, to, widget, class);\ +} + +#define streq(a,b) (strcmp ((a), (b)) == 0) diff --git a/scm/Makefile b/scm/Makefile new file mode 100644 index 0000000..cdc57f0 --- /dev/null +++ b/scm/Makefile @@ -0,0 +1,25 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../config/system ../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + $(MAKE) -f Makefile.local localize + +lint: Makefile.local + $(MAKE) -f Makefile.local lint + +clean: Makefile.local + $(MAKE) -f Makefile.local clean + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/scm/apropos.scm b/scm/apropos.scm new file mode 100644 index 0000000..abc12f2 --- /dev/null +++ b/scm/apropos.scm @@ -0,0 +1,27 @@ +;;; -*-Scheme-*- +;;; +;;; apropos -- print matching symbols + +(define apropos) + +(let ((found)) + +(define (got-one sym) + (if (bound? sym) + (begin + (set! found #t) + (print sym)))) + +(set! apropos (lambda (what) + (if (symbol? what) + (set! what (symbol->string what)) + (if (not (string? what)) + (error 'apropos "string or symbol expected"))) + (set! found #f) + (do ((tail (oblist) (cdr tail))) ((null? tail)) + (do ((l (car tail) (cdr l))) ((null? l)) + (if (substring? what (symbol->string (car l))) + (got-one (car l))))) + (if (not found) + (format #t "~a: nothing appropriate~%" what)) + #v))) diff --git a/scm/bitstring.scm b/scm/bitstring.scm new file mode 100644 index 0000000..8d112fb --- /dev/null +++ b/scm/bitstring.scm @@ -0,0 +1,59 @@ +;;; -*-Scheme-*- +;;; +;;; The Scheme layer of the bitstring extension. + +(require 'bitstring.o) + +(define (bitstring-copy b) + (let ((new (make-bitstring (bitstring-length b) #f))) + (bitstring-move! new b) + new)) + +(define (bitstring-append a b) + (let* ((alen (bitstring-length a)) + (blen (bitstring-length b)) + (new (make-bitstring (+ alen blen) #f))) + (bitstring-substring-move! a 0 alen new 0) + (bitstring-substring-move! b 0 blen new alen) + new)) + +(define (bitstring-substring b from to) + (let ((new (make-bitstring (- to from) #f))) + (bitstring-substring-move! b from to new 0) + new)) + +(define (bitstring-not b) + (let ((new (bitstring-copy b))) + (bitstring-not! new b) + new)) + +(define (bitstring-make-logical-function fun!) + (lambda (a b) + (let ((new (bitstring-copy a))) + (fun! new b) + new))) + +(define bitstring-and (bitstring-make-logical-function bitstring-and!)) +(define bitstring-andnot (bitstring-make-logical-function bitstring-andnot!)) +(define bitstring-or (bitstring-make-logical-function bitstring-or!)) +(define bitstring-xor (bitstring-make-logical-function bitstring-xor!)) + +(define (signed-integer->bitstring len n) + (if (or (>= n (expt 2 (1- len))) (< n (- (expt 2 (1- len))))) + (error 'signed-integer->bitstring + "length ~s too small for signed integer ~s" len n)) + (unsigned-integer->bitstring len (if (negative? n) (+ n (expt 2 len)) n))) + +(define (bitstring->signed-integer b) + (let ((n (bitstring->unsigned-integer b)) + (len (bitstring-length b))) + (cond ((zero? len) 0) + ((bitstring-ref b (1- len)) (- n (expt 2 len))) + (else n)))) + +(define (describe-bitstring b) + (let ((len (bitstring-length b))) + (format #t "a bitstring of length ~s bit~a.~%" len + (if (= len 1) "" "s")))) + +(provide 'bitstring) diff --git a/scm/build b/scm/build new file mode 100755 index 0000000..1b1f5fe --- /dev/null +++ b/scm/build @@ -0,0 +1,66 @@ +. ../config/system +. ../config/site + +echo Building Makefile.local... +cat >Makefile.local <siteinfo.scm +;;; -*-Scheme-*- +;;; +;;; This file has been produced automatically from the information in +;;; your config/system and config/site files. Do not edit! + + +;;; Miscellaneous parameters from config/system: + +(define site-machine "$machine") +(define site-os "$os") +(define site-cc "$cc") + +(define site-version '($major . $minor)) + + +;;; Various pathnames/options for dynamically loading the X extensions: + +(define site-lib-xlib + "$libxlib") + +(define site-lib-xt + "$libxt") + +(define site-lib-xaw + "$libxaw") + +(define site-lib-xmotif + "$libxmotif") + +(define site-force-load-xm "$force_load_xm") + +(provide 'siteinfo) +EOT diff --git a/scm/cscheme.scm b/scm/cscheme.scm new file mode 100644 index 0000000..4920011 --- /dev/null +++ b/scm/cscheme.scm @@ -0,0 +1,138 @@ +;;; -*-Scheme-*- +;;; +;;; A few C-Scheme compatibility hacks + +(provide 'cscheme) + +(define-macro (syntax-table-define table name mac) + `(define ,(eval name) ,mac)) + +(define mapcar map) + +(define user-initial-environment (global-environment)) + +(define (rep-environment) (global-environment)) + +(define (atom? x) + (not (pair? x))) + +(define nil '()) + +(define *the-non-printing-object* #v) + +(define (integer->string i) + (format #f "~s" i)) + +(define (get* sym prop) + (let ((ret (get sym prop))) + (if ret ret '()))) + +(define-macro (access sym env) + `(eval ',sym ,env)) + +(define-macro (in-package env . body) + `(eval '(begin ,@body) ,env)) + +(define-macro (without-interrupts thunk) + `(,thunk)) + +(define-macro (rec var exp) + `(letrec ((,var ,exp)) ,exp)) + +(define (cons* first . rest) + (let loop ((curr first) (rest rest)) + (if (null? rest) + curr + (cons curr (loop (car rest) (cdr rest)))))) + +(define sequence begin) + +(define -1+ 1-) + +(define (remq x y) + (cond ((null? y) y) + ((eq? x (car y)) (remq x (cdr y))) + (else (cons (car y) (remq x (cdr y)))))) + +(define (remv x y) + (cond ((null? y) y) + ((eqv? x (car y)) (remv x (cdr y))) + (else (cons (car y) (remv x (cdr y)))))) + +(define (remove x y) + (cond ((null? y) y) + ((equal? x (car y)) (remove x (cdr y))) + (else (cons (car y) (remove x (cdr y)))))) + +(define (remq! x y) + (cond ((null? y) y) + ((eq? x (car y)) (remq! x (cdr y))) + (else (let loop ((prev y)) + (cond ((null? (cdr prev)) + y) + ((eq? (cadr prev) x) + (set-cdr! prev (cddr prev)) + (loop prev)) + (else (loop (cdr prev)))))))) + +(define (remv! x y) + (cond ((null? y) y) + ((eqv? x (car y)) (remv! x (cdr y))) + (else (let loop ((prev y)) + (cond ((null? (cdr prev)) + y) + ((eqv? (cadr prev) x) + (set-cdr! prev (cddr prev)) + (loop prev)) + (else (loop (cdr prev)))))))) + +(define (remove! x y) + (cond ((null? y) y) + ((equal? x (car y)) (remove! x (cdr y))) + (else (let loop ((prev y)) + (cond ((null? (cdr prev)) + y) + ((equal? (cadr prev) x) + (set-cdr! prev (cddr prev)) + (loop prev)) + (else (loop (cdr prev)))))))) + +(define delq remq) +(define delv remv) +(define delete remove) +(define delq! remq!) +(define delv! remv!) +(define delete! remove!) + +(empty-list-is-false-for-backward-compatibility #t) + +(if (feature? 'bitstring) + (begin + (define (bit-string-allocate k) (make-bitstring k #f)) + (define bit-string-copy bitstring-copy) + (define bit-string? bitstring?) + (define bit-string-length bitstring-length) + (define bit-string-ref bitstring-ref) + (define (bit-string-set! b i) (bitstring-set! b i #t)) + (define (bit-string-clear! b i) (bitstring-set! b i #f)) + (define bit-string-append bitstring-append) + (define bit-substring bitstring-substring) + (define bit-string-zero? bitstring-zero?) + (define bit-string=? bitstring=?) + (define bit-string-not bitstring-not) + (define bit-string-movec! bitstring-not!) + (define bit-string-and bitstring-and) + (define bit-string-andc bitstring-andnot) + (define bit-string-or bitstring-or) + (define bit-string-xor bitstring-xor) + (define bit-string-and! bitstring-and!) + (define bit-string-or! bitstring-or!) + (define bit-string-xor! bitstring-xor!) + (define bit-string-andc! bitstring-andnot!) + (define bit-string-fill! bitstring-fill!) + (define bit-string-move! bitstring-move!) + (define bit-substring-move-right! bitstring-substring-move!) + (define unsigned-integer->bit-string unsigned-integer->bitstring) + (define signed-integer->bit-string signed-integer->bitstring) + (define bit-string->unsigned-integer bitstring->unsigned-integer) + (define bit-string->signed-integer bitstring->signed-integer))) diff --git a/scm/debug.scm b/scm/debug.scm new file mode 100644 index 0000000..157535c --- /dev/null +++ b/scm/debug.scm @@ -0,0 +1,212 @@ +;;; -*-Scheme-*- +;;; +;;; A simple debugger (improvements by Thomas M. Breuel ). + +(define (backtrace . args) + (if (> (length args) 1) + (error 'backtrace "too many arguments")) + (if (not (null? args)) + (if (not (eq? (type (car args)) 'control-point)) + (error 'backtrace "argument must be a control point"))) + (let ((trace (apply backtrace-list args))) + (if (null? args) + (set! trace (cdddr trace))) + (show-backtrace trace 0 999999))) + +(define (show-backtrace trace start-frame end-frame) + (define (rjust n x) + (let* ((y (string-append (make-string n #\space) x)) + (l (string-length y))) + (substring y (- l n) l))) + (let ((maxlen 28)) + (let loop ((frames (list-tail trace start-frame)) (num start-frame)) + (if (or (null? frames) (>= num end-frame)) #v + (let ((frame (car frames))) + (let* ((func + (format #f "~s" (vector-ref frame 0))) + (indent + (- maxlen (+ 5 (string-length func))))) + (display (rjust 4 (number->string num))) + (display " ") + (display func) + (if (negative? indent) + (begin + (newline) + (set! indent maxlen))) + (do ((i indent (1- i))) + ((> 0 i)) + (display " "))) + (fluid-let + ((print-depth 2) + (print-length 3)) + (display (vector-ref frame 1))) + (newline)) + (loop (cdr frames) (1+ num)))))) + +(define (show-environment env) + (fluid-let + ((print-length 2) + (print-depth 2)) + (do ((f (environment->list env) (cdr f))) + ((null? f)) + (do ((b (car f) (cdr b))) + ((null? b)) + (format #t "~s\t~s~%" (caar b) (cdar b))) + (print '-------))) + #v) + +(define inspect) + +(let ((frame) + (trace) + (help-text + '("q -- quit inspector" + "f -- print current frame" + "u -- go up one frame" + "d -- go down one frame" + "^ -- go to top frame" + "$ -- go to bottom frame" + "g -- goto to n-th frame" + "e -- eval expressions in environment" + "p -- pretty-print procedure" + "v -- show environment" + " -- pretty-print n-th argument" + "b -- show backtrace starting at current frame" + "t -- show top of bracktrace starting at current frame" + "z -- show and move top of backtrace starting at current frame" + "o -- obarray information"))) + + (define (inspect-command-loop) + (let ((input) (done #f)) + (display "inspect> ") + (set! input (read)) + (case input + (q + (set! done #t)) + (? + (for-each + (lambda (msg) + (display msg) + (newline)) + help-text)) + (f + (print-frame)) + (^ + (set! frame 0) + (print-frame)) + ($ + (set! frame (1- (length trace))) + (print-frame)) + (u + (if (zero? frame) + (format #t "Already on top frame.~%") + (set! frame (1- frame)) + (print-frame))) + (d + (if (= frame (1- (length trace))) + (format #t "Already on bottom frame.~%") + (set! frame (1+ frame)) + (print-frame))) + (g + (set! input (read)) + (if (integer? input) + (set! frame + (cond ((negative? input) 0) + ((>= input (length trace)) (1- (length trace))) + (else input))) + (format #t "Frame number must be an integer.~%"))) + (v + (show-environment (vector-ref (list-ref trace frame) 2))) + (e + (format #t "Type ^D to return to Inspector.~%") + (let loop () + (display "eval> ") + (set! input (read)) + (if (not (eof-object? input)) + (begin + (write (eval input + (vector-ref (list-ref trace frame) 2))) + (newline) + (loop)))) + (newline)) + (p + (pp (vector-ref (list-ref trace frame) 0)) + (newline)) + (z + (show-backtrace trace frame (+ frame 10)) + (set! frame (+ frame 9)) + (if (>= frame (length trace)) (set! frame (1- (length trace))))) + (t + (show-backtrace trace frame (+ frame 10))) + (b + (show-backtrace trace frame 999999)) + (o + (let ((l (map length (oblist)))) + (let ((n 0)) + (for-each (lambda (x) (set! n (+ x n))) l) + (format #t "~s symbols " n) + (format #t "(maximum bucket: ~s).~%" (apply max l))))) + (else + (cond + ((integer? input) + (let ((args (vector-ref (list-ref trace frame) 1))) + (if (or (< input 1) (> input (length args))) + (format #t "No such argument.~%") + (pp (list-ref args (1- input))) + (newline)))) + ((eof-object? input) + (set! done #t)) + (else + (format #t "Invalid command. Type ? for help.~%"))))) + (if (not done) + (inspect-command-loop)))) + + (define (print-frame) + (format #t "~%Frame ~s of ~s:~%~%" frame (1- (length trace))) + (let* ((f (list-ref trace frame)) (args (vector-ref f 1))) + (format #t "Procedure: ~s~%" (vector-ref f 0)) + (format #t "Environment: ~s~%" (vector-ref f 2)) + (if (null? args) + (format #t "No arguments.~%") + (fluid-let + ((print-depth 2) + (print-length 3)) + (do ((i 1 (1+ i)) (args args (cdr args))) ((null? args)) + (format #t "Argument ~s: ~s~%" i (car args)))))) + (newline)) + + (define (find-frame proc) + (let loop ((l trace) (i 0)) + (cond ((null? l) -1) + ((eq? (vector-ref (car l) 0) proc) i) + (else (loop (cdr l) (1+ i)))))) + + (set! inspect + (lambda () + (set! trace (backtrace-list)) + (set! trace (cddr trace)) + (do ((t trace (cdr t)) (f 1 (1+ f))) ((null? t)) + (if (not (null? (vector-ref (car t) 1))) + (let ((last (last-pair (vector-ref (car t) 1)))) + (if (not (null? (cdr last))) + (begin + (format #t + "[inspector: fixing improper arglist in frame ~s]~%" f) + (set-cdr! last (cons (cdr last) '()))))))) + (set! frame (find-frame error-handler)) + (if (negative? frame) + (set! frame 0)) + (format #t "Inspector (type ? for help):~%") + (let loop () + (if (call-with-current-continuation + (lambda (control-point) + (push-frame control-point) + (inspect-command-loop) + #f)) + (begin + (pop-frame) + (loop)))) + (newline) + (pop-frame) + (let ((next-frame (car rep-frames))) + (next-frame #t))))) diff --git a/scm/describe.scm b/scm/describe.scm new file mode 100644 index 0000000..1f79dc9 --- /dev/null +++ b/scm/describe.scm @@ -0,0 +1,72 @@ +;;; -*-Scheme-*- +;;; +;;; describe -- print information about a Scheme object + +(define (describe x) + (fluid-let + ((print-depth 2) + (print-length 3)) + (format #t "~s is " (if (void? x) '\#v x))) + (case (type x) + (integer + (format #t "an integer.~%")) + (real + (format #t "a real.~%")) + (null + (format #t "an empty list.~%")) + (boolean + (format #t "a boolean value (~s).~%" (if x 'true 'false))) + (character + (format #t "a character, ascii value is ~s~%" (char->integer x))) + (symbol + (format #t "a symbol~a." (if (void? x) " (the non-printing object)" "")) + (let ((l (symbol-plist x))) + (if (null? l) + (format #t " It has no property list.~%") + (format #t "~%Its property list is: ~s.~%" l)))) + (pair + (if (pair? (cdr x)) + (let ((p (last-pair x))) + (if (null? (cdr p)) + (format #t "a list of length ~s.~%" (length x)) + (format #t "an improper list.~%"))) + (format #t "a pair.~%"))) + (environment + (format #t "an environment.~%")) + (string + (if (eqv? x "") + (format #t "an empty string.~%") + (format #t "a string of length ~s.~%" (string-length x)))) + (vector + (if (eqv? x '#()) + (format #t "an empty vector.~%") + (if (and (feature? 'oops) (memq (vector-ref x 0) + '(class instance))) + (if (eq? (vector-ref x 0) 'class) + (begin + (format #t "a class.~%~%") + (describe-class x)) + (format #t "an instance.~%~%") + (describe-instance x)) + (format #t "a vector of length ~s.~%" (vector-length x))))) + (primitive + (format #t "a primitive procedure.~%")) + (compound + (format #t "a compound procedure (type ~s).~%" + (car (procedure-lambda x)))) + (control-point + (format #t "a control point (continuation).~%")) + (promise + (format #t "a promise.~%")) + (port + (format #t "a port.~%")) + (end-of-file + (format #t "the end-of-file object.~%")) + (macro + (format #t "a macro.~%")) + (else + (let ((descr-func (string->symbol + (format #f "describe-~s" (type x))))) + (if (bound? descr-func) + ((eval descr-func) x) + (format #t "an object of unknown type (~s)~%" (type x))))))) diff --git a/scm/gdbmtest.scm b/scm/gdbmtest.scm new file mode 100644 index 0000000..128a4d6 --- /dev/null +++ b/scm/gdbmtest.scm @@ -0,0 +1,82 @@ +;;; -*-Scheme-*- +;;; +;;; An interactive command loop for testing the GNU gdbm extension. +;;; Contributed by Martin Stut. + + +(require 'gdbm.o) + +(let ((gf (gdbm-open 'test.gdbm 1024 'create)) (last "nothing")) + (if (not gf) + (error 'gdbm-open "cannot open test.gdbm")) + (format #t "Type ? for help~%") + (let loop ((op (read-char))) + (newline) + (if (not (char=? op #\newline)) + (read-string)) ; flush rest of line + (case op + ((#\? #\h) + (format #t "c -- count items~%") + (format #t "d -- delete item~%") + (format #t "f -- fetch item~%") + (format #t "s -- store item~%") + (format #t "n -- next key~%") + (format #t "1 -- first key~%") + (format #t "2 -- next key of last n, 1, or 2~%") + (format #t "r -- reorganize~%") + (format #t "q -- quit~%")) + (#\c + (do ((i 0 (1+ i)) + (x (gdbm-firstkey gf) (gdbm-nextkey gf x))) + ((not x) (format #t "Number of entries: ~s~%" i)))) + (#\d + (display "Key: ") + (if (gdbm-delete gf (read-string)) + (format #t "Deleted.~%") + (format #t "Doesn't exist.~%"))) + (#\f + (display "Key: ") + ((lambda (d) + (if d + (format #t "Data: ~s~%" d) + (format #t "Doesn't exist.~%"))) + (gdbm-fetch gf (read-string)))) + (#\s + (display "Key: ") + ((lambda (k) + (display "Data: ") + (if (= 1 (gdbm-store gf k (read-string) 'insert)) + (format #t "Already there.~%") + (format #t "Inserted.~%"))) + (read-string))) + (#\n + (display "Key: ") + ((lambda (r) + (if r + (begin + (format #t "Next: ~s Data: ~s~%" r (gdbm-fetch gf r)) + (set! last r)) + (print #f))) + (gdbm-nextkey gf (read-string)))) + (#\1 + ((lambda (r) + (if r + (begin + (format #t "First: ~s Data: ~s~%" r (gdbm-fetch gf r)) + (set! last r)) + (print #f))) + (gdbm-firstkey gf))) + (#\2 + ((lambda (r) + (if r + (begin + (format #t "Next: ~s Data: ~s~%" r (gdbm-fetch gf r)) + (set! last r)) + (print #f))) + (gdbm-nextkey gf last))) + (#\r + (gdbm-reorganize gf) + (format #t "Reorganized.~%")) + (#\q + (exit))) + (loop (read-char)))) diff --git a/scm/initscheme.scm b/scm/initscheme.scm new file mode 100644 index 0000000..476de0f --- /dev/null +++ b/scm/initscheme.scm @@ -0,0 +1,81 @@ +;;; -*-Scheme-*- +;;; +;;; Initialization code for the Elk interpreter kernel. +;;; +;;; This file is loaded on startup before the toplevel (or the file +;;; supplied along with the -l option) is loaded. +;;; +;;; If a garbage collection is triggered while loading this file, +;;; it is regarded as an indication that the heap size is too small +;;; and an error message is printed. + + +;;; Primitives that are part of the core functionality but are not +;;; implemented in C. This is a bad thing, because extension or +;;; application writers should be able to rely on P_Expt(). + +(define (expt x y) + + (define (square x) (* x x)) + + (define (integer-expt b n) + (cond ((= n 0) 1) + ((negative? n) (/ 1 (integer-expt b (abs n)))) + ((even? n) (square (integer-expt b (/ n 2)))) + (else (* b (integer-expt b (- n 1)))))) + + (cond ((zero? x) (if (zero? y) 1 0)) + ((integer? y) (integer-expt x y)) + (else (exp (* (log x) y))))) + + +;;; Synonyms: + +(define call/cc call-with-current-continuation) + + +;;; Backwards compatibility. These procedures are really obsolete; +;;; please do not use them any longer. + +(define (close-port p) + (if (input-port? p) (close-input-port p) (close-output-port p))) + +(define (void? x) (eq? x (string->symbol ""))) + +(define (re-entrant-continuations?) #t) + + +;;; Useful macros (these were loaded by the standard toplevel in +;;; earlier versions of Elk). They shouldn't really be here, but +;;; it's too late... + +(define (expand form) + (if (or (not (pair? form)) (null? form)) + form + (let ((head (expand (car form))) (args (expand (cdr form))) (result)) + (if (and (symbol? head) (bound? head)) + (begin + (set! result (macro-expand (cons head args))) + (if (not (equal? result form)) + (expand result) + result)) + (cons head args))))) + +(define-macro (unwind-protect body . unwind-forms) + `(dynamic-wind + (lambda () #f) + (lambda () ,body) + (lambda () ,@unwind-forms))) + +(define-macro (while test . body) + `(let loop () + (cond (,test ,@body (loop))))) + +(define-macro (when test . body) + `(cond (,test ,@body))) + +(define-macro (unless test . body) + `(when (not ,test) ,@body)) + +(define-macro (multiple-value-bind vars form . body) + `(apply (lambda ,vars ,@body) ,form)) diff --git a/scm/motif.scm b/scm/motif.scm new file mode 100644 index 0000000..4f3c105 --- /dev/null +++ b/scm/motif.scm @@ -0,0 +1,11 @@ +;;; -*-Scheme-*- +;;; +;;; This file is `required' in place of `xwidgets' when the Motif widgets +;;; are to be used. + +(provide 'motif) + +(require 'xwidgets) + +(set! widget-subdirectory 'xm) +(set! load-always '(support)) diff --git a/scm/oops.scm b/scm/oops.scm new file mode 100644 index 0000000..47e6634 --- /dev/null +++ b/scm/oops.scm @@ -0,0 +1,274 @@ +;;; -*-Scheme-*- +;;; +;;; A simple `OOPS' package + +(require 'hack.o) + +(provide 'oops) + +(define class-size 5) +(define instance-size 3) + +;;; Classes and instances are represented as vectors. The first +;;; two slots (tag and class-name) are common to classes and instances. + +(define (tag v) (vector-ref v 0)) +(define (set-tag! v t) (vector-set! v 0 t)) + +(define (class-name v) (vector-ref v 1)) +(define (set-class-name! v n) (vector-set! v 1 n)) + +(define (class-instance-vars c) (vector-ref c 2)) +(define (set-class-instance-vars! c v) (vector-set! c 2 v)) + +(define (class-env c) (vector-ref c 3)) +(define (set-class-env! c e) (vector-set! c 3 e)) + +(define (class-super c) (vector-ref c 4)) +(define (set-class-super! c s) (vector-set! c 4 s)) + +(define (instance-env i) (vector-ref i 2)) +(define (set-instance-env! i e) (vector-set! i 2 e)) + +;;; Methods are bound in the class environment. + +(define (method-known? method class) + (eval `(bound? ',method) (class-env class))) + +(define (lookup-method method class) + (eval method (class-env class))) + +(define (class? c) + (and (vector? c) (= (vector-length c) class-size) (eq? (tag c) 'class))) + +(define (check-class sym c) + (if (not (class? c)) + (error sym "argument is not a class"))) + +(define (instance? i) + (and (vector? i) (= (vector-length i) instance-size) + (eq? (tag i) 'instance))) + +(define (check-instance sym i) + (if (not (instance? i)) + (error sym "argument is not an instance"))) + +;;; Evaluate `body' within the scope of instance `i'. + +(define-macro (with-instance i . body) + `(eval '(begin ,@body) (instance-env ,i))) + +;;; Set a variable in an instance. + +(define (instance-set! instance var val) + (eval `(set! ,var ',val) (instance-env instance))) + +;;; Set a class variable when no instance is available. + +(define (class-set! class var val) + (eval `(set! ,var ',val) (class-env class))) + +;;; Convert a class variable spec into a binding suitable for a `let'. + +(define (make-binding var) + (if (symbol? var) + (list var '()) ; No initializer given; use () + var)) ; Initializer has been specified; leave alone + +;;; Check whether the elements of `vars' are either a symbol or +;;; of the form (symbol initializer). + +(define (check-vars vars) + (if (not (null? vars)) + (if (not (or (symbol? (car vars)) + (and (pair? (car vars)) (= (length (car vars)) 2) + (symbol? (caar vars))))) + (error 'define-class "bad variable spec: ~s" (car vars)) + (check-vars (cdr vars))))) + +;;; Check whether the class var spec `v' is already a member of +;;; the list `l'. If this is the case, check whether the initializers +;;; are identical. + +(define (find-matching-var l v) + (cond + ((null? l) #f) + ((eq? (caar l) (car v)) + (if (not (equal? (cdar l) (cdr v))) + (error 'define-class "initializer mismatch: ~s and ~s" + (car l) v) + #t)) + (else (find-matching-var (cdr l) v)))) + +;;; Same as above, but don't check initializer. + +(define (find-var l v) + (cond + ((null? l) #f) + ((eq? (caar l) (car v)) #t) + (else (find-var (cdr l) v)))) + +;;; Create a new list of class var specs by discarding all variables +;;; from `b' that are already a member of `a' (with identical initializers). + +(define (join-vars a b) + (cond + ((null? b) a) + ((find-matching-var a (car b)) (join-vars a (cdr b))) + (else (join-vars (cons (car b) a) (cdr b))))) + +;;; The syntax is as follows: +;;; (define-class class-name . options) +;;; options are: (super-class class-name) +;;; (class-vars . var-specs) +;;; (instance-vars . var-specs) +;;; each var-spec is either a symbol or (symbol initializer). + +(define-macro (define-class name . args) + (let ((class-vars) (instance-vars (list (make-binding 'self))) + (super) (super-class-env)) + (do ((a args (cdr a))) ((null? a)) + (cond + ((not (pair? (car a))) + (error 'define-class "bad argument: ~s" (car a))) + ((eq? (caar a) 'class-vars) + (check-vars (cdar a)) + (set! class-vars (cdar a))) + ((eq? (caar a) 'instance-vars) + (check-vars (cdar a)) + (set! instance-vars (append instance-vars + (map make-binding (cdar a))))) + ((eq? (caar a) 'super-class) + (if (> (length (cdar a)) 1) + (error 'define-class "only one super-class allowed")) + (set! super (cadar a))) + (else + (error 'define-class "bad keyword: ~s" (caar a))))) + (if (not (null? super)) + (let ((class (eval super))) + (set! super-class-env (class-env class)) + (set! instance-vars (join-vars (class-instance-vars class) + instance-vars))) + (set! super-class-env (the-environment))) + `(define ,name + (let ((c (make-vector class-size '()))) + (set-tag! c 'class) + (set-class-name! c ',name) + (set-class-instance-vars! c ',instance-vars) + (set-class-env! c (eval `(let* ,(map make-binding ',class-vars) + (the-environment)) + ,super-class-env)) + (set-class-super! c ',super) + c)))) + +(define-macro (define-method class lambda-list . body) + (if (not (pair? lambda-list)) + (error 'define-method "bad lambda list")) + `(begin + (check-class 'define-method ,class) + (let ((env (class-env ,class)) + (method (car ',lambda-list)) + (args (cdr ',lambda-list)) + (forms ',body)) + (eval `(define ,method (lambda ,args ,@forms)) env) + #v))) + +;;; All arguments of the form (instance-var init-value) are used +;;; to initialize the specified instance variable; then an +;;; initialize-instance message is sent with all remaining +;;; arguments. + +(define-macro (make-instance class . args) + `(begin + (check-class 'make-instance ,class) + (let* ((e (the-environment)) + (i (make-vector instance-size #f)) + (class-env (class-env ,class)) + (instance-vars (class-instance-vars ,class))) + (set-tag! i 'instance) + (set-class-name! i ',class) + (set-instance-env! i (eval `(let* ,instance-vars (the-environment)) + class-env)) + (eval `(set! self ',i) (instance-env i)) + (init-instance ',args ,class i e) + i))) + +(define (init-instance args class instance env) + (let ((other-args)) + (do ((a args (cdr a))) ((null? a)) + (if (and (pair? (car a)) (= (length (car a)) 2) + (find-var (class-instance-vars class) (car a))) + (instance-set! instance (caar a) (eval (cadar a) env)) + (set! other-args (cons (eval (car a) env) other-args)))) + (call-init-methods class instance (reverse! other-args)))) + +;;; Call all initialize-instance methods in super-class to sub-class +;;; order in the environment of `instance' with arguments `args'. + +(define (call-init-methods class instance args) + (let ((called '())) + (let loop ((class class)) + (if (not (null? (class-super class))) + (loop (eval (class-super class)))) + (if (method-known? 'initialize-instance class) + (let ((method (lookup-method 'initialize-instance class))) + (if (not (memq method called)) + (begin + (apply (hack-procedure-environment! + method (instance-env instance)) + args) + (set! called (cons method called))))))))) + +(define (send instance msg . args) + (check-instance 'send instance) + (let ((class (eval (class-name instance)))) + (if (not (method-known? msg class)) + (error 'send "message not understood: ~s" `(,msg ,@args)) + (apply (hack-procedure-environment! (lookup-method msg class) + (instance-env instance)) + args)))) + +;;; If the message is not understood, return #f. Otherwise return +;;; a list of one element, the result of the method. + +(define (send-if-handles instance msg . args) + (check-instance 'send-if-handles instance) + (let ((class (eval (class-name instance)))) + (if (not (method-known? msg class)) + #f + (list (apply (hack-procedure-environment! (lookup-method msg class) + (instance-env instance)) + args))))) + +(define (describe-class c) + (check-class 'describe-class c) + (format #t "Class name: ~s~%" (class-name c)) + (format #t "Superclass: ~s~%" + (if (not (null? (class-super c))) + (class-super c) + 'None)) + (format #t "Instancevars: ") + (do ((v (class-instance-vars c) (cdr v)) (space #f #t)) ((null? v)) + (if space + (format #t " ")) + (print (cons (caar v) (cadar v)))) + (format #t "Classvars/Methods: ") + (define v (car (environment->list (class-env c)))) + (if (not (null? v)) + (do ((f v (cdr f)) (space #f #t)) ((null? f)) + (if space + (format #t " ")) + (print (car f))) + (print 'None)) + #v) + +(define (describe-instance i) + (check-instance 'describe-instance i) + (format #t "Instance of: ~s~%" (class-name i)) + (format #t "Instancevars: ") + (do ((f (car (environment->list (instance-env i))) (cdr f)) + (space #f #t)) ((null? f)) + (if space + (format #t " ")) + (print (car f))) + #v) diff --git a/scm/parse.scm b/scm/parse.scm new file mode 100644 index 0000000..ad3b1fd --- /dev/null +++ b/scm/parse.scm @@ -0,0 +1,16 @@ +;;; -*-Scheme-*- +;;; +;;; string-tokenize -- parse a string into a list of tokens + +(define (string-tokenize s) + (let ((i 0) (j) + (n (string-length s))) + (let loop ((args '())) + (while (and (< i n) (char-whitespace? (string-ref s i))) + (set! i (1+ i))) + (if (>= i n) + (reverse! args) + (set! j i) + (while (and (< i n) (not (char-whitespace? (string-ref s i)))) + (set! i (1+ i))) + (loop (cons (substring s j i) args)))))) diff --git a/scm/pp.scm b/scm/pp.scm new file mode 100644 index 0000000..05d8e8a --- /dev/null +++ b/scm/pp.scm @@ -0,0 +1,117 @@ +;;; -*-Scheme-*- +;;; +;;; Trivial pretty-printer + +(provide 'pp) + +(define pp) + +(let ((max-pos 55) (pos 0) (tab-stop 8)) + + (put 'lambda 'special #t) + (put 'macro 'special #t) + (put 'define 'special #t) + (put 'define-macro 'special #t) + (put 'define-structure 'special #t) + (put 'fluid-let 'special #t) + (put 'let 'special #t) + (put 'let* 'special #t) + (put 'letrec 'special #t) + (put 'case 'special #t) + + (put 'call-with-current-continuation 'long #t) + + (put 'quote 'abbr "'") + (put 'quasiquote 'abbr "`") + (put 'unquote 'abbr ",") + (put 'unquote-splicing 'abbr ",@") + +(set! pp (lambda (x) + (set! pos 0) + (cond ((eq? (type x) 'compound) + (set! x (procedure-lambda x))) + ((eq? (type x) 'macro) + (set! x (macro-body x)))) + (fluid-let ((garbage-collect-notify? #f)) + (pp-object x)) + #v)) + +(define (flat-size s) + (fluid-let ((print-length 50) (print-depth 10)) + (string-length (format #f "~a" s)))) + +(define (pp-object x) + (if (or (null? x) (pair? x)) + (pp-list x) + (if (void? x) + (display "#v") + (write x)) + (set! pos (+ pos (flat-size x))))) + +(define (pp-list x) + (if (and (pair? x) + (symbol? (car x)) + (string? (get (car x) 'abbr)) + (= 2 (length x))) + (let ((abbr (get (car x) 'abbr))) + (display abbr) + (set! pos (+ pos (flat-size abbr))) + (pp-object (cadr x))) + (if (> (flat-size x) (- max-pos pos)) + (pp-list-vertically x) + (pp-list-horizontally x)))) + +(define (pp-list-vertically x) + (maybe-pp-list-vertically #t x)) + +(define (pp-list-horizontally x) + (maybe-pp-list-vertically #f x)) + +(define (maybe-pp-list-vertically vertical? list) + (display "(") + (set! pos (1+ pos)) + (if (null? list) + (begin + (display ")") + (set! pos (1+ pos))) + (let ((pos1 pos)) + (pp-object (car list)) + (if (and vertical? + (or + (and (pair? (car list)) + (not (null? (cdr list)))) + (and (symbol? (car list)) + (get (car list) 'long)))) + (indent-newline (1- pos1))) + (let ((pos2 (1+ pos)) (key (car list))) + (let tail ((flag #f) (l (cdr list))) + (cond ((pair? l) + (if flag + (indent-newline + (if (and (symbol? key) (get key 'special)) + (1+ pos1) + pos2)) + (display " ") + (set! pos (1+ pos))) + (pp-object (car l)) + (tail vertical? (cdr l))) + (else + (cond ((not (null? l)) + (display " . ") + (set! pos (+ pos 3)) + (if flag (indent-newline pos2)) + (pp-object l))) + (display ")") + (set! pos (1+ pos))))))))) + + (define (indent-newline x) + (newline) + (set! pos x) + (let loop ((i x)) + (cond ((>= i tab-stop) + (display "\t") + (loop (- i tab-stop))) + ((> i 0) + (display " ") + (loop (1- i))))))) + diff --git a/scm/qsort.scm b/scm/qsort.scm new file mode 100644 index 0000000..8568c36 --- /dev/null +++ b/scm/qsort.scm @@ -0,0 +1,32 @@ +;;; -*-Scheme-*- +;;; +;;; Quicksort (straight from Wirth, Algorithmen & Datenstrukturen, p. 117) + +(provide 'sort) + +(define (sort obj pred) + (if (vector? obj) + (sort! (vector-copy obj) pred) + (vector->list (sort! (list->vector obj) pred)))) + +(define (sort! v pred) + (define (internal-sort l r) + (let ((i l) (j r) (x (vector-ref v (quotient (1- (+ l r)) 2)))) + (let loop () + (do () ((not (pred (vector-ref v i) x))) (set! i (1+ i))) + (do () ((not (pred x (vector-ref v j)))) (set! j (1- j))) + (if (<= i j) + (begin + (vector-set! v j (vector-set! v i (vector-ref v j))) + (set! i (1+ i)) + (set! j (1- j)))) + (if (<= i j) + (loop))) + (if (< l j) + (internal-sort l j)) + (if (< i r) + (internal-sort i r)))) + (let ((len (vector-length v))) + (if (> len 1) + (internal-sort 0 (1- len))) + v)) diff --git a/scm/record.scm b/scm/record.scm new file mode 100644 index 0000000..a09f15a --- /dev/null +++ b/scm/record.scm @@ -0,0 +1,81 @@ +;;; -*-Scheme-*- +;;; +;;; The Scheme layer of the record extension. + +(require 'record.o) + +(define (record-field-index name fields) + (let loop ((fields fields) (index 0)) + (cond ((null? fields) + (error 'record-field-index "invalid field name")) + ((eq? name (car fields)) + index) + (else + (loop (cdr fields) (1+ index)))))) + +(define (record-constructor rtd . fields) + + (define (check-fields f) + (if (not (null? f)) + (if (or (not (symbol? (car f))) (memq (car f) (cdr f))) + (error 'record-constructor "invalid field name") + (check-fields (cdr f))))) + + (let* ((rtd-fields (record-type-field-names rtd)) + (indexes '()) + (size (length rtd-fields))) + (if (null? fields) + (set! fields rtd-fields) + (if (not (null? (cdr fields))) + (error 'record-constructor "too many arguments")) + (set! fields (car fields)) + check-fields fields) + (set! indexes + (map (lambda (x) (record-field-index x rtd-fields)) fields)) + (lambda args + (if (not (= (length args) (length fields))) + (error 'record-constructor "invalid number of fields")) + (let ((vec (make-vector size '()))) + (for-each + (lambda (index value) + (vector-set! vec index value)) + indexes args) + (make-record rtd vec))))) + +(define (record-predicate rtd) + (if (not (record-type? rtd)) + (error 'record-predicate "argument not a record-type")) + (lambda (obj) + (and (record? obj) (eq? (record-type-descriptor obj) rtd)))) + +(define (record-accessor rtd field-name) + (let ((index (record-field-index field-name (record-type-field-names rtd)))) + (lambda (obj) + (if (and (record? obj) (eq? (record-type-descriptor obj) rtd)) + (vector-ref (record-values obj) index) + (error 'record-accessor "argument not of correct record type"))))) + +(define (record-modifier rtd field-name) + (let ((index (record-field-index field-name (record-type-field-names rtd)))) + (lambda (obj val) + (if (and (record? obj) (eq? (record-type-descriptor obj) rtd)) + (vector-set! (record-values obj) index val) + (error 'record-modifier "argument not of correct record type"))))) + +(define (describe-record-type rtd) + (format #t "a record type.~%") + (if (null? (record-type-field-names rtd)) + (format #t "It has no fields.~%") + (format #t "Its fields are: ~s.~%" (record-type-field-names rtd)))) + +(define (describe-record rec) + (format #t "a record.~%") + (let ((fields (record-type-field-names (record-type-descriptor rec)))) + (if (null? fields) + (format #t "It has no fields.~%") + (format #t "Its fields are:") + (for-each (lambda (f v) (format #t " (~s ~s)" f v)) + fields (vector->list (record-values rec))) + (format #t ".~%")))) + +(provide 'record) diff --git a/scm/recordutil.scm b/scm/recordutil.scm new file mode 100644 index 0000000..04ce001 --- /dev/null +++ b/scm/recordutil.scm @@ -0,0 +1,41 @@ +;;; -*-Scheme-*- +;;; +;;; Utility macros for use with the record extension. + +(define-macro (define-record-type name fields) + (let* ((rtd (eval `(make-record-type ',name ',fields))) + (namestr (symbol->string name))) + `(begin + (define + ,(string->symbol (string-append namestr "-record")) ,rtd) + (define + ,(string->symbol (string-append "make-" namestr "-record")) + ,(record-constructor rtd '())) + (define + ,(string->symbol (string-append namestr "-record?")) + ,(record-predicate rtd)) #v))) + +(define-macro (define-record-accessors rtd) + (let* ((r (eval rtd))) + `(begin + ,@(map (lambda (field) + `(define ( + ,(string->symbol (string-append (record-type-name r) "-" + (symbol->string field))) + record) + (,(record-accessor r field) record))) + (record-type-field-names r)) #v))) + +(define-macro (define-record-modifiers rtd) + (let* ((r (eval rtd))) + `(begin + ,@(map (lambda (field) + `(define ( + ,(string->symbol (string-append + "set-" (record-type-name r) "-" + (symbol->string field) "!")) + record value) + (,(record-modifier r field) record value))) + (record-type-field-names r)) #v))) + +(provide 'recordutil) diff --git a/scm/regexp.scm b/scm/regexp.scm new file mode 100644 index 0000000..042122d --- /dev/null +++ b/scm/regexp.scm @@ -0,0 +1,23 @@ +;;; -*-Scheme-*- +;;; +;;; The Scheme layer of the regexp extension is (almost) empty for now. +;;; It mainly exists to enable use of "(require 'regexp)". + +(require 'regexp.o) + +(define (describe-regexp r) + (format #t "a regular expression.~%") + (format #t "Its pattern is ~s,~%" (regexp-pattern r)) + (format #t "and its flags are ~s.~%" (regexp-flags r))) + +(define (describe-regexp-match m) + (format #t "a regular expression match.~%") + (let ((n (regexp-match-number m))) + (if (zero? n) + (format #t "It has no substring matches.~%") + (format #t "It has ~s substring match~a:~%" n (if (= n 1) "" "es")) + (do ((i 0 (1+ i))) ((= i n)) + (format #t " ~s~%" (cons (regexp-match-start m i) + (regexp-match-end m i))))))) + +(provide 'regexp) diff --git a/scm/safe-env.scm b/scm/safe-env.scm new file mode 100644 index 0000000..8363ed0 --- /dev/null +++ b/scm/safe-env.scm @@ -0,0 +1,15 @@ +;;; -*-Scheme-*- +;;; +;;; This macro evaluates its arguments (arbitrary expressions) in a +;;; lexical environment created as a copy of the global environment +;;; in which all the predefined primitives are bound. +;;; Contributed by Carsten Bormann + +(define-macro (with-safe-environment . body) + (let* ((built-in-environment + (car (last-pair (environment->list (the-environment))))) + (binding-copy + (map (lambda (p) + (list (car p) (car p))) + built-in-environment)) ) + `(let ,binding-copy ,@body))) diff --git a/scm/setf.scm b/scm/setf.scm new file mode 100644 index 0000000..56ee4ba --- /dev/null +++ b/scm/setf.scm @@ -0,0 +1,28 @@ +;;; -*-Scheme-*- +;;; +;;; An attempt on defsetf and setf + +(define defsetf) +(define get-setter) + +(let ((setters '())) + + (set! defsetf + (lambda (accessor setter) + (set! setters (cons (cons accessor setter) setters)) + #v)) + + (set! get-setter + (lambda (accessor) + (let ((a (assoc accessor setters))) + (if a + (cdr a) + (error 'get-setter "no setter for ~s" accessor)))))) + +(define-macro (setf var val) + (cond + ((symbol? var) `(set! ,var ,val)) + ((pair? var) + (let ((setter (get-setter (eval (car var))))) + `(,setter ,@(cdr var) ,val))) + (else (error 'setf "symbol or form expected")))) diff --git a/scm/struct.scm b/scm/struct.scm new file mode 100644 index 0000000..fe1a28d --- /dev/null +++ b/scm/struct.scm @@ -0,0 +1,120 @@ +;;; -*-Scheme-*- +;;; +;;; The `strucuture' extension is obsolete and should not be used in +;;; applications any longer; it has been replaced by the more powerful +;;; `record' extension. +;;; +;;; The Scheme part of the structures implementation +;;; +;;; (define-structure name slot slot ...) +;;; +;;; slot = slot-name or (slot-name initial-value) + +(require 'struct.o) + +(define-macro (define-structure name . slot-descr) + (internal-define-structure name slot-descr #t)) + +(define-macro (define-simple-structure name . slot-descr) + (internal-define-structure name slot-descr #f)) + +(define (internal-define-structure name slot-descr full?) + (if (not (symbol? name)) + (error 'define-structure "structure name must be a symbol")) + (if (null? slot-descr) + (error 'define-structure "structure has no slots")) + (let* ((s (symbol->string name)) + (constructor + (string->symbol (string-append "make-" s))) + (predicator + (string->symbol (string-append s "?"))) + (copier + (string->symbol (string-append "copy-" s))) + (slots '()) (arg-slots '())) + (for-each + (lambda (slot) + (cond ((symbol? slot) + (set! slots (cons slot slots)) + (set! arg-slots (cons slot arg-slots))) + ((pair? slot) + (if (or (not (pair? (cdr slot))) + (not (null? (cddr slot)))) + (error 'define-structure "invalid slot specification") + (if (not (symbol? (car slot))) + (error 'define-structure "slot name must be a symbol")) + (set! slots (cons (car slot) slots)))) + (else + (error 'define-structure "slot must be symbol or list")))) + slot-descr) + (set! slots (reverse slots)) + `(begin + (make-constructor ,constructor ,name ,slots + ,(reverse arg-slots) ,slot-descr) + (make-predicator ,predicator ',name) + (make-copier ,copier) + ,@(let ((offset -1)) + (map + (lambda (slot) + (let ((f + (string->symbol (format #f "~s-~s" name slot)))) + (set! offset (1+ offset)) + `(make-accessor ,f ',name ,offset))) + slots)) + ,@(if full? (let ((offset -1)) + (map + (lambda (slot) + (let ((f + (string->symbol (format #f "set-~s-~s!" name slot)))) + (set! offset (1+ offset)) + `(make-mutator ,f ',name ,offset))) + slots))) + ',name))) + +(define-macro (make-constructor constructor name slots arg-slots descr) + `(define (,constructor ,@arg-slots) + (let ((,name (make-structure ',name ',slots))) + ,@(let ((offset -1)) + (map + (lambda (slot) + (set! offset (1+ offset)) + `(structure-set! ,name ',name ,offset + ,(if (symbol? slot) + slot + (cadr slot)))) + descr)) + ,name))) + +(define-macro (make-predicator predicator name) + `(define (,predicator x) + (and (structure? x) (eq? (structure-name x) ,name)))) + +(define-macro (make-copier copier) + `(define (,copier x) + (copy-structure x))) + +(define-macro (make-accessor accessor name offset) + `(define (,accessor x) + (structure-ref x ,name ,offset))) + +(define-macro (make-mutator mutator name offset) + `(define (,mutator x val) + (structure-set! x ,name ,offset val))) + +(define (copy-structure s) + (let* ((slots (structure-slots s)) + (name (structure-name s)) + (new (make-structure name slots)) + (size (length slots))) + (do ((offset 0 (1+ offset))) ((= offset size) new) + (structure-set! new name offset (structure-ref s name offset))))) + +(define (describe-structure s) + (format #t "a structure of type ~s.~%" (structure-name s)) + (if (null? (structure-slots s)) + (format #t "It has no slots.~%") + (format #t "Its slots are:") + (for-each (lambda (s v) (format #t " (~s ~s)" s v)) + (structure-slots s) (structure-values s)) + (format #t ".~%"))) + +(provide 'struct) diff --git a/scm/toplevel.scm b/scm/toplevel.scm new file mode 100644 index 0000000..55edd9f --- /dev/null +++ b/scm/toplevel.scm @@ -0,0 +1,110 @@ +;;; -*-Scheme-*- +;;; +;;; Read-eval-print loop and error handler + + +(autoload 'pp 'pp.scm) +(autoload 'apropos 'apropos.scm) +(autoload 'sort 'qsort.scm) +(autoload 'describe 'describe.scm) +(autoload 'backtrace 'debug.scm) +(autoload 'inspect 'debug.scm) + +(define ?) +(define ??) +(define ???) +(define !) +(define !!) +(define !!!) +(define &) + +(define (rep-loop env) + (define input) + (define value) + (let loop () + (set! ??? ??) + (set! ?? ?) + (set! ? &) + ;;; X Windows hack + (if (and (bound? 'display-flush-output) (bound? 'dpy) (display? dpy)) + (display-flush-output dpy)) + (if (> rep-level 0) + (display rep-level)) + (display "> ") + (set! input (read)) + (set! & input) + (if (not (eof-object? input)) + (begin + (set! value (eval input env)) + (set! !!! !!) + (set! !! !) + (set! ! value) + (write value) + (newline) + (loop))))) + +(define rep-frames) +(define rep-level) + +(set! interrupt-handler + (lambda () + (format #t "~%\7Interrupt!~%") + (let ((next-frame (car rep-frames))) + (next-frame #t)))) + +(define-macro (push-frame control-point) + `(begin + (set! rep-frames (cons ,control-point rep-frames)) + (set! rep-level (1+ rep-level)))) + +(define-macro (pop-frame) + '(begin + (set! rep-frames (cdr rep-frames)) + (set! rep-level (1- rep-level)))) + +(define (error-print error-msg) + (format #t "~s: " (car error-msg)) + (apply format `(#t ,@(cdr error-msg))) + (newline)) + +(set! error-handler + (lambda error-msg + (error-print error-msg) + (let loop ((intr-level (enable-interrupts))) + (if (positive? intr-level) + (loop (enable-interrupts)))) + (let loop () + (if (call-with-current-continuation + (lambda (control-point) + (push-frame control-point) + (rep-loop (the-environment)) + #f)) + (begin + (pop-frame) + (loop)))) + (newline) + (pop-frame) + (let ((next-frame (car rep-frames))) + (next-frame #t)))) + +(define top-level-environment (the-environment)) + +(define (top-level) + (let loop () + ;;; Allow GC to free old rep-frames when we get here on "reset": + (set! rep-frames (list top-level-control-point)) + (if (call-with-current-continuation + (lambda (control-point) + (set! rep-frames (list control-point)) + (set! top-level-control-point control-point) + (set! rep-level 0) + (rep-loop top-level-environment) + #f)) + (loop)))) + +(define (the-top-level) + (top-level) + (newline) + (exit)) + +(the-top-level) diff --git a/scm/trace.scm b/scm/trace.scm new file mode 100644 index 0000000..69057a0 --- /dev/null +++ b/scm/trace.scm @@ -0,0 +1,48 @@ +;;; -*-Scheme-*- +;;; +;;; A simple trace package contributed in 1990 by WAKITA Ken +;;; (ken-w@is.s.u-tokyo.ac.jp) + +(define trc:trace-list '(())) + +(define (reset-trace) (set! trc:trace-list '(()))) + +(define-macro (trace func) + `(let ((the-func (eval ,func)) + (result #v)) + (if (assoc ',func trc:trace-list) + (error 'trace "~s already trace on." ,func)) + (if (not (compound? ,func)) + (error 'trace "wrong argument type ~s (expected compound)" + (type ,func))) + (set! trc:trace-list + (cons '() + (cons (cons ',func the-func) + (cdr trc:trace-list)))) + (set! ,func + (lambda param-list + (format #t "# Entering ~s~%" + (cons ',func param-list)) + (set! result (apply the-func param-list)) + (format #t "# Exiting ~s ==> ~s~%" + (cons ',func param-list) + result) + result)))) + +(define-macro (untrace func) + `(let ((the-func (assoc ',func trc:trace-list))) + + (define (remove! func) + (let ((prev trc:trace-list) + (here (cdr trc:trace-list))) + (while (and here + (not (eq? func (caar here)))) + (set! prev here) + (set! here (cdr here))) + (if (not here) + (error 'remove "item ~s not found." func) + (set-cdr! prev (cdr here))))) + + (if the-func + (begin (remove! ',func) + (set! ,func (cdr the-func)))))) diff --git a/scm/unix.scm b/scm/unix.scm new file mode 100644 index 0000000..ec16aa0 --- /dev/null +++ b/scm/unix.scm @@ -0,0 +1,174 @@ +;;; -*-Scheme-*- +;;; +;;; The Scheme layer of the UNIX extension. + +(require 'record) +(require 'recordutil) +(require 'unix.o) + +(define-record-type stat (type mode ino dev nlink uid gid size + atime mtime ctime)) +(define-record-accessors stat-record) + +(define (unix-stat fn) + (let* ((ret (make-stat-record)) + (err (unix-stat-vector-fill! fn (record-values ret)))) + (if (unix-error? err) err ret))) + +(if (feature? 'unix:symlinks) + (define (unix-lstat fn) + (let* ((ret (make-stat-record)) + (err (unix-lstat-vector-fill! fn (record-values ret)))) + (if (unix-error? err) err ret)))) + + +(define-record-type time (seconds minutes hours day-of-month month year + weekday day-of-year dst)) +(define-record-accessors time-record) +(define-record-modifiers time-record) + +(define (unix-decode-localtime t) + (let ((ret (make-time-record))) + (unix-decode-time-vector-fill! t (record-values ret) #f) + ret)) + +(define (unix-decode-utc t) + (let ((ret (make-time-record))) + (unix-decode-time-vector-fill! t (record-values ret) #t) + ret)) + +(define (unix-time->string t) + (cond + ((integer? t) + (unix-time->string-internal t)) + ((time-record? t) + (unix-time->string-internal (record-values t))) + (else + (error 'unix-time->string "argument must be integer or time-record")))) + + +(define-record-type nanotime (nanoseconds minuteswest dst)) +(define-record-accessors nanotime-record) + +(define (unix-internal-make-nanotime v i) + (if (vector-ref v i) + (vector-set! v i (+ (* (car (vector-ref v i)) 1000000000) + (cdr (vector-ref v i)))))) + +(define (unix-nanotime) + (let* ((ret (make-nanotime-record)) + (v (record-values ret))) + (unix-nanotime-vector-fill! v) + (vector-set! v 0 (+ (* (car (vector-ref v 0)) 1000000000) + (cdr (vector-ref v 0)))) + ret)) + + +(define-record-type system (hostname sysname osname)) +(define-record-accessors system-record) + +(define (unix-system-info) + (let ((ret (make-system-record))) + (unix-system-info-vector-fill! (record-values ret)) + ret)) + + +(define-record-type passwd (name password uid gid gecos homedir shell)) +(define-record-accessors passwd-record) + +(define (unix-get-passwd . arg) + (let* ((ret (make-passwd-record)) + (err (apply unix-get-passwd-vector-fill! (record-values ret) arg))) + (if (unix-error? err) err ret))) + + +(define-record-type group (name password gid members)) +(define-record-accessors group-record) + +(define (unix-get-group . arg) + (let* ((ret (make-group-record)) + (err (apply unix-get-group-vector-fill! (record-values ret) arg))) + (if (unix-error? err) err ret))) + + +(define-record-type resources (user-time system-time)) +(define-record-accessors resources-record) + +(define (unix-process-resources) + (let* ((self (make-resources-record)) + (children (make-resources-record)) + (v1 (record-values self)) + (v2 (record-values children)) + (ticks/s (unix-process-resources-vector-fill! v1 v2)) + (convert (lambda (ticks) (round (/ (* ticks 1000000000) ticks/s))))) + (vector-set! v1 0 (convert (vector-ref v1 0))) + (vector-set! v1 1 (convert (vector-ref v1 1))) + (vector-set! v2 0 (convert (vector-ref v2 0))) + (vector-set! v2 1 (convert (vector-ref v2 1))) + (cons self children))) + + +(if (feature? 'unix:file-locking) + (begin + (define-record-type lock (exclusive? whence start length)) + (define-record-accessors lock-record) + (define-record-modifiers lock-record) + + (define (unix-set-lock fd lock wait?) + (if (not (lock-record? lock)) + (error 'unix-set-lock "argument not a lock-record")) + (unix-internal-lock-operation fd (record-values lock) wait? #\s 0)) + + (define (unix-remove-lock fd lock) + (if (not (lock-record? lock)) + (error 'unix-remove-lock "argument not a lock-record")) + (unix-internal-lock-operation fd (record-values lock) #f #\r 0)) + + (define (unix-query-lock fd lock) + (if (not (lock-record? lock)) + (error 'unix-remove-lock "argument not a lock-record")) + (let* ((ret (make-lock-record)) + (pid (unix-internal-lock-operation fd (record-values lock) + #f #\q (record-values ret)))) + (if pid + (cons pid ret) + #f))))) + + +(define-record-type wait (pid status code core-dump? resources)) +(define-record-accessors wait-record) + +(define (unix-wait . options) + (let* ((ret (make-wait-record)) + (resources ((record-constructor resources-record) #f #f)) + (v (record-values ret)) + (rv (record-values resources)) + (err (apply unix-wait-vector-fill! v rv options))) + (unix-internal-make-nanotime rv 0) + (unix-internal-make-nanotime rv 1) + (vector-set! v 4 resources) + (if (unix-error? err) err ret))) + +(if (feature? 'unix:wait-process) + (define (unix-wait-process pid . options) + (let* ((ret (make-wait-record)) + (resources ((record-constructor resources-record) #f #f)) + (v (record-values ret)) + (rv (record-values resources)) + (err (apply unix-wait-process-vector-fill! v rv pid options))) + (unix-internal-make-nanotime rv 0) + (unix-internal-make-nanotime rv 1) + (vector-set! v 4 resources) + (if (unix-error? err) err ret)))) + + +(define (unix-perror str) + (format #t "~a: ~E" str)) + +(define-macro (unix-errval expr) + `(fluid-let ((unix-call-standard-error-handler? #f)) + ,expr)) + +;; also need the opposite of unix-errval (i.e. make sure error is handled) + +(provide 'unix) diff --git a/scm/xlib.scm b/scm/xlib.scm new file mode 100644 index 0000000..18eff5b --- /dev/null +++ b/scm/xlib.scm @@ -0,0 +1,429 @@ +;;; -*-Scheme-*- +;;; +;;; The Scheme part of the Xlib extension. + +(require 'siteinfo) + +(fluid-let ((load-libraries (string-append site-lib-xlib " " load-libraries))) + (require 'xlib.o)) + +(define (create-window . args) + (apply-with-keywords + 'create-window xlib-create-window + '((parent) (x 0) (y 0) (width) (height) (border 2)) + 'set-window-attributes set-window-attributes-slots args)) + +(define (create-gcontext . args) + (apply-with-keywords + 'create-gcontext xlib-create-gcontext + '((window)) + 'gcontext gcontext-slots args)) + +(define (set-wm-hints! . args) + (apply-with-keywords + 'set-wm-hints! xlib-set-wm-hints! + '((window)) + 'wm-hints wm-hints-slots args)) + +(define (wm-hints w) + (cdr (vector->list (xlib-wm-hints w)))) + +(define (set-wm-normal-hints! . args) + (apply-with-keywords + 'set-wm-normal-hints! xlib-set-wm-normal-hints! + '((window)) + 'size-hints size-hints-slots args)) + +(define (wm-normal-hints w) + (cdr (vector->list (xlib-wm-normal-hints w)))) + +(define (reconfigure-wm-window . args) + (apply-with-keywords + 'reconfigure-wm-window xlib-reconfigure-wm-window + '((window) (screen)) + 'window-configuration window-configuration-slots args)) + + +(define (apply-with-keywords name function formals tag slots args) + (let* ((v (make-vector (1+ (length slots)) '())) + (empty '(empty)) + (l (make-list (1+ (length formals)) empty)) + (slot '())) + (vector-set! v 0 tag) + (do ((a args (cddr a))) ((null? a)) + (if (not (symbol? (car a))) + (error name "even-numbered argument must be a symbol")) + (if (null? (cdr a)) + (error name "missing value for ~s" (car a))) + (set! slot (assq (car a) slots)) + (if slot + (vector-set! v (cdr slot) (cadr a)) + (let loop ((f formals) (g l)) + (if (null? f) + (error name "unknown argument ~s" (car a))) + (if (eq? (car a) (caar f)) + (set-car! g (cadr a)) + (loop (cdr f) (cdr g)))))) + (set-car! (last-pair l) v) + (do ((f formals (cdr f)) (a l (cdr a))) ((null? f)) + (if (eq? (car a) empty) + (if (pair? (cdar f)) + (set-car! a (cadar f)) + (error name "you must specify a value for ~s" (caar f))))) + (apply function l))) + + +;;; Definition of the access and update functions for window attributes, +;;; geometry, gcontexts, etc. + +(define-macro (define-functions definer type fun pref) + (let ((slots (string->symbol (format #f "~s-slots" type)))) + `(for-each eval (map (lambda (s) + (,definer ',type (1+ (length ,slots)) ,fun s ,pref)) ,slots)))) + +(define (define-accessor-with-cache type num-slots fun slot pref) + (let ((name (string->symbol (format #f pref (car slot))))) + `(define (,name object) + (general-accessor object ',type ,fun ,(cdr slot))))) + +(define (define-mutator-with-cache type num-slots fun slot pref) + (let ((name (string->symbol (format #f pref (car slot))))) + `(define (,name object val) + (general-mutator object val ',type ,num-slots ,fun ,(cdr slot))))) + +(define (define-accessor type num-slots fun slot pref) + (let ((name (string->symbol (format #f pref (car slot))))) + `(define (,name . args) + (vector-ref (apply ,fun args) ,(cdr slot))))) + + +(define-functions define-accessor-with-cache + get-window-attributes xlib-get-window-attributes "window-~s") + +(define-functions define-mutator-with-cache + set-window-attributes xlib-change-window-attributes "set-window-~s!") + +(define-functions define-mutator-with-cache + window-configuration xlib-configure-window "set-window-~s!") + +(define-functions define-accessor-with-cache + geometry xlib-get-geometry "drawable-~s") + +(define-functions define-mutator-with-cache + gcontext xlib-change-gcontext "set-gcontext-~s!") + +;; Note: gcontext-clip-mask and gcontext-dashes are bogus. + +(define gcontext-values-slots gcontext-slots) + +(define-functions define-accessor-with-cache + gcontext-values xlib-get-gcontext-values "gcontext-~s") + +(define-functions define-accessor-with-cache + font-info xlib-font-info "font-~s") + +(define-functions define-accessor + char-info xlib-char-info "char-~s") + +(define (min-char-info c) (xlib-char-info c 'min)) +(define (max-char-info c) (xlib-char-info c 'max)) + +;; Note: min-char-attributes, max-char-attributes, and +;; text-extents-attributes are bogus. + +(define-functions define-accessor + char-info min-char-info "min-char-~s") + +(define-functions define-accessor + char-info max-char-info "max-char-~s") + +(define-functions define-accessor + char-info xlib-text-extents "extents-~s") + + +;;; ``cache'' is an a-list of (drawable-or-gcontext-or-font . state) pairs, +;;; where state is a vector of buffers as listed below. Each slot in +;;; a vector can be #f to indicate that the cache is empty. The cache +;;; is manipulated by the ``with'' macro. + +(define cache '()) + +(define num-slots 7) + +(put 'set-window-attributes 'cache-slot 0) +(put 'get-window-attributes 'cache-slot 1) +(put 'window-configuration 'cache-slot 2) +(put 'geometry 'cache-slot 3) +(put 'gcontext 'cache-slot 4) +(put 'font-info 'cache-slot 5) +(put 'gcontext-values 'cache-slot 6) + + +;;; List of buffers that are manipulated by mutator functions and must +;;; be flushed using the associated update function when a ``with'' is +;;; left (e.g., a set-window-attributes buffer is manipulated by +;;; set-window-FOO functions; the buffer is flushed by a call to +;;; (change-window-attributes WINDOW BUFFER)): + +(define mutable-types '(set-window-attributes window-configuration gcontext)) + +(put 'set-window-attributes 'update-function xlib-change-window-attributes) +(put 'window-configuration 'update-function xlib-configure-window) +(put 'gcontext 'update-function xlib-change-gcontext) + + +;;; Some types of buffers in the cache are invalidated when other +;;; buffers are written to. For instance, a get-window-attributes +;;; buffer for a window must be filled again when the window's +;;; set-window-attributes or window-configuration buffers have been +;;; written to. + +(put 'get-window-attributes 'invalidated-by + '(set-window-attributes window-configuration)) +(put 'geometry 'invalidated-by + '(set-window-attributes window-configuration)) +(put 'gcontext-values 'invalidated-by + '(gcontext)) + +;;; Within the scope of a ``with'', the first call to a OBJECT-FOO +;;; function causes the result of the corresponding Xlib function to +;;; be retained in the cache; subsequent calls just read from the cache. +;;; Similarly, calls to Xlib functions for set-OBJECT-FOO! functions are +;;; delayed until exit of the ``with'' body or until a OBJECT-FOO +;;; is called and the cached data for this accessor function has been +;;; invalidated by the call to the mutator function (see ``invalidated-by'' +;;; property above). + +(define-macro (with object . body) + `(if (assq ,object cache) ; if it's already in the cache, just + (begin ,@body) ; execute the body. + (dynamic-wind + (lambda () + (set! cache (cons (cons ,object (make-vector num-slots #f)) cache))) + (lambda () + ,@body) + (lambda () + (for-each (lambda (x) (flush-cache (car cache) x)) mutable-types) + (set! cache (cdr cache)))))) + +;;; If a mutator function has been called on an entry in the cache +;;; of the given type, flush it by calling the right update function. + +(define (flush-cache entry type) + (let* ((slot (get type 'cache-slot)) + (buf (vector-ref (cdr entry) slot))) + (if buf + (begin + ((get type 'update-function) (car entry) buf) + (vector-set! (cdr entry) slot #f))))) + +;;; General accessor function (OBJECT-FOO). See if the data in the +;;; cache have been invalidated. If this is the case, or if the cache +;;; has not yet been filled, fill it. + +(define (general-accessor object type fun slot) + (let ((v) (entry (assq object cache))) + (if entry + (let ((cache-slot (get type 'cache-slot)) + (inval (get type 'invalidated-by))) + (if inval + (let ((must-flush #f)) + (for-each + (lambda (x) + (if (vector-ref (cdr entry) (get x 'cache-slot)) + (set! must-flush #t))) + inval) + (if must-flush + (begin + (for-each (lambda (x) (flush-cache entry x)) inval) + (vector-set! (cdr entry) cache-slot #f))))) + (if (not (vector-ref (cdr entry) cache-slot)) + (vector-set! (cdr entry) cache-slot (fun object))) + (set! v (vector-ref (cdr entry) cache-slot))) + (set! v (fun object))) + (vector-ref v slot))) + + +;;; General mutator function (set-OBJECT-FOO!). If the cache is empty, +;;; put a new buffer of the given type and size into it. Write VAL +;;; into the buffer. + +(define (general-mutator object val type num-slots fun slot) + (let ((entry (assq object cache))) + (if entry + (let ((cache-slot (get type 'cache-slot))) + (if (not (vector-ref (cdr entry) cache-slot)) + (let ((v (make-vector num-slots '()))) + (vector-set! v 0 type) + (vector-set! (cdr entry) cache-slot v) + (vector-set! v slot val)) + (vector-set! (vector-ref (cdr entry) cache-slot) slot val))) + (let ((v (make-vector num-slots '()))) + (vector-set! v 0 type) + (vector-set! v slot val) + (fun object v))))) + + + +(define (translate-text string) + (list->vector (map char->integer (string->list string)))) + +(define (drawable? d) + (or (window? d) (pixmap? d))) + +(define (clear-window w) + (clear-area w 0 0 0 0 #f)) + +(define (raise-window w) + (set-window-stack-mode! w 'above)) + +(define (lower-window w) + (set-window-stack-mode! w 'below)) + +(define (restack-windows l) + (let loop ((w (car l)) (t (cdr l))) + (if t + (begin + (set-window-sibling! (car t) w) + (set-window-stack-mode! (car t) 'below) + (loop (car t) (cdr t)))))) + +(define (define-cursor w c) + (set-window-cursor! w c)) + +(define (undefine-cursor w) + (set-window-cursor! w 'none)) + +(define (create-font-cursor dpy which) + (let ((font (open-font dpy 'cursor))) + (unwind-protect + (create-glyph-cursor font which font (1+ which) + (make-color 0 0 0) (make-color 1 1 1)) + (close-font font)))) + +(define (synchronize d) + (set-after-function! d (lambda (d) (display-wait-output d #f)))) + +(define (font-property font prop) + (let* ((dpy (font-display font)) + (atom (intern-atom dpy prop)) + (properties (vector->list (font-properties font))) + (result (assq atom properties))) + (if result + (cdr result) + result))) + +(define-macro (with-server-grabbed dpy . body) + `(dynamic-wind + (lambda () (grab-server ,dpy)) + (lambda () ,@body) + (lambda () (ungrab-server ,dpy)))) + +(define (warp-pointer dst dst-x dst-y) + (general-warp-pointer (window-display dst) dst dst-x dst-y 'none 0 0 0 0)) + +(define (warp-pointer-relative dpy x-off y-off) + (general-warp-pointer dpy 'none x-off y-off 'none 0 0 0 0)) + +(define (query-best-cursor dpy w h) + (query-best-size dpy w h 'cursor)) + +(define (query-best-tile dpy w h) + (query-best-size dpy w h 'tile)) + +(define (query-best-stipple dpy w h) + (query-best-size dpy w h 'stipple)) + +(define store-buffer) +(define store-bytes) +(define fetch-buffer) +(define fetch-bytes) +(define rotate-buffers) + +(let ((xa-string (make-atom 31)) + (xa-cut-buffers + (vector (make-atom 9) (make-atom 10) (make-atom 11) (make-atom 12) + (make-atom 13) (make-atom 14) (make-atom 15) (make-atom 16)))) + +(set! store-buffer (lambda (dpy bytes buf) + (if (<= 0 buf 7) + (change-property + (display-root-window dpy) + (vector-ref xa-cut-buffers buf) xa-string 8 'replace bytes)))) + +(set! store-bytes (lambda (dpy bytes) + (store-buffer dpy bytes 0))) + +(set! fetch-buffer (lambda (dpy buf) + (if (<= 0 buf 7) + (multiple-value-bind (type format data bytes-left) + (get-property + (display-root-window dpy) + (vector-ref xa-cut-buffers buf) xa-string 0 100000 #f) + (if (and (eq? type xa-string) (< format 32)) data "")) + ""))) + +(set! fetch-bytes (lambda (dpy) + (fetch-buffer dpy 0))) + +(set! rotate-buffers (lambda (dpy delta) + (rotate-properties (display-root-window dpy) xa-cut-buffers delta)))) + + +(define xa-wm-normal-hints (make-atom 40)) + +(define (xlib-wm-normal-hints w) + (xlib-wm-size-hints w xa-wm-normal-hints)) + +(define (xlib-set-wm-normal-hints! w h) + (xlib-set-wm-size-hints! w xa-wm-normal-hints h)) + + +(define xa-wm-name (make-atom 39)) +(define xa-wm-icon-name (make-atom 37)) +(define xa-wm-client-machine (make-atom 36)) + +(define (wm-name w) + (get-text-property w xa-wm-name)) + +(define (wm-icon-name w) + (get-text-property w xa-wm-icon-name)) + +(define (wm-client-machine w) + (get-text-property w xa-wm-client-machine)) + +(define (set-wm-name! w s) + (set-text-property! w s xa-wm-name)) + +(define (set-wm-icon-name! w s) + (set-text-property! w s xa-wm-icon-name)) + +(define (set-wm-client-machine! w s) + (set-text-property! w s xa-wm-client-machine)) + + +;; Backwards compatibility: + +(define display-root-window display-default-root-window) + +(define display-colormap display-default-colormap) + +;; Backwards compatibility hack for old-style make-* functions: + +(define-macro (make-compat make-macro create-function) + `(define-macro (,make-macro . args) + (let ((cargs + (let loop ((a args) (v '())) + (if (null? a) + v + (loop (cdr a) `(',(caar a) ,(cadar a) ,@v)))))) + (cons ,create-function cargs)))) + +(make-compat make-gcontext create-gcontext) +(make-compat make-window create-window) + + +;;; Describe functions go here: + + +(provide 'xlib) diff --git a/scm/xt.scm b/scm/xt.scm new file mode 100644 index 0000000..082407a --- /dev/null +++ b/scm/xt.scm @@ -0,0 +1,48 @@ +;;; -*-Scheme-*- +;;; +;;; The Scheme part of the Xt extension. + +(require 'siteinfo) + +(if (feature? 'motif) + (fluid-let ((load-libraries + (string-append site-force-load-xm " " site-lib-xmotif " " + load-libraries))) + (require 'xt.o 'xt-motif.o)) + (fluid-let ((load-libraries + (string-append site-lib-xt " " load-libraries))) + (require 'xt.o))) + +(load 'xlib.scm) + +(provide 'xlib) +(provide 'xt) + +(define (manage-child w) + (manage-children (list w))) + +(define (unmanage-child w) + (unmanage-children (list w))) + +(define (add-callback w name fun) + (add-callbacks w name (list fun))) + +(define (create-managed-widget . args) + (let ((w (apply create-widget args))) + (manage-child w) + w)) + +(define application-initialize #f) + +(let ((con) (dpy) (app-class #f) (shell-class #f)) + (set! application-initialize + (lambda (name . fallback-res) + (set! con (create-context)) + (if (not (null? fallback-res)) + (apply set-context-fallback-resources! con fallback-res)) + (set! dpy (initialize-display con #f name app-class)) + (create-shell name shell-class (find-class 'application-shell) dpy)))) + +;; Backwards compatibility: + +(define widget-window widget->window) diff --git a/scm/xwidgets.scm b/scm/xwidgets.scm new file mode 100644 index 0000000..accf861 --- /dev/null +++ b/scm/xwidgets.scm @@ -0,0 +1,54 @@ +;;; -*-Scheme-*- +;;; +;;; The Scheme part of the X11 widget interface. + +(require 'xt) + +(define widget-subdirectory 'xaw) + +(define load-always '()) + +(define widget-aliases #f) + +(define (widget-loaded? w) + (feature? (string->symbol (format #f "~a:~a.o" widget-subdirectory w)))) + +(define-macro (load-widgets . w) + (let ((wl '()) (l '())) + (if (null? w) + (error 'load-widgets "no arguments")) + (for-each + (lambda (w) + (if (not (symbol? w)) + (error 'load-widgets "argument not a symbol")) + (if (not (widget-loaded? w)) + (set! l (cons w l)))) + w) + (for-each + (lambda (w) + (if (not (widget-loaded? w)) + (set! l (cons w l)))) + load-always) + (if (not (null? l)) + (begin + (if (not widget-aliases) + (load (format #f "~a/ALIASES" widget-subdirectory))) + (format #t "[Loading ") + (do ((f l (cdr f))) ((null? f)) + (let* ((file (car f)) + (alias (assq (car f) widget-aliases))) + (if alias (set! file (cdr alias))) + (format #t "~a~a" file (if (null? (cdr f)) "" " ")) + (set! wl (cons (format #f "~a/~a.o" widget-subdirectory file) + wl)))) + (format #t "]~%") + `(fluid-let ((load-libraries + (if (feature? 'motif) + (string-append site-lib-xmotif " " load-libraries) + (string-append site-lib-xaw " " load-libraries)))) + (load ',wl))) + #f))) + +(define load-widget load-widgets) + +(provide 'xwidgets) diff --git a/scripts/Makefile b/scripts/Makefile new file mode 100644 index 0000000..e61d7f4 --- /dev/null +++ b/scripts/Makefile @@ -0,0 +1,23 @@ +SHELL=/bin/sh +MAKE=make + +all: default + +Makefile.local: ../config/system ../config/site + $(SHELL) ./build + +default: Makefile.local + $(MAKE) -f Makefile.local + +install: Makefile.local + $(MAKE) -f Makefile.local install + +localize: Makefile.local + $(MAKE) -f Makefile.local localize + +lint: + +clean: + +distclean: Makefile.local + $(MAKE) -f Makefile.local distclean diff --git a/scripts/README b/scripts/README new file mode 100644 index 0000000..a5749dd --- /dev/null +++ b/scripts/README @@ -0,0 +1,20 @@ +Running `make' in this directory creates the localized versions of the +shell scripts from the (unlocalized) source files in the subdirectory +`src'. A script `makedl' (without suffix) is created by choosing the +correct makedl-xyz version from src. + +Running `make install' copies linkscheme, ldflags, and makedl into +$install_dir/lib. + +The shell script `linkscheme' can be used used to link the Scheme +interpreter statically with a number of extensions and/or with an +application. The script `makedl' is used to create a dynamically +loadable object file from one or more ordinary object files. There is +one `makedl-xyz' script in `src' for each dynamic loading mechanism +supported by Elk; the `xyz' suffix corresponds to the possible values +of $load_obj in config/system. + +The shell script `ldflags' echoes the linker flags that are required to +link the interpreter (at least -lm). You are supposed to use this +script in your Makefiles when linking the interpreter with extensions +and/or an application. diff --git a/scripts/build b/scripts/build new file mode 100755 index 0000000..48b8a3c --- /dev/null +++ b/scripts/build @@ -0,0 +1,43 @@ +. ../config/system +. ../config/site + +if [ _$load_obj = _ ]; then + load_obj=none +fi + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +FILES= linkscheme makedl ldflags + +all: \$(FILES) + +localize: \$(FILES) + +linkscheme: src/linkscheme ../config/system ../config/site + \$(SHELL) src/\$@ > \$@ + chmod +x \$@ + +makedl: src/makedl-$load_obj ../config/system ../config/site + \$(SHELL) src/makedl-$load_obj > \$@ + chmod +x \$@ + +ldflags: src/ldflags ../config/system ../config/site + \$(SHELL) src/\$@ > \$@ + chmod +x \$@ + +install: \$(FILES) + -@if [ ! -d $install_dir/lib ]; then \\ + echo mkdir $install_dir/lib; \\ + mkdir $install_dir/lib; \\ + fi + cp linkscheme $install_dir/lib + cp makedl $install_dir/lib + cp ldflags $install_dir/lib + +distclean: + rm -f \$(FILES) Makefile.local +EOT diff --git a/scripts/src/ldflags b/scripts/src/ldflags new file mode 100644 index 0000000..f4a7abc --- /dev/null +++ b/scripts/src/ldflags @@ -0,0 +1,8 @@ +. ../config/system +. ../config/site + +cat <> exportlist + ;; + esac + done + cat exportlist + $cc -o \$aout -bexport:exportlist \$ofile \$extensions $ldflags + rm exportlist + ;; +*-aix4*-cc) + echo Creating export list for AIX 4.x linker: + for e in \$extensions + do + case \$e in + -l*) ;; + *) + nm \$e | grep '^\.$init_prefix.* *T ' \\ + | awk '{print \$1}' >> exportlist + ;; + esac + done + cat exportlist + $cc -o \$aout -bexport:exportlist \$ofile \$extensions $ldflags + rm exportlist + ;; +*) + $cc -o \$aout \$ofile \$extensions $ldflags + ;; +esac +chmod +x \$aout +HERE diff --git a/scripts/src/makedl-dl b/scripts/src/makedl-dl new file mode 100644 index 0000000..7d24658 --- /dev/null +++ b/scripts/src/makedl-dl @@ -0,0 +1,24 @@ +. ../config/system +. ../config/site + +cat <files = files; + AUTOLOAD(al)->env = The_Environment; + al = Cons (al, Null); + al = Cons (sym, al); + ret = P_Define (al); + GC_Unlink; + return ret; +} + +Object Do_Autoload (sym, al) Object sym, al; { + Object val, a[1]; + GC_Node; + + if (Var_Is_True (V_Autoload_Notifyp)) { + a[0] = AUTOLOAD(al)->files; + Format (Standard_Output_Port, "[Autoloading ~a]~%", 18, 1, a); + } + GC_Link (sym); + (void)General_Load (AUTOLOAD(al)->files, AUTOLOAD(al)->env); + GC_Unlink; + val = SYMBOL(sym)->value; + if (TYPE(val) == T_Autoload) + Primitive_Error ("autoloading failed to define ~s", sym); + return val; +} diff --git a/src/bignum.c b/src/bignum.c new file mode 100644 index 0000000..2efcf3c --- /dev/null +++ b/src/bignum.c @@ -0,0 +1,796 @@ +#include +#include + +#include "kernel.h" + +Object Make_Uninitialized_Bignum (size) { + Object big; + + big = Alloc_Object ((sizeof (struct S_Bignum) - sizeof (gran_t)) + + (size * sizeof (gran_t)), T_Bignum, 0); + BIGNUM(big)->minusp = False; + BIGNUM(big)->size = size; + BIGNUM(big)->usize = 0; + return big; +} + +Object Copy_Bignum (x) Object x; { + Object big; + register size; + GC_Node; + + GC_Link (x); + big = Make_Uninitialized_Bignum (size = BIGNUM(x)->usize); + BIGNUM(big)->minusp = BIGNUM(x)->minusp; + BIGNUM(big)->usize = size; + bcopy ((char *)BIGNUM(x)->data, (char *)BIGNUM(big)->data, + size * sizeof (gran_t)); + GC_Unlink; + return big; +} + +Object Copy_S_Bignum (s) struct S_Bignum *s; { + Object big; + register size; + + big = Make_Uninitialized_Bignum (size = s->usize); + BIGNUM(big)->minusp = s->minusp; + BIGNUM(big)->usize = size; + bcopy ((char *)s->data, (char *)BIGNUM(big)->data, + size * sizeof (gran_t)); + return big; +} + +Object Make_Bignum (buf, neg, radix) const char *buf; { + Object big; + register const char *p; + register c; + register size = (strlen (buf) + 4) / 4; + + big = Make_Uninitialized_Bignum (size); + BIGNUM(big)->minusp = neg ? True : False; + p = buf; + while (c = *p++) { + Bignum_Mult_In_Place (BIGNUM(big), radix); + if (radix == 16) { + if (isupper (c)) + c = tolower (c); + if (c >= 'a') + c = '9' + c - 'a' + 1; + } + Bignum_Add_In_Place (BIGNUM(big), c - '0'); + } + Bignum_Normalize_In_Place (BIGNUM(big)); /* to avoid -0 */ + return big; +} + +Object Reduce_Bignum (x) Object x; { + unsigned ret = 0; + int i, shift = 0, size = BIGNUM(x)->usize; + int digits = sizeof(int)/2; + + if (size > digits) + return x; + for (i = 0; i < digits && i < size; i++, shift += 16) + ret |= (unsigned)BIGNUM(x)->data[i] << shift; + if (Truep (BIGNUM(x)->minusp)) { + if (ret > (~(unsigned)0 >> 1) + 1) + return x; + return Make_Integer (-ret); + } else { + if (ret > ~(unsigned)0 >> 1) + return x; + return Make_Integer (ret); + } +} + +Bignum_Mult_In_Place (x, n) register struct S_Bignum *x; { + register i = x->usize; + register gran_t *p = x->data; + register j; + register unsigned k = 0; + + for (j = 0; j < i; ++j) { + k += n * *p; + *p++ = k; + k >>= 16; + } + if (k) { + if (i >= x->size) + Panic ("Bignum_Mult_In_Place"); + *p++ = k; + x->usize++; + } +} + +Bignum_Add_In_Place (x, n) register struct S_Bignum *x; { + register i = x->usize; + register gran_t *p = x->data; + register j = 0; + register unsigned k = n; + + if (i == 0) goto extend; + k += *p; + *p++ = k; + while (k >>= 16) { + if (++j >= i) { + extend: + if (i >= x->size) + Panic ("Bignum_Add_In_Place"); + *p++ = k; + x->usize++; + return; + } + k += *p; + *p++ = k; + } +} + +Bignum_Div_In_Place (x, n) register struct S_Bignum *x; { + register i = x->usize; + register gran_t *p = x->data + i; + register unsigned k = 0; + for ( ; i; --i) { + k <<= 16; + k += *--p; + *p = k / n; + k %= n; + } + Bignum_Normalize_In_Place (x); + return k; +} + +Bignum_Normalize_In_Place (x) register struct S_Bignum *x; { + register i = x->usize; + register gran_t *p = x->data + i; + while (i && !*--p) + --i; + x->usize = i; + if (!i) + x->minusp = False; +} + +Print_Bignum (port, x) Object port, x; { + register char *p; + char *buf; + register size; + struct S_Bignum *big; + Alloca_Begin; + + if (Bignum_Zero (x)) { + Printf (port, "0"); + return; + } + + size = BIGNUM(x)->usize * 5 + 3; + Alloca (buf, char*, size + 1); + p = buf + size; + *p = 0; + + size = (sizeof (struct S_Bignum) - sizeof (gran_t)) + + BIGNUM(x)->usize * sizeof (gran_t); + Alloca (big, struct S_Bignum*, size); + bcopy ((char *)POINTER(x), (char *)big, size); + big->size = BIGNUM(x)->usize; + + while (big->usize) { + register unsigned bigdig = Bignum_Div_In_Place (big, 10000); + *--p = '0' + bigdig % 10; + bigdig /= 10; + *--p = '0' + bigdig % 10; + bigdig /= 10; + *--p = '0' + bigdig % 10; + bigdig /= 10; + *--p = '0' + bigdig; + } + while (*p == '0') + ++p; + if (Truep (BIGNUM(x)->minusp)) + Printf (port, "-"); + Format (port, p, strlen (p), 0, (Object *)0); + Alloca_End; +} + +Object Bignum_To_String (x, radix) Object x; { + register char *p; + char *buf; + register unsigned div, ndig, size; + struct S_Bignum *big; + Object ret; + Alloca_Begin; + + if (Bignum_Zero (x)) + return Make_String ("0", 1); + + size = BIGNUM(x)->usize * (radix == 2 ? 17 : 6) + 3; + Alloca (buf, char*, size + 1); + p = buf + size; + *p = 0; + + size = (sizeof (struct S_Bignum) - sizeof (gran_t)) + + BIGNUM(x)->usize * sizeof (gran_t); + Alloca (big, struct S_Bignum*, size); + bcopy ((char *)POINTER(x), (char *)big, size); + big->size = BIGNUM(x)->usize; + + switch (radix) { + case 2: + div = 65536; ndig = 16; break; + case 8: + div = 32768; ndig = 5; break; + case 10: + div = 10000; ndig = 4; break; + case 16: + div = 65536; ndig = 4; break; + } + + while (big->usize) { + register unsigned bigdig = Bignum_Div_In_Place (big, div); + register i; + for (i = 0; i < ndig; i++) { + *--p = '0' + bigdig % radix; + if (*p > '9') + *p = 'A' + (*p - '9') - 1; + bigdig /= radix; + } + } + while (*p == '0') + ++p; + if (Truep (BIGNUM(x)->minusp)) + *--p = '-'; + ret = Make_String (p, strlen (p)); + Alloca_End; + return ret; +} + +Bignum_To_Integer (x) Object x; { + unsigned ret = 0; + int i, shift = 0, size = BIGNUM(x)->usize; + int digits = sizeof(int)/2; + + if (size > digits) +err: + Primitive_Error ("integer out of range: ~s", x); + for (i = 0; i < digits && i < size; i++, shift += 16) + ret |= (unsigned)BIGNUM(x)->data[i] << shift; + if (Truep (BIGNUM(x)->minusp)) { + if (ret > (~(unsigned)0 >> 1) + 1) + goto err; + return -ret; + } else { + if (ret > ~(unsigned)0 >> 1) + goto err; + return ret; + } +} + +unsigned Bignum_To_Unsigned (x) Object x; { + unsigned ret = 0; + int i, shift = 0, size = BIGNUM(x)->usize; + int digits = sizeof(int)/2; + + if (size > digits || Truep (BIGNUM(x)->minusp)) + Primitive_Error ("integer out of range: ~s", x); + for (i = 0; i < digits && i < size; i++, shift += 16) + ret |= (unsigned)BIGNUM(x)->data[i] << shift; + return ret; +} + +long Bignum_To_Long (x) Object x; { + unsigned long ret = 0; + int i, shift = 0, size = BIGNUM(x)->usize; + int digits = sizeof(long)/2; + + if (size > digits) +err: + Primitive_Error ("integer out of range: ~s", x); + for (i = 0; i < digits && i < size; i++, shift += 16) + ret |= (unsigned long)BIGNUM(x)->data[i] << shift; + if (Truep (BIGNUM(x)->minusp)) { + if (ret > (~(unsigned long)0 >> 1) + 1) + goto err; + return -ret; + } else { + if (ret > ~(unsigned long)0 >> 1) + goto err; + return ret; + } +} + +unsigned long Bignum_To_Unsigned_Long (x) Object x; { + unsigned long ret = 0; + int i, shift = 0, size = BIGNUM(x)->usize; + int digits = sizeof(long)/2; + + if (size > digits || Truep (BIGNUM(x)->minusp)) + Primitive_Error ("integer out of range: ~s", x); + for (i = 0; i < digits && i < size; i++, shift += 16) + ret |= (unsigned long)BIGNUM(x)->data[i] << shift; + return ret; +} + +Object Integer_To_Bignum (i) { + int k, digits = sizeof(int)/2; + Object big; + unsigned n = i; + + big = Make_Uninitialized_Bignum (digits); + if (i < 0) { + BIGNUM(big)->minusp = True; + n = -i; + } + for (k = 0; k < digits; k++, n >>= 16) + BIGNUM(big)->data[k] = n & 0xffff; + BIGNUM(big)->usize = k; + Bignum_Normalize_In_Place (BIGNUM(big)); + return big; +} + +Object Unsigned_To_Bignum (i) unsigned i; { + int k, digits = sizeof(int)/2; + Object big; + + big = Make_Uninitialized_Bignum (digits); + for (k = 0; k < digits; k++, i >>= 16) + BIGNUM(big)->data[k] = i & 0xffff; + BIGNUM(big)->usize = k; + Bignum_Normalize_In_Place (BIGNUM(big)); + return big; +} + +Object Long_To_Bignum (i) long i; { + int k, digits = sizeof(long)/2; + Object big; + unsigned long n = i; + + big = Make_Uninitialized_Bignum (digits); + if (i < 0) { + BIGNUM(big)->minusp = True; + n = -i; + } + for (k = 0; k < digits; k++, n >>= 16) + BIGNUM(big)->data[k] = n & 0xffff; + BIGNUM(big)->usize = k; + Bignum_Normalize_In_Place (BIGNUM(big)); + return big; +} + +Object Unsigned_Long_To_Bignum (i) unsigned long i; { + int k, digits = sizeof(long)/2; + Object big; + + big = Make_Uninitialized_Bignum (digits); + for (k = 0; k < digits; k++, i >>= 16) + BIGNUM(big)->data[k] = i & 0xffff; + BIGNUM(big)->usize = k; + Bignum_Normalize_In_Place (BIGNUM(big)); + return big; +} + +Object Double_To_Bignum (d) double d; { /* Truncates the double */ + Object big; + int expo, size; + double mantissa = frexp (d, &expo); + register gran_t *p; + + if (expo <= 0 || mantissa == 0.0) + return Make_Uninitialized_Bignum (0); + size = (expo + (16-1)) / 16; + big = Make_Uninitialized_Bignum (size); + BIGNUM(big)->usize = size; + if (mantissa < 0.0) { + BIGNUM(big)->minusp = True; + mantissa = -mantissa; + } + p = BIGNUM(big)->data; + bzero ((char *)p, size * sizeof (gran_t)); + p += size; + if (expo &= (16-1)) + mantissa = ldexp (mantissa, expo - 16); + while (mantissa != 0.0) { + if (--size < 0) + break; /* inexact */ + mantissa *= 65536.0; + *--p = (int)mantissa; + mantissa -= *p; + } + Bignum_Normalize_In_Place (BIGNUM(big)); /* Probably not needed */ + return Reduce_Bignum (big); +} + +double Bignum_To_Double (x) Object x; { /* error if it ain't fit */ + double rx = 0.0; + register i = BIGNUM(x)->usize; + register gran_t *p = BIGNUM(x)->data + i; + + for (i = BIGNUM(x)->usize; --i >= 0; ) { + if (rx >= HUGE / 65536.0) + Primitive_Error ("cannot coerce to real: ~s", x); + rx *= 65536.0; + rx += *--p; + } + if (Truep (BIGNUM(x)->minusp)) + rx = -rx; + return rx; +} + +Bignum_Zero (x) Object x; { + return BIGNUM(x)->usize == 0; +} + +Bignum_Negative (x) Object x; { + return Truep (BIGNUM(x)->minusp); +} + +Bignum_Positive (x) Object x; { + return !Truep (BIGNUM(x)->minusp) && BIGNUM(x)->usize != 0; +} + +Bignum_Even (x) Object x; { + return BIGNUM(x)->usize == 0 || (BIGNUM(x)->data[0] & 1) == 0; +} + +Object Bignum_Abs (x) Object x; { + Object big; + + big = Copy_Bignum (x); + BIGNUM(big)->minusp = False; + return big; +} + +Bignum_Mantissa_Cmp (x, y) register struct S_Bignum *x, *y; { + register i = x->usize; + if (i < y->usize) + return -1; + else if (i > y->usize) + return 1; + else { + register gran_t *xbuf = x->data + i; + register gran_t *ybuf = y->data + i; + for ( ; i; --i) { + register n; + if (n = (int)*--xbuf - (int)*--ybuf) + return n; + } + return 0; + } +} + +Bignum_Cmp (x, y) register struct S_Bignum *x, *y; { + register xm = Truep (x->minusp); + register ym = Truep (y->minusp); + if (xm) { + if (ym) + return -Bignum_Mantissa_Cmp (x, y); + else return -1; + } else { + if (ym) + return 1; + else return Bignum_Mantissa_Cmp (x, y); + } +} + +Bignum_Equal (x, y) Object x, y; { + return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) == 0; +} + +Bignum_Less (x, y) Object x, y; { + return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) < 0; +} + +Bignum_Greater (x, y) Object x, y; { + return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) > 0; +} + +Bignum_Eq_Less (x, y) Object x, y; { + return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) <= 0; +} + +Bignum_Eq_Greater (x, y) Object x, y; { + return Bignum_Cmp (BIGNUM(x), BIGNUM(y)) >= 0; +} + +Object General_Bignum_Plus_Minus (x, y, neg) Object x, y; { + Object big; + int size, xsize, ysize, xminusp, yminusp; + GC_Node2; + + GC_Link2 (x,y); + xsize = BIGNUM(x)->usize; + ysize = BIGNUM(y)->usize; + xminusp = Truep (BIGNUM(x)->minusp); + yminusp = Truep (BIGNUM(y)->minusp); + if (neg) + yminusp = !yminusp; + size = xsize > ysize ? xsize : ysize; + if (xminusp == yminusp) + size++; + big = Make_Uninitialized_Bignum (size); + BIGNUM(big)->usize = size; + GC_Unlink; + + if (xminusp == yminusp) { + /* Add x and y */ + register unsigned k = 0; + register i; + register gran_t *xbuf = BIGNUM(x)->data; + register gran_t *ybuf = BIGNUM(y)->data; + register gran_t *zbuf = BIGNUM(big)->data; + for (i = 0; i < size; ++i) { + if (i < xsize) + k += *xbuf++; + if (i < ysize) + k += *ybuf++; + *zbuf++ = k; + k >>= 16; + } + } else { + if (Bignum_Mantissa_Cmp (BIGNUM(x), BIGNUM(y)) < 0) { + Object temp; + + temp = x; x = y; y = temp; + xsize = ysize; + ysize = BIGNUM(y)->usize; + xminusp = yminusp; + } + /* Subtract y from x */ + { + register unsigned k = 1; + register i; + register gran_t *xbuf = BIGNUM(x)->data; + register gran_t *ybuf = BIGNUM(y)->data; + register gran_t *zbuf = BIGNUM(big)->data; + for (i = 0; i < size; ++i) { + if (i < xsize) + k += *xbuf++; + else Panic ("General_Bignum_Plus_Minus"); + if (i < ysize) + k += ~*ybuf++ & 0xFFFF; + else k += 0xFFFF; + *zbuf++ = k; + k >>= 16; + } + } + } + BIGNUM(big)->minusp = xminusp ? True : False; + Bignum_Normalize_In_Place (BIGNUM(big)); + return Reduce_Bignum (big); +} + +Object Bignum_Plus (x, y) Object x, y; { /* bignum + bignum */ + return General_Bignum_Plus_Minus (x, y, 0); +} + +Object Bignum_Minus (x, y) Object x, y; { /* bignum - bignum */ + return General_Bignum_Plus_Minus (x, y, 1); +} + +Object Bignum_Fixnum_Multiply (x, y) Object x, y; { /* bignum * fixnum */ + Object big; + register size, xsize, i; + register gran_t *xbuf, *zbuf; + int fix = FIXNUM(y); + register unsigned yl, yh; + GC_Node; + + GC_Link (x); + xsize = BIGNUM(x)->usize; + size = xsize + 2; + big = Make_Uninitialized_Bignum (size); + BIGNUM(big)->usize = size; + if (Truep (BIGNUM(x)->minusp) != (fix < 0)) + BIGNUM(big)->minusp = True; + bzero ((char *)BIGNUM(big)->data, size * sizeof (gran_t)); + xbuf = BIGNUM(x)->data; + if (fix < 0) + fix = -fix; + yl = fix & 0xFFFF; + yh = fix >> 16; + zbuf = BIGNUM(big)->data; + for (i = 0; i < xsize; ++i) { + register unsigned xf = xbuf[i]; + register unsigned k = 0; + register gran_t *r = zbuf + i; + k += xf * yl + *r; + *r++ = k; + k >>= 16; + k += xf * yh + *r; + *r++ = k; + k >>= 16; + *r = k; + } + GC_Unlink; + Bignum_Normalize_In_Place (BIGNUM(big)); + return Reduce_Bignum (big); +} + +Object Bignum_Multiply (x, y) Object x, y; { /* bignum * bignum */ + Object big; + register size, xsize, ysize, i, j; + register gran_t *xbuf, *ybuf, *zbuf; + GC_Node2; + + GC_Link2 (x, y); + xsize = BIGNUM(x)->usize; + ysize = BIGNUM(y)->usize; + size = xsize + ysize; + big = Make_Uninitialized_Bignum (size); + BIGNUM(big)->usize = size; + if (!EQ(BIGNUM(x)->minusp, BIGNUM(y)->minusp)) + BIGNUM(big)->minusp = True; + bzero ((char *)BIGNUM(big)->data, size * sizeof (gran_t)); + xbuf = BIGNUM(x)->data; + ybuf = BIGNUM(y)->data; + zbuf = BIGNUM(big)->data; + for (i = 0; i < xsize; ++i) { + register unsigned xf = xbuf[i]; + register unsigned k = 0; + register gran_t *p = ybuf; + register gran_t *r = zbuf + i; + for (j = 0; j < ysize; ++j) { + k += xf * *p++ + *r; + *r++ = k; + k >>= 16; + } + *r = k; + } + GC_Unlink; + Bignum_Normalize_In_Place (BIGNUM(big)); + return Reduce_Bignum (big); +} + +/* Returns cons cell (quotient . remainder); cdr is a fixnum + */ +Object Bignum_Fixnum_Divide (x, y) Object x, y; { /* bignum / fixnum */ + Object big; + register xsize, i; + register gran_t *xbuf, *zbuf; + int fix = FIXNUM(y); + int xminusp, yminusp = 0; + register unsigned rem; + GC_Node; + + GC_Link (x); + if (fix < 0) { + fix = -fix; + yminusp = 1; + } + if (fix > 0xFFFF) { + big = Integer_To_Bignum (FIXNUM(y)); + GC_Unlink; + return Bignum_Divide (x, big); + } + xsize = BIGNUM(x)->usize; + big = Make_Uninitialized_Bignum (xsize); + BIGNUM(big)->usize = xsize; + xminusp = Truep (BIGNUM(x)->minusp); + if (xminusp != yminusp) + BIGNUM(big)->minusp = True; + xbuf = BIGNUM(x)->data; + zbuf = BIGNUM(big)->data; + rem = 0; + for (i = xsize; --i >= 0; ) { + rem <<= 16; + rem += xbuf[i]; + zbuf[i] = rem / fix; + rem %= fix; + } + GC_Unlink; + Bignum_Normalize_In_Place (BIGNUM(big)); + if (xminusp) + rem = -(int)rem; + return Cons (Reduce_Bignum (big), Make_Integer ((int)rem)); +} + +/* Returns cons cell (quotient . remainder); cdr is a fixnum + */ +Object Bignum_Divide (x, y) Object x, y; { /* bignum / bignum */ + struct S_Bignum *dend, *dor; + int quotsize, dendsize, dorsize, scale; + unsigned dor1, dor2; + Object quot, rem; + register gran_t *qp, *dendp; + GC_Node2; + Alloca_Begin; + + if (BIGNUM(y)->usize < 2) + return Bignum_Fixnum_Divide (x, Make_Integer (Bignum_To_Integer (y))); + + GC_Link2 (x, y); + quotsize = BIGNUM(x)->usize - BIGNUM(y)->usize + 1; + if (quotsize < 0) + quotsize = 0; + quot = Make_Uninitialized_Bignum (quotsize); + GC_Unlink; + + dendsize = (sizeof (struct S_Bignum) - sizeof (gran_t)) + + (BIGNUM(x)->usize + 1) * sizeof (gran_t); + Alloca (dend, struct S_Bignum*, dendsize); + bcopy ((char *)POINTER(x), (char *)dend, dendsize); + dend->size = BIGNUM(x)->usize + 1; + + if (quotsize == 0 || Bignum_Mantissa_Cmp (dend, BIGNUM(y)) < 0) + goto zero; + + dorsize = (sizeof (struct S_Bignum) - sizeof (gran_t)) + + BIGNUM (y)->usize * sizeof (gran_t); + Alloca (dor, struct S_Bignum*, dorsize); + bcopy ((char *)POINTER(y), (char *)dor, dorsize); + dor->size = dorsize = BIGNUM(y)->usize; + + scale = 65536 / (unsigned int)(dor->data[dor->usize - 1] + 1); + Bignum_Mult_In_Place (dend, scale); + if (dend->usize < dend->size) + dend->data[dend->usize++] = 0; + Bignum_Mult_In_Place (dor, scale); + + BIGNUM(quot)->usize = BIGNUM(quot)->size; + qp = BIGNUM(quot)->data + BIGNUM(quot)->size; + dendp = dend->data + dend->usize; + dor1 = dor->data[dor->usize - 1]; + dor2 = dor->data[dor->usize - 2]; + + while (qp > BIGNUM(quot)->data) { + unsigned msw, guess; + int k; + register gran_t *dep, *dop, *edop; + + msw = dendp[-1] << 16 | dendp[-2]; + guess = msw / dor1; + if (guess >= 65536) /* [65535, 0, 0] / [65535, 65535] */ + guess = 65535; + for (;;) { + unsigned d1, d2, d3; + d3 = dor2 * guess; + d2 = dor1 * guess + (d3 >> 16); + d3 &= 0xFFFF; + d1 = d2 >> 16; + d2 &= 0xFFFF; + if (d1 < dendp[-1] || (d1 == dendp[-1] && + (d2 < dendp[-2] || (d2 == dendp[-2] && + d3 <= dendp[-3])))) + break; + --guess; + } + --dendp; + k = 0; + dep = dendp - dorsize; + for (dop = dor->data, edop = dop + dor->usize; dop < edop; ) { + register unsigned prod = *dop++ * guess; + k += *dep; + k -= prod & 0xFFFF; + *dep++ = k; + ASR(k, 16); + k -= prod >> 16; + } + k += *dep; + *dep = k; + if (k < 0) { + k = 0; + dep = dendp - dorsize; + for (dop = dor->data, edop = dop + dor->usize; dop < edop; ) { + k += *dep + *dop++; + *dep++ = k; + ASR(k, 16); + } + k += *dep; + *dep = k; + --guess; + } + *--qp = guess; + } + + if (Bignum_Div_In_Place (dend, scale)) + Panic ("Bignum_Div scale"); + zero: + dend->minusp = BIGNUM(x)->minusp; + if (Truep (dend->minusp) != Truep (BIGNUM(y)->minusp)) + BIGNUM(quot)->minusp = True; + Bignum_Normalize_In_Place (BIGNUM(quot)); + Bignum_Normalize_In_Place (dend); + GC_Link (quot); + rem = Reduce_Bignum (Copy_S_Bignum (dend)); + GC_Unlink; + Alloca_End; + return Cons (Reduce_Bignum (quot), rem); +} diff --git a/src/bool.c b/src/bool.c new file mode 100644 index 0000000..3d5ee6d --- /dev/null +++ b/src/bool.c @@ -0,0 +1,114 @@ +#include "kernel.h" + +Object P_Booleanp (x) Object x; { + return TYPE(x) == T_Boolean ? True : False; +} + +Object P_Not (x) Object x; { + return Truep (x) ? False : True; +} + +Object P_Eq (x1, x2) Object x1, x2; { + return EQ(x1, x2) ? True : False; +} + +Object P_Eqv (x1, x2) Object x1, x2; { + return Eqv (x1, x2) ? True : False; +} + +Object P_Equal (x1, x2) Object x1, x2; { + return Equal (x1, x2) ? True : False; +} + +Eqv (x1, x2) Object x1, x2; { + register t1, t2; + if (EQ(x1, x2)) + return 1; + t1 = TYPE(x1); + t2 = TYPE(x2); + if (Numeric (t1) && Numeric (t2)) + return Generic_Equal (x1, x2); + if (t1 != t2) + return 0; + switch (t1) { + case T_String: + return STRING(x1)->size == 0 && STRING(x2)->size == 0; + case T_Vector: + return VECTOR(x1)->size == 0 && VECTOR(x2)->size == 0; + case T_Primitive: + return strcmp (PRIM(x1)->name, PRIM(x2)->name) == 0; + default: + if (t1 < 0 || t1 >= Num_Types) + Panic ("bad type in eqv"); + if (Types[t1].eqv == NOFUNC) + return 0; + return (Types[t1].eqv)(x1, x2); + } + /*NOTREACHED*/ +} + +Equal (x1, x2) Object x1, x2; { + register t1, t2, i; + +again: + if (EQ(x1, x2)) + return 1; + t1 = TYPE(x1); + t2 = TYPE(x2); + if (Numeric (t1) && Numeric (t2)) + return Generic_Equal (x1, x2); + if (t1 != t2) + return 0; + switch (t1) { + case T_Boolean: + case T_Character: + case T_Compound: + case T_Control_Point: + case T_Promise: + case T_Port: + case T_Macro: + return 0; + case T_Primitive: + case T_Environment: + return Eqv (x1, x2); + case T_Symbol: { + struct S_Symbol *p1 = SYMBOL(x1), *p2 = SYMBOL(x2); + return Equal (p1->name, p2->name) && Equal (p1->plist, p2->plist); + } + case T_Pair: + if (!Equal (Car (x1), Car (x2))) + return 0; + x1 = Cdr (x1); x2 = Cdr (x2); + goto again; + case T_String: { + struct S_String *p1 = STRING(x1), *p2 = STRING(x2); + return p1->size == p2->size && + bcmp (p1->data, p2->data, p1->size) == 0; + } + case T_Vector: { + struct S_Vector *p1 = VECTOR(x1), *p2 = VECTOR(x2); + if (p1->size != p2->size) + return 0; + for (i = 0; i < p1->size; i++) + if (!Equal (p1->data[i], p2->data[i])) + return 0; + return 1; + } + default: + if (t1 < 0 || t1 >= Num_Types) + Panic ("bad type in equal"); + if (Types[t1].equal == NOFUNC) + return 0; + return (Types[t1].equal)(x1, x2); + } + /*NOTREACHED*/ +} + +Object P_Empty_List_Is_False (is_false) Object is_false; { + Check_Type (is_false, T_Boolean); + if (Truep (is_false)) + False2 = Null; + else + False2 = False; + return Void; +} diff --git a/src/build b/src/build new file mode 100755 index 0000000..33056f2 --- /dev/null +++ b/src/build @@ -0,0 +1,204 @@ +. ../config/system +. ../config/site + +case _$aout_format in +_coff) dump=dump-vanilla.c; stab=stab-coff.c;; +_ecoff) dump=dump-ecoff.c; stab=stab-ecoff.c;; +_xcoff) stab=stab-coff.c;; +_elf) dump=dump-elf.c; stab=stab-elf.c;; +_macho) stab=stab-macho.c;; +_hp9k) dump=dump-hp9k.c; stab='stab-hp9k300.c stab-hp9k800.c';; +_convex) stab='stab-convex.c';; +*) dump=dump-vanilla.c; stab=stab-bsd.c;; +esac + +if [ _$load_obj != _ ]; then + load=load-${load_obj}.c +fi + +echo Building Makefile.local... +cat <Makefile.local +# This Makefile was produced by running ./build in this directory. + +SHELL=/bin/sh + +CC= ${cc-cc} +CFLAGS= $cflags +LDFLAGS= $ldflags +LINTFLAGS= $lintflags + +INC= ../include + +H= \$(INC)/compat.h\\ + \$(INC)/config.h\\ + \$(INC)/cstring.h\\ + \$(INC)/exception.h\\ + \$(INC)/extern.h\\ + \$(INC)/funcproto.h\\ + \$(INC)/gc.h\\ + \$(INC)/intern.h\\ + \$(INC)/kernel.h\\ + \$(INC)/misc.h\\ + \$(INC)/object.h\\ + \$(INC)/param.h\\ + \$(INC)/stkmem.h\\ + \$(INC)/type.h + +C= autoload.c\\ + bignum.c\\ + bool.c\\ + char.c\\ + cont.c\\ + cstring.c\\ + debug.c\\ + dump.c\\ + env.c\\ + error.c\\ + exception.c\\ + feature.c\\ + heap.c\\ + io.c\\ + list.c\\ + load.c\\ + main.c\\ + malloc.c\\ + math.c\\ + onfork.c\\ + prim.c\\ + print.c\\ + proc.c\\ + promise.c\\ + read.c\\ + special.c\\ + stab.c\\ + stkmem.c\\ + string.c\\ + symbol.c\\ + terminate.c\\ + type.c\\ + vector.c + +OCOMMON=\\ + autoload.o\\ + bignum.o\\ + bool.o\\ + char.o\\ + cont.o\\ + cstring.o\\ + debug.o\\ + dump.o\\ + env.o\\ + error.o\\ + exception.o\\ + feature.o\\ + heap.o\\ + io.o\\ + list.o\\ + load.o\\ + malloc.o\\ + math.o\\ + onfork.o\\ + prim.o\\ + print.o\\ + proc.o\\ + promise.o\\ + read.o\\ + special.o\\ + stkmem.o\\ + string.o\\ + symbol.o\\ + terminate.o\\ + type.o\\ + vector.o + +O1= \$(OCOMMON) main.o stab.o +O2= \$(OCOMMON) main2.o stab2.o +O3= \$(OCOMMON) main3.o stab2.o + +all: scheme standalone.o module.o + +scheme: \$(O1) + \$(CC) -o \$@ \$(CFLAGS) \$(O1) \$(LDFLAGS) + +standalone.o: \$(O2) + ld -r -o \$@ \$(O2) + chmod 644 \$@ + +module.o: \$(O3) + ld -r -o \$@ \$(O3) + chmod 644 \$@ + +.c.o: + \$(CC) \$(CFLAGS) -I\$(INC) -c \$< + +autoload.o: \$(H) autoload.c +bignum.o: \$(H) bignum.c +bool.o: \$(H) bool.c +char.o: \$(H) char.c +cont.o: \$(H) cont.c +cstring.o: \$(H) cstring.c +debug.o: \$(H) debug.c +dump.o: \$(H) dump.c $dump +env.o: \$(H) env.c +error.o: \$(H) error.c +exception.o: \$(H) exception.c +feature.o: \$(H) feature.c +heap.o: \$(H) heap.c heap-sc.c heap-gen.c +io.o: \$(H) io.c +list.o: \$(H) list.c +load.o: \$(H) load.c $load +main.o: \$(H) main.c +malloc.o: \$(H) malloc.c +math.o: \$(H) math.c +onfork.o: \$(H) onfork.c +prim.o: \$(H) prim.c +print.o: \$(H) print.c +proc.o: \$(H) proc.c +promise.o: \$(H) promise.c +read.o: \$(H) read.c +special.o: \$(H) special.c +stab.o: \$(H) stab.c $stab +stkmem.o: \$(H) stkmem.c +string.o: \$(H) string.c +symbol.o: \$(H) symbol.c +terminate.o: \$(H) terminate.c +type.o: \$(H) type.c +vector.o: \$(H) vector.c + +main2.o: \$(H) main.c + rm -f main2.c; ln main.c main2.c + \$(CC) -DINIT_OBJECTS \$(CFLAGS) -I\$(INC) -c main2.c + rm main2.c + +stab2.o: \$(H) stab.c $stab + rm -f stab2.c; ln stab.c stab2.c + \$(CC) -DINIT_OBJECTS \$(CFLAGS) -I\$(INC) -c stab2.c + rm stab2.c + +main3.o: \$(H) main.c + rm -f main3.c; ln main.c main3.c + \$(CC) -DINIT_OBJECTS -DNOMAIN \$(CFLAGS) -I\$(INC) -c main3.c + rm main3.c + +install: scheme standalone.o module.o + -@if [ ! -d $install_dir/bin ]; then \\ + echo mkdir $install_dir/bin; \\ + mkdir $install_dir/bin; \\ + fi + cp scheme $install_dir/bin + -@if [ ! -d $install_dir/lib ]; then \\ + echo mkdir $install_dir/lib; \\ + mkdir $install_dir/lib; \\ + fi + cp standalone.o $install_dir/lib + cp module.o $install_dir/lib + +lint: + lint \$(LINTFLAGS) -I\$(INC) \$(C) + +clean: + rm -f *.o core main2.c stab2.c main3.c + +distclean: + rm -f *.o core main2.c stab2.c main3.c lint.out scheme Makefile.local +EOT diff --git a/src/char.c b/src/char.c new file mode 100644 index 0000000..9caaaac --- /dev/null +++ b/src/char.c @@ -0,0 +1,113 @@ +#include + +#include "kernel.h" + +Object Make_Char (c) register c; { + Object ch; + + SET(ch, T_Character, (unsigned char)c); + return ch; +} + +Object P_Charp (c) Object c; { + return TYPE(c) == T_Character ? True : False; +} + +Object P_Char_To_Integer (c) Object c; { + Check_Type (c, T_Character); + return Make_Integer (CHAR(c)); +} + +Object P_Integer_To_Char (n) Object n; { + register i; + + if ((i = Get_Exact_Integer (n)) < 0 || i > 255) + Range_Error (n); + return Make_Char (i); +} + +Object P_Char_Upper_Casep (c) Object c; { + Check_Type (c, T_Character); + return isupper (CHAR(c)) ? True : False; +} + +Object P_Char_Lower_Casep (c) Object c; { + Check_Type (c, T_Character); + return islower (CHAR(c)) ? True : False; +} + +Object P_Char_Alphabeticp (c) Object c; { + Check_Type (c, T_Character); + return isalpha (CHAR(c)) ? True : False; +} + +Object P_Char_Numericp (c) Object c; { + Check_Type (c, T_Character); + return isdigit (CHAR(c)) ? True : False; +} + +Object P_Char_Whitespacep (c) Object c; { + register x; + + Check_Type (c, T_Character); + x = CHAR(c); + return Whitespace (x) ? True : False; +} + +Object P_Char_Upcase (c) Object c; { + Check_Type (c, T_Character); + return islower (CHAR(c)) ? Make_Char (toupper (CHAR(c))) : c; +} + +Object P_Char_Downcase (c) Object c; { + Check_Type (c, T_Character); + return isupper (CHAR(c)) ? Make_Char (tolower (CHAR(c))) : c; +} + +General_Chrcmp (c1, c2, ci) Object c1, c2; register ci; { + Check_Type (c1, T_Character); + Check_Type (c2, T_Character); + if (ci) + return Char_Map[CHAR(c1)] - Char_Map[CHAR(c2)]; + return CHAR(c1) - CHAR(c2); +} + +Object P_Char_Eq (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 0) ? False : True; +} + +Object P_Char_Less (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 0) < 0 ? True : False; +} + +Object P_Char_Greater (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 0) > 0 ? True : False; +} + +Object P_Char_Eq_Less (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 0) <= 0 ? True : False; +} + +Object P_Char_Eq_Greater (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 0) >= 0 ? True : False; +} + +Object P_Char_CI_Eq (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 1) ? False : True; +} + +Object P_Char_CI_Less (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 1) < 0 ? True : False; +} + +Object P_Char_CI_Greater (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 1) > 0 ? True : False; +} + +Object P_Char_CI_Eq_Less (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 1) <= 0 ? True : False; +} + +Object P_Char_CI_Eq_Greater (c1, c2) Object c1, c2; { + return General_Chrcmp (c1, c2, 1) >= 0 ? True : False; +} diff --git a/src/cont.c b/src/cont.c new file mode 100644 index 0000000..b96bdf9 --- /dev/null +++ b/src/cont.c @@ -0,0 +1,328 @@ +/* Continuations and dynamic-wind. + */ + +#include "kernel.h" + +/* The C library versions of longjmp on the VAX and the Convex unwind + * the stack. As Jump_Cont below installs a new stack before calling + * longjmp, the standard version cannot be used. The following simplistic + * version of setjmp/longjmp is used instead: + */ + +#if defined(vax) || defined(__vax__) + __asm__(" .globl _setjmp"); + __asm__("_setjmp:"); + __asm__(" .word 0"); + __asm__(" movl 4(ap),r0"); + __asm__(" movq r2,(r0)+"); + __asm__(" movq r4,(r0)+"); + __asm__(" movq r6,(r0)+"); + __asm__(" movq r8,(r0)+"); + __asm__(" movq r10,(r0)+"); + __asm__(" movl fp,(r0)+"); + __asm__(" movq 4(fp),(r0)+"); + __asm__(" movq 12(fp),(r0)+"); + __asm__(" movq 20(fp),(r0)"); + __asm__(" clrl r0"); + __asm__(" ret"); + + __asm__(" .globl _longjmp"); + __asm__("_longjmp:"); + __asm__(" .word 0"); + __asm__(" movl 4(ap),r0"); + __asm__(" movq (r0)+,r2"); + __asm__(" movq (r0)+,r4"); + __asm__(" movq (r0)+,r6"); + __asm__(" movq (r0)+,r8"); + __asm__(" movq (r0)+,r10"); + __asm__(" movl (r0)+,r1"); + __asm__(" movq (r0)+,4(r1)"); + __asm__(" movq (r0)+,12(r1)"); + __asm__(" movq (r0),20(r1)"); + __asm__(" movl 8(ap),r0"); + __asm__(" movl r1,fp"); + __asm__(" ret"); +#endif + +#if defined(convex) || defined(__convex__) +convex_longjmp (p, i) char *p; { + __asm__("ld.w 4(ap),s0"); + __asm__("ld.w 0(ap),a1"); + __asm__("ld.w 12(a1),a7"); + __asm__("ld.w 16(a1),a0"); + __asm__("ld.w 8(a1),a3"); + __asm__("mov a3,psw"); + __asm__("ld.w 4(a1),a2"); + __asm__("jmp 0(a2)"); +} +#define longjmp convex_longjmp +#endif + + +WIND *First_Wind, *Last_Wind; + +static Object Cont_Value; +#ifndef USE_ALLOCA +static Object Cont_GCsave; +#endif + +Check_Stack_Grows_Down () { + char foo; + + return &foo < stkbase; +} + +/* Stack_Size returns the current stack size relative to stkbase. + * It works independent of the direction into which the stack grows + * (the stack grows upwards on HP-PA based machines and Pyramids). + */ +int Stack_Size () { + char foo; + + return Stack_Grows_Down ? stkbase-&foo : &foo-stkbase; +} + +Grow_Stack (cp, val) struct S_Control *cp; Object val; { + char buf[100]; + + /* Prevent the optimizer from optimizing buf away: + */ + bzero (buf, 1); + + Jump_Cont (cp, val); +} + +Jump_Cont (cp, val) struct S_Control *cp; Object val; { + static struct S_Control *p; + static char *from, *to; /* Must not be allocated on stack */ + static i; /* Ditto */ + char foo; + + /* Reinstall the saved stack contents; take stack direction + * into account. cp must be put into a static variable, as + * variables living on the stack cannot be referenced any + * longer after the new stack has been installed. + * + * (The asm below must not be the first statement in the function + * to prevent buggy Sun ANSI SPARCompiler C 2.0.1 from emitting + * it at the wrong position.) + */ + p = cp; + Cont_Value = val; + if (Stack_Grows_Down) { + if (stkbase - &foo < p->size) Grow_Stack (cp, val); + to = stkbase - p->size; + } else { + if (stkbase + p->size > &foo) Grow_Stack (cp, val); + to = stkbase; + } + from = p->stack; +#if defined(sparc) || defined(__sparc__) + __asm__("t 0x3"); /* Flush register window */ +#endif + for (i = p->size; i > 0; i--) + *to++ = *from++; + longjmp (p->j, 1); +} + +#ifndef USE_ALLOCA +Object Terminate_Cont (cont) Object cont; { + Free_Mem_Nodes (CONTROL(cont)->memlist); + return Void; +} +#endif + +Object P_Control_Pointp (x) Object x; { + return TYPE(x) == T_Control_Point ? True : False; +} + +Object P_Call_With_Current_Continuation (proc) Object proc; { + register t; + + t = TYPE(proc); + if (t != T_Primitive && t != T_Compound && t != T_Control_Point) + Wrong_Type_Combination (proc, "procedure"); + return Internal_Call_CC (0, proc); +} + +Object Internal_Call_CC (from_dump, proc) int from_dump; Object proc; { + Object control, ret, gcsave; + register struct S_Control *cp; + register char *p, *to; + register size; + GC_Node3; + + control = gcsave = Null; + GC_Link3 (proc, control, gcsave); +#ifndef USE_ALLOCA + gcsave = Save_GC_Nodes (); +#endif + + size = Stack_Size (); + size = (size + 7) & ~7; + control = Alloc_Object (size + sizeof (struct S_Control) - 1, + T_Control_Point, 0); + cp = CONTROL(control); + cp->env = The_Environment; + cp->gclist = GC_List; + cp->firstwind = First_Wind; + cp->lastwind = Last_Wind; + cp->tailcall = Tail_Call; + cp->intrlevel = Intr_Level; + cp->size = size; + cp->memsave = Null; + cp->gcsave = gcsave; +#if defined(sparc) || defined(__sparc__) + __asm__("t 0x3"); /* Flush register window */ +#endif + /* Save the current stack contents; take stack direction + * into account. delta holds the number of bytes by which + * the stack contents has been moved in memory (it is required + * to access variables on the saved stack later): + */ + p = Stack_Grows_Down ? stkbase - cp->size : stkbase; + to = cp->stack; + bcopy (p, to, cp->size); + cp->delta = to - p; +#ifndef USE_ALLOCA + Register_Object (control, (GENERIC)0, Terminate_Cont, 0); + Save_Mem_Nodes (control); +#endif + if (setjmp (CONTROL(control)->j) != 0) { +#ifndef USE_ALLOCA + Restore_GC_Nodes (Cont_GCsave); +#endif + if (Intr_Level == 0) { + Force_Enable_Interrupts; + } else { + Force_Disable_Interrupts; + } + return Cont_Value; + } + if (from_dump) { +#ifdef CAN_DUMP + Dump_Control_Point = control; +#endif + ret = False; + } else { + control = Cons (control, Null); + ret = Funcall (proc, control, 0); + } + GC_Unlink; + return ret; +} + +Funcall_Control_Point (control, argl, eval) Object control, argl; { + Object val, len; + register struct S_Control *cp; + register WIND *w, *wp, *cwp, *p; + register delta = 0; + GC_Node3; + + if (GC_In_Progress) + Fatal_Error ("jumping out of GC"); + val = Null; + GC_Link3 (argl, control, val); + len = P_Length (argl); + if (FIXNUM(len) != 1) + Primitive_Error ("control point expects one argument"); + val = Car (argl); + if (eval) + val = Eval (val); + delta = CONTROL(control)->delta; + wp = First_Wind; + cwp = CONTROL(control)->firstwind; + while (wp && cwp) { + p = (WIND *)NORM(wp); + if (!EQ(wp->inout,p->inout)) break; + wp = wp->next; + cwp = p->next; + } + if (wp) { + for (w = Last_Wind; w != wp->prev; w = w->prev) + Do_Wind (Cdr (w->inout)); + } + while (cwp) { + delta = CONTROL(control)->delta; + p = (WIND *)NORM(cwp); + cwp = p->next; + Do_Wind (Car (p->inout)); + } + GC_Unlink; + Disable_Interrupts; + cp = CONTROL(control); + Switch_Environment (cp->env); + GC_List = cp->gclist; +#ifndef USE_ALLOCA + Restore_Mem_Nodes (control); + Cont_GCsave = CONTROL(control)->gcsave; +#endif + First_Wind = cp->firstwind; + Last_Wind = cp->lastwind; + Intr_Level = cp->intrlevel; + Jump_Cont (cp, val); + /*NOTREACHED*/ +} + +Do_Wind (w) Object w; { + Object oldenv, b, tmp; + + if (TYPE(w) == T_Vector) { /* fluid-let */ + oldenv = The_Environment; + Switch_Environment (VECTOR(w)->data[1]); + b = Lookup_Symbol (VECTOR(w)->data[0], 0); + if (Nullp (b)) + Panic ("fluid-let"); + tmp = VECTOR(w)->data[2]; + VECTOR(w)->data[2] = Cdr (b); + Cdr (b) = tmp; + SYMBOL(Car (b))->value = tmp; + VECTOR(w)->data[1] = oldenv; + Switch_Environment (oldenv); + } else { /* dynamic-wind */ + (void)Funcall (w, Null, 0); + } +} + +Add_Wind (w, in, out) register WIND *w; Object in, out; { + Object inout; + GC_Node2; + + GC_Link2 (in, out); + inout = Cons (in, out); + w->inout = inout; + w->next = 0; + if (First_Wind == 0) + First_Wind = w; + else + Last_Wind->next = w; + w->prev = Last_Wind; + Last_Wind = w; + GC_Unlink; +} + +Object P_Dynamic_Wind (in, body, out) Object in, body, out; { + WIND w, *first = First_Wind; + Object ret; + GC_Node4; + + Check_Procedure (in); + Check_Procedure (body); + Check_Procedure (out); + ret = Null; + GC_Link4 (in, body, out, ret); + Add_Wind (&w, in, out); + (void)Funcall (in, Null, 0); + ret = Funcall (body, Null, 0); + (void)Funcall (out, Null, 0); + if (Last_Wind = w.prev) + Last_Wind->next = 0; + First_Wind = first; + GC_Unlink; + return ret; +} + +Object P_Control_Point_Environment (c) Object c; { + Check_Type (c, T_Control_Point); + return CONTROL(c)->env; +} diff --git a/src/cstring.c b/src/cstring.c new file mode 100644 index 0000000..937d9e5 --- /dev/null +++ b/src/cstring.c @@ -0,0 +1,48 @@ +/* Convert Scheme strings to C strings. The contents of strings has to + * be copied, because strings in Elk do not have a terminating null-byte + * (strings may _contain_ null-bytes). + * + * Get_String() and Get_Strsym() allocate memory in NUMSTRBUFS cyclically + * reused buffers in the C heap. + * The macros Get_String_Stack() and Get_Strsym_Stack() in include/cstring.h + * allocate memory on the stack. They have to be used whenever more than + * NUMSTRBUFS strings are active in a function at the same time. + */ + +#include "kernel.h" + +static char *heapstr[NUMSTRBUFS]; +static int heaplen[NUMSTRBUFS]; +static int nextstr; + +Init_Cstring() { /* Preallocate memory to avoid fragmentation */ + int i; + + for (i = 0; i < NUMSTRBUFS; i++) + heapstr[i] = Safe_Malloc (heaplen[i] = 512); +} + +char *Get_String (str) Object str; { + char **pp = &heapstr[nextstr]; + int len; + + Check_Type (str, T_String); + if ((len = STRING(str)->size+1) > heaplen[nextstr]) { + Disable_Interrupts; + *pp = Safe_Realloc (*pp, len); + heaplen[nextstr] = len; + Enable_Interrupts; + } + bcopy (STRING(str)->data, *pp, --len); + (*pp)[len] = '\0'; + if (++nextstr == NUMSTRBUFS) nextstr = 0; + return *pp; +} + +char *Get_Strsym (str) Object str; { + if (TYPE(str) == T_Symbol) + str = SYMBOL(str)->name; + else if (TYPE(str) != T_String) + Wrong_Type_Combination (str, "string or symbol"); + return Get_String (str); +} diff --git a/src/debug.c b/src/debug.c new file mode 100644 index 0000000..7cbfa12 --- /dev/null +++ b/src/debug.c @@ -0,0 +1,42 @@ +/* The primitive `backtrace-list'. + */ + +#include "kernel.h" + +Object P_Backtrace_List (argc, argv) Object *argv; { + register GCNODE *p, *gp = GC_List; + register delta = 0; + Object cp, list, tail, cell, vec; + GC_Node3; + + if (argc > 0) { + cp = argv[0]; + Check_Type (cp, T_Control_Point); + delta = CONTROL(cp)->delta; + gp = CONTROL(cp)->gclist; + } + vec = list = tail = Null; + GC_Link3 (vec, list, tail); + for ( ; gp; gp = p->next) { + p = (GCNODE *)NORM(gp); + switch (p->gclen) { + case TAG_ENV: + vec = Make_Vector (3, Null); + VECTOR(vec)->data[2] = *(Object *)NORM(p->gcobj); + break; + case TAG_FUN: case TAG_TCFUN: + VECTOR(vec)->data[0] = *(Object *)NORM(p->gcobj); + break; + case TAG_ARGS: + VECTOR(vec)->data[1] = *(Object *)NORM(p->gcobj); + cell = Cons (vec, Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + tail = cell; + } + } + GC_Unlink; + return list; +} diff --git a/src/dump-ecoff.c b/src/dump-ecoff.c new file mode 100644 index 0000000..94dfaf8 --- /dev/null +++ b/src/dump-ecoff.c @@ -0,0 +1,189 @@ +#include +#include +#include +#include +#include +#include + +extern char *sbrk(); + +/* Find section header of section with given name. + */ +#define FIND_SECTHDR(name,ptr) {\ + char err[100];\ + int _i;\ + for (_i = 0; _i < fhdr.f_nscns; _i++)\ + if (strncmp (sect[_i].s_name, (name), sizeof(sect[_i].s_name)) == 0)\ + break;\ + if (_i == fhdr.f_nscns) {\ + Dump_Finalize;\ + sprintf (err, "running a.out doesn't have %s section", (name));\ + Primitive_Error (err);\ + }\ + (ptr) = sect+_i;\ +} + +#define MAX_SECTS 20 + +Object P_Dump (ofile) Object ofile; { + struct filehdr fhdr; + struct aouthdr ahdr; + struct scnhdr sect[MAX_SECTS]; + struct scnhdr *sp, *datap; + unsigned long data_start, data_end, delta; + int mask, n; + HDRR shdr; + char buf[4096]; + + Dump_Prolog; + + /* Read file header, optional header, and section headers from + * running a.out; locate .data section. + * Reading the headers is not really necessary, as they get + * mapped into the address space on startup. + * However, we do not know where exactly they get mapped and + * whether they haven't been modified. + */ + if (read (afd, (char *)&fhdr, sizeof (fhdr)) != sizeof (fhdr) || + read (afd, (char *)&ahdr, sizeof (ahdr)) != sizeof (ahdr)) { + Dump_Finalize; + Primitive_Error ("error reading a.out headers: ~E"); + } + if (fhdr.f_nscns > MAX_SECTS) { + Dump_Finalize; + Primitive_Error ("too many sections in a.out"); + } + if (read (afd, (char *)sect, fhdr.f_nscns * sizeof (sect[0])) != + fhdr.f_nscns * sizeof (sect[0])) { + Dump_Finalize; + Primitive_Error ("error reading section headers: ~E"); + } + FIND_SECTHDR (_DATA, datap); + + /* Adjust optional header and size of data segment + */ + data_start = datap->s_vaddr; + mask = getpagesize () - 1; + data_end = (unsigned long)sbrk (0) + mask & ~mask; + delta = data_end - data_start - datap->s_size; + + ahdr.dsize = data_end - ahdr.data_start; + ahdr.bsize = 0; + ahdr.bss_start = ahdr.data_start + ahdr.dsize; + datap->s_size += delta; + + /* Deactivate sections that aren't really needed (such as bss). + * Actually, the section type should be set to STYP_DSECT (dummy section), + * but this causes the linker to complain next time an object file is + * loaded. + * Adjust offsets in section headers of all other sections (such as + * .comment). (XXX: Should s_lnnoptr be adjusted as well?) + */ + for (sp = datap+1; sp < sect+fhdr.f_nscns; sp++) { + switch (sp->s_flags & ~0xf) { + case STYP_BSS: + case STYP_SBSS: + case STYP_LIT4: + case STYP_LIT8: + case STYP_SDATA: +#ifdef DEBUG_DUMP + /* .comment is not null-terminated */ + printf ("nuking %.8s\n", sp->s_name); +#endif + sp->s_paddr = sp->s_vaddr = sp->s_scnptr = sp->s_lnnoptr = 0; + sp->s_size = 0; + break; + default: +#ifdef DEBUG_DUMP + printf ("adjusting %.8s\n", sp->s_name); +#endif + sp->s_paddr += delta; + sp->s_vaddr += delta; + if (sp->s_scnptr) sp->s_scnptr += delta; + } + } + delta = ahdr.tsize + ahdr.dsize - fhdr.f_symptr; + fhdr.f_symptr += delta; + + /* Write headers + */ + n = fhdr.f_nscns * sizeof (sect[0]); + if (write (ofd, (char *)&fhdr, sizeof (fhdr)) != sizeof (fhdr) || + write (ofd, (char *)&ahdr, sizeof (ahdr)) != sizeof (ahdr) || + write (ofd, (char *)sect, n) != n) { + Dump_Finalize; + Primitive_Error ("error writing a.out/section headers: ~E"); + } + + /* Write sections + */ + Was_Dumped = 1; + n += sizeof (fhdr) + sizeof (ahdr); +#ifdef DEBUG_DUMP + printf ("writing text 0x%x bytes and data 0x%x bytes\n", + ahdr.tsize-n, ahdr.dsize); +#endif + if (write (ofd, (char *)ahdr.text_start+n, ahdr.tsize-n) != ahdr.tsize-n) { + Dump_Finalize; + Primitive_Error ("error writing text section: ~E"); + } + if (write (ofd, (char *)ahdr.data_start, ahdr.dsize) != ahdr.dsize) { + Dump_Finalize; + Primitive_Error ("error writing data sections: ~E"); + } + + /* Copy the symbol table. If an object file has been loaded into + * this invocation, copy the symbols from the ld temp file, + * otherwise from the running a.out. + * Adjust various offsets in the symbolic header. + * (XXX: Are there any offsets to be adjusted in the table proper?) + */ + if (Loader_Input) { + close (afd); + if ((afd = open (Loader_Input, O_RDONLY)) == -1) { + Dump_Finalize; + Primitive_Error ("cannot open symbol table file: ~E"); + } + delta = fhdr.f_symptr; + if (read (afd, (char *)&fhdr, sizeof (fhdr)) != sizeof (fhdr)) { + Dump_Finalize; + Primitive_Error ("error reading a.out header: ~E"); + } + delta -= fhdr.f_symptr; + (void)lseek (afd, (off_t)fhdr.f_symptr, SEEK_SET); + } else + (void)lseek (afd, (off_t)fhdr.f_symptr-delta, SEEK_SET); + +#ifdef DEBUG_DUMP + printf ("copying symbols from %s\n", Loader_Input ? Loader_Input : + A_Out_Name); +#endif + if (read (afd, (char *)&shdr, sizeof (shdr)) != sizeof (shdr)) { +symrerr: + Dump_Finalize; + Primitive_Error ("error reading symbol table: ~E"); + } +#define ADJUST(what) if (shdr.what > 0) shdr.what += delta + ADJUST (cbLineOffset); + ADJUST (cbDnOffset); + ADJUST (cbPdOffset); + ADJUST (cbSymOffset); + ADJUST (cbOptOffset); + ADJUST (cbAuxOffset); + ADJUST (cbSsOffset); + ADJUST (cbSsExtOffset); + ADJUST (cbFdOffset); + ADJUST (cbRfdOffset); + ADJUST (cbExtOffset); + + if (write (ofd, (char *)&shdr, sizeof (shdr)) != sizeof (shdr)) { +symwerr: + Dump_Finalize; + Primitive_Error ("error writing symbol table: ~E"); + } + while ((n = read (afd, buf, 4096)) > 0) + if (write (ofd, buf, n) != n) goto symwerr; + if (n < 0) goto symrerr; + + Dump_Epilog; +} diff --git a/src/dump-elf.c b/src/dump-elf.c new file mode 100644 index 0000000..4970584 --- /dev/null +++ b/src/dump-elf.c @@ -0,0 +1,319 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include + +/* Find section header of section with given name. + */ +#define FIND_SECTHDR(name,ndx) {\ + char err[100];\ + unsigned _i;\ + for (_i = 0; _i < ohdr->e_shnum; _i++)\ + if (strcmp (sectstr+osecthdr[_i].sh_name, (name)) == 0) break;\ + if (_i == ohdr->e_shnum) {\ + Dump_Finalize;\ + sprintf (err, "running a.out doesn't have %s section", (name));\ + Primitive_Error (err);\ + }\ + (ndx) = _i;\ +} + +/* Find section header of section with given name (if present, else + * set to -1). + */ +#define FIND_SECTHDR_MAYBE(name,ndx) {\ + int _i;\ + for ((ndx) = -1, _i = 0; _i < ohdr->e_shnum; _i++)\ + if (strcmp (sectstr+osecthdr[_i].sh_name, (name)) == 0) {\ + (ndx) = _i;\ + break;\ + }\ +} + +/* If a new section was inserted, adjust section index if it points behind + * old .bss section + */ +#define UPDATE_SHNDX(ndx) if (sect_created && (ndx) >= obssndx) (ndx)++; + + +/* Bug: the mmapped regions are never munmapped again. + */ + +Object P_Dump (ofile) Object ofile; { + /* + * ELF header, section header table, program header table of running + * a.out and new a.out + */ + Elf32_Ehdr *ohdr, *nhdr; + Elf32_Shdr *osecthdr, *nsecthdr; + Elf32_Phdr *oproghdr, *nproghdr; + /* + * .bss section index and section header pointer of running a.out + */ + unsigned obssndx; + Elf32_Shdr *obssp; + /* + * .mdebug section index + */ + int mdebugndx; + /* + * Pointers to section headers of new .bss and new .data + */ + Elf32_Shdr *nbssp, *ndatap; + /* + * Memory address, size, and file offset of newly created .data section + */ + Elf32_Addr ndata; + Elf32_Word ndatasize; + Elf32_Off ndataoff; + /* + * Start of .shstrtab section of running a.out + */ + char *sectstr; + /* + * Memory address of running a.out and new a.out (mmap() return value) + */ + char *oaddr, *naddr; + + struct stat st; + unsigned i; + int sect_created = !Was_Dumped; + + Dump_Prolog; + + /* mmap running a.out, setup pointers to ELF header, section header + * table, program header table, section names, and old .bss + * XXX: call munmap later. + */ + if (fstat (afd, &st) == -1) { + Dump_Finalize; + Primitive_Error ("cannot fstat running a.out: ~E"); + } + oaddr = (char *)mmap ((caddr_t)0, st.st_size, PROT_READ, MAP_SHARED, + afd, 0); + if (oaddr == (char *)-1) { + Dump_Finalize; + Primitive_Error ("cannot mmap running a.out: ~E"); + } + ohdr = (Elf32_Ehdr *)(oaddr); + osecthdr = (Elf32_Shdr *)(oaddr + ohdr->e_shoff); + oproghdr = (Elf32_Phdr *)(oaddr + ohdr->e_phoff); + if (ohdr->e_shstrndx == SHN_UNDEF) { + Dump_Finalize; + Primitive_Error ("running a.out doesn't have section names"); + } + sectstr = oaddr + osecthdr[ohdr->e_shstrndx].sh_offset; + FIND_SECTHDR (".bss", obssndx); + obssp = osecthdr+obssndx; + + FIND_SECTHDR_MAYBE (".mdebug", mdebugndx); + + /* Determine size of newly created .data section; address and file + * offset are that of the old .bss section + */ + if ((Brk_On_Dump = sbrk (0)) == (char *)-1) { + Dump_Finalize; + Primitive_Error ("sbrk(0) failed: ~E"); + } + ndata = obssp->sh_addr; + ndatasize = (Elf32_Addr)Brk_On_Dump - ndata; + ndataoff = obssp->sh_offset; + + /* mmap new a.out file, setup pointers to ELF header, section header + * table, and program header table + * XXX: munmap missing + */ + st.st_size += ndatasize; + if (!Was_Dumped) + st.st_size += sizeof (osecthdr[0]); + if (ftruncate (ofd, st.st_size) == -1) { + Dump_Finalize; + Primitive_Error ("cannot ftruncate new a.out: ~E"); + } + naddr = (char *)mmap ((caddr_t)0, st.st_size, PROT_READ|PROT_WRITE, + MAP_SHARED, ofd, 0); + if (naddr == (char *)-1) { + Dump_Finalize; + Primitive_Error ("cannot mmap new a.out: ~E"); + } + nhdr = (Elf32_Ehdr *)(naddr); + nsecthdr = (Elf32_Shdr *)(naddr + ohdr->e_shoff + ndatasize); + nproghdr = (Elf32_Phdr *)(naddr + ohdr->e_phoff); + + /* Copy and adjust ELF header, copy program header table + */ + *nhdr = *ohdr; + if (!Was_Dumped) + nhdr->e_shnum++; + UPDATE_SHNDX (nhdr->e_shstrndx); + nhdr->e_shoff += ndatasize; + memcpy ((void *)nproghdr, (void *)oproghdr, + ohdr->e_phnum * sizeof (oproghdr[0])); + + /* Scan program header table and search for a loadable segment that + * ends immediately below the .bss section. Extend this segment so + * that it encompasses the newly created .data section. + * There must not exist any segment above the new .data. + */ +#define max(a,b) ((a) > (b) ? (a) : (b)) + for (i = 0; i < nhdr->e_phnum; i++) { + Elf32_Phdr *pp = nproghdr+i; + unsigned mask = max(pp->p_align, obssp->sh_addralign) - 1; + Elf32_Addr ends_at = pp->p_vaddr + pp->p_filesz + mask & ~mask; + Elf32_Addr bssend = obssp->sh_addr + mask & ~mask; +#ifndef __sgi + if (pp->p_vaddr + pp->p_filesz > obssp->sh_addr) { + Dump_Finalize; + Primitive_Error ("running a.out has segment above .bss"); + } +#endif + if (pp->p_type == PT_LOAD && ends_at == bssend) + break; + } + + nproghdr[i].p_filesz += ndatasize; + nproghdr[i].p_memsz = nproghdr[i].p_filesz; /* load entire segment */ + +#ifdef __sgi + for (i = 0; i < nhdr->e_phnum; i++) { + Elf32_Phdr *pp = nproghdr+i; + + if (pp->p_vaddr >= ndata) + pp->p_vaddr += ndatasize - obssp->sh_size; + if (pp->p_offset >= ndataoff) + pp->p_offset += ndatasize; + } +#endif + + if (Was_Dumped) { + /* No need to insert a new data section header. Just copy + * section header table. Data segment to be adjusted must + * be immediately before .bss + */ + memcpy ((void*)nsecthdr, (void *)osecthdr, + nhdr->e_shnum * sizeof (osecthdr[0])); + nbssp = nsecthdr + obssndx; + ndatap = nbssp - 1; + if (strcmp (sectstr+ndatap->sh_name, ".data")) { + Dump_Finalize; + Primitive_Error ("missing .data section in dumped a.out"); + } + ndatap->sh_size += ndatasize; + } else { + /* Copy section headers up to old .bss, then copy remaining section + * headers shifted by one position to make room for new .data + */ + memcpy ((void *)nsecthdr, (void *)osecthdr, + obssndx * sizeof (osecthdr[0])); + ndatap = nsecthdr + obssndx; + nbssp = ndatap + 1; + memcpy ((void *)nbssp, (void *)obssp, + (nhdr->e_shnum-obssndx) * sizeof (osecthdr[0])); + + /* Initialize section header for new .data section with values + * from old .data section; set new address, size, and file offset + */ + FIND_SECTHDR (".data", i); + ndatap[0] = osecthdr[i]; + ndatap->sh_addr = ndata; + ndatap->sh_size = ndatasize; + ndatap->sh_offset = ndataoff; + } + nbssp->sh_size = 0; + nbssp->sh_addr += ndatasize; + + /* Now copy the contents of the sections. If section is in memory + * and writable, copy from memory, else copy from a.out file. + * Skip sections that are inactive or occupy no space in file. + * Adjust file offset of sections behind new .data section. + */ + Was_Dumped = 1; + for (i = 1; i < nhdr->e_shnum; i++) { + void *from; + Elf32_Shdr *sp = nsecthdr+i; +#ifdef DEBUG_DUMP + printf ("%s (from %s)", sectstr+sp->sh_name, (sp->sh_flags & + (SHF_ALLOC|SHF_WRITE)) == (SHF_ALLOC|SHF_WRITE) ? + "memory" : "file"); (void)fflush (stdout); +#endif + if ((sp->sh_flags & (SHF_ALLOC|SHF_WRITE)) == (SHF_ALLOC|SHF_WRITE)) + from = (void *)sp->sh_addr; + else + from = (void *)(oaddr + sp->sh_offset); + if (sp != ndatap && sp->sh_offset >= ndataoff) + sp->sh_offset += ndatasize; + if (sp->sh_type != SHT_NULL && sp->sh_type != SHT_NOBITS) { +#ifdef DEBUG_DUMP + printf (" copy from %x to %x size %x", from, naddr+sp->sh_offset, + sp->sh_size); (void)fflush (stdout); +#endif + memcpy ((void *)(naddr + sp->sh_offset), from, sp->sh_size); + } +#ifdef DEBUG_DUMP + printf ("\n"); +#endif + } + + /* Go through all section headers and fixup sh_link and sh_info fields + * that point behind new .data section, also fixup st_shndx fields in + * symbol table entries + */ + for (i = 1; i < nhdr->e_shnum; i++) { + Elf32_Shdr *sp = nsecthdr+i; + + UPDATE_SHNDX (sp->sh_link); + if (sp->sh_type != SHT_DYNSYM && sp->sh_type != SHT_SYMTAB) + UPDATE_SHNDX (sp->sh_info); + + if (sp->sh_type == SHT_SYMTAB || sp->sh_type == SHT_DYNSYM) { + Elf32_Sym *p = (Elf32_Sym *)(naddr + sp->sh_offset), + *ep = p + sp->sh_size / sp->sh_entsize; + for ( ; p < ep; p++) switch (p->st_shndx) { + case SHN_UNDEF: case SHN_ABS: case SHN_COMMON: + break; + default: + UPDATE_SHNDX (p->st_shndx); + } + } + } + +#ifdef __sgi + /* If the .mdebug section is located after the newly inserted section, + * update the offsets. + */ + if (mdebugndx >= obssndx) { + HDRR *mp; + mdebugndx++; + mp = (HDRR *)(naddr + nsecthdr[mdebugndx].sh_offset); + if (mp->cbLine > 0) + mp->cbLineOffset += ndatasize; + if (mp->idnMax > 0) + mp->cbDnOffset += ndatasize; + if (mp->ipdMax > 0) + mp->cbPdOffset += ndatasize; + if (mp->isymMax > 0) + mp->cbSymOffset += ndatasize; + if (mp->ioptMax > 0) + mp->cbOptOffset += ndatasize; + if (mp->iauxMax > 0) + mp->cbAuxOffset += ndatasize; + if (mp->issMax > 0) + mp->cbSsOffset += ndatasize; + if (mp->issExtMax > 0) + mp->cbSsExtOffset += ndatasize; + if (mp->ifdMax > 0) + mp->cbFdOffset += ndatasize; + if (mp->crfd > 0) + mp->cbRfdOffset += ndatasize; + if (mp->iextMax > 0) + mp->cbExtOffset += ndatasize; + } +#endif + + Dump_Epilog; +} diff --git a/src/dump-hp9k.c b/src/dump-hp9k.c new file mode 100644 index 0000000..5216d4b --- /dev/null +++ b/src/dump-hp9k.c @@ -0,0 +1,242 @@ +/* Dump for the HP-PA. It needs some work; for instance, it currently + * assumes that the data space is the last space in the a.out file. + * If it weren't the last space, the code would have to adjust pointers + * (such as header.space_location) that point into spaces beyond the + * data space, as the data space in the new a.out is larger than that + * in the original a.out. + * + * Also, it is unclear how the checksum field in the a.out header has + * to be computed. + * + * An a.out file must not have holes in HP-UX (or exec(2) would complain + * about an invalid data segment), therefore we cannot lseek over the + * ununsed parts of the heap. + * + * The code to support dump with a dynamically linked a.out is a hack. + * I have no idea why it works and if it will continue to work in + * newer OS releases. + */ + +#include AOUT_H + +#define copy(from,to,size) {\ + char buf[4096];\ + int len = (size), n;\ + \ + while (len > 0) {\ + if ((n = read (from, buf, 4096)) == -1) {\ + Dump_Finalize;\ + Primitive_Error ("error reading old a.out: ~E");\ + }\ + if (write (to, buf, n) == -1) {\ + Dump_Finalize;\ + Primitive_Error ("error writing new a.out: ~E");\ + }\ + len -= n;\ + }\ +} + +Object P_Dump (ofile) Object ofile; { + struct header hdr; + struct som_exec_auxhdr auxhdr; + unsigned data_size; + int delta; + struct stat stat; + extern void *sbrk(); + + Dump_Prolog; + + /* Read a.out header and first aux header + */ + if (read (afd, (char *)&hdr, sizeof (hdr)) != sizeof (hdr) || + lseek (afd, (off_t)hdr.aux_header_location, SEEK_SET) == -1 || + read (afd, (char *)&auxhdr, sizeof (auxhdr)) != sizeof (auxhdr)) { + Dump_Finalize; + Primitive_Error ("can't read a.out headers"); + } + if (hdr.a_magic != EXEC_MAGIC && hdr.a_magic != SHARE_MAGIC && + hdr.a_magic != DEMAND_MAGIC) { + Dump_Finalize; + Primitive_Error ("bad magic number ~s in a.out", + Make_Integer (hdr.a_magic)); + } + if (auxhdr.som_auxhdr.type != HPUX_AUX_ID) { + Dump_Finalize; + Primitive_Error ("bad aux header id ~s in a.out", + Make_Integer (auxhdr.som_auxhdr.type)); + } + + /* Copy old file up to beginning of data space + */ + (void)lseek (afd, (off_t)0, SEEK_SET); + copy (afd, ofd, auxhdr.exec_dfile); + +#ifdef HPSHLIB + /* Save data segments of shared libraries + */ + Save_Shared_Data (); +#endif + + /* Write data space (doesn't skip holes in heap yet) + */ + Was_Dumped = 1; + Brk_On_Dump = sbrk (0); + data_size = Brk_On_Dump - (char *)auxhdr.exec_dmem; + if (write (ofd, (char *)auxhdr.exec_dmem, data_size) != data_size) { + Dump_Finalize; + Primitive_Error ("error writing data space: ~E"); + } + + /* Check if data space was last space in a.out file. + * Should not just quit, but adjust all pointers that point + * beyond end of data space + */ + (void)fstat (afd, &stat); + if (lseek (afd, (off_t)auxhdr.exec_dsize, SEEK_CUR) != stat.st_size) + Primitive_Error ("$DATA$ not last space in a.out file"); + + /* Write new headers. + * Do we have to recalculate the checksum? The manual doesn't + * say how the checksum is calculated. + */ + delta = data_size - auxhdr.exec_dsize; + hdr.som_length += delta; + auxhdr.exec_dsize = data_size; + auxhdr.exec_bsize = 0; + (void)lseek (ofd, (off_t)0, SEEK_SET); + if (write (ofd, (char *)&hdr, sizeof (hdr)) == -1 || + lseek (ofd, (off_t)hdr.aux_header_location, SEEK_SET) == -1 || + write (ofd, (char *)&auxhdr, sizeof (auxhdr)) == -1) { + Dump_Finalize; + Primitive_Error ("error writing a.out headers: ~E"); + } + + Dump_Epilog; +} + +#ifdef HPSHLIB + +/* Save and restore data segments of shared libraries. + * + * When the running program is dumped, we copy the data segment of + * each shared library into a malloced area so that it gets saved + * into the newly created a.out. + * + * On startup of the new a.out, we have to restore the data segments. + * To do so, we first have to re-load all libraries that were present + * in the old a.out when dump was called. + * As the libraries may now get mapped to different locations, we + * call mmap with an anonymous file to make the memory at the old + * locations accessible again. + */ + +#include +#include + +#define MAX_SHARED 1024 + +struct shared_data { + struct shl_descriptor desc; + char *oldaddr; /* Start of data segment */ + char *saved; /* Saved contents of data segment */ +} shared_data[MAX_SHARED], *lsp = shared_data; + +#ifdef DEBUG_DUMP + static char Z[1024]; +# define W write(1,Z,strlen(Z)) +#endif + +Save_Shared_Data () { + struct shl_descriptor *p; + struct shared_data *sp; + int i; + + /* Assumptions: 1st shared library has index 1; + * we can stop as soon as shl_get fails + */ + for (i = 1; shl_get (i, &p) != -1 ; i++) { +#ifdef DEBUG_DUMP + sprintf (Z, "Saving shared lib %s\n", p->filename); W; +#endif + for (sp = shared_data; sp != lsp && + strcmp (sp->desc.filename, p->filename) != 0; sp++) + ; + if (sp == lsp) { +#ifdef DEBUG_DUMP + sprintf (Z, " (new library)\n"); W; +#endif + if (sp == shared_data + MAX_SHARED) + Primitive_Error ("too many shared libraries"); + lsp++; + sp->desc = *p; + sp->saved = Safe_Malloc (p->dend - p->dstart); + sp->oldaddr = (char *)p->dstart; + } + } + for (sp = shared_data; sp != lsp; sp++) { +#ifdef DEBUG_DUMP + sprintf (Z, " copy data seg from %x to %x len %d\n", + sp->oldaddr, sp->saved, sp->desc.dend - sp->desc.dstart); W; +#endif + bcopy (sp->oldaddr, sp->saved, sp->desc.dend - sp->desc.dstart); + } +} + +Restore_Shared_Data () { + struct shared_data *sp; + struct shl_descriptor *p; + shl_t tmp; + + for (sp = shared_data; sp != lsp; sp++) { + /* + * Assumption: libraries whose names start with /lib/ or + * with /usr/lib/ were present in the original a.out and + * need not be re-loaded + */ +#ifdef DEBUG_DUMP + sprintf (Z, "Restoring shared lib %s\n", sp->desc.filename); W; +#endif + if (strncmp (sp->desc.filename, "/lib/", 5) != 0 && + strncmp (sp->desc.filename, "/usr/lib/", 8) != 0) { + /* + * Re-load the library and make sure memory locations + * at the old start of data segment are mapped + */ +#ifdef DEBUG_DUMP + sprintf (Z, " (re-loading)\n"); W; +#endif + tmp = shl_load (sp->desc.filename, BIND_IMMEDIATE|BIND_VERBOSE, 0L); + if (tmp == 0) + exit (1); /* There's nothing we can do... */ + (void)shl_gethandle (tmp, &p); + sp->desc = *p; + + /* Try to mnumap the region in any case. If MAP_REPLACE is + * there, use it. + */ + (void)munmap (sp->oldaddr, sp->desc.dend - sp->desc.dstart); +#ifndef MAP_REPLACE +# define MAP_REPLACE 0 +#endif + if (mmap (sp->oldaddr, sp->desc.dend - sp->desc.dstart, + PROT_READ|PROT_WRITE, + MAP_REPLACE|MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED, + -1, 0) == (char *)-1) { + sprintf (Z, "mmap failed[%d]\n", errno); W; + exit (1); + } + } +#ifdef DEBUG_DUMP + sprintf (Z, " copy data seg from %x to %x len %d\n", sp->saved, + sp->oldaddr, sp->desc.dend-sp->desc.dstart); W; +#endif + bcopy (sp->saved, sp->oldaddr, sp->desc.dend - sp->desc.dstart); + /* + * Initial break must be set as soon as data segment of + * C library is restored + */ + if (strcmp (sp->desc.filename, "/lib/libc.sl") == 0) + (void)brk (Brk_On_Dump); + } +} +#endif /* HPSHLIB */ diff --git a/src/dump-vanilla.c b/src/dump-vanilla.c new file mode 100644 index 0000000..babe4b3 --- /dev/null +++ b/src/dump-vanilla.c @@ -0,0 +1,217 @@ +#ifdef COFF +# include +# include +# include +# include +# ifndef N_BADMAG +# define N_BADMAG(x) (0) +# endif +#else +# include AOUT_H +#endif + +extern void *sbrk(); + +#if defined(hp9000s300) || defined(__hp9000s300) || defined(__hp9000s300__) +static int getpagesize () { + return EXEC_PAGESIZE; +} +#endif + +Object P_Dump (ofile) Object ofile; { +#ifdef COFF + static struct scnhdr thdr, dhdr, bhdr, scn; + static struct filehdr hdr; + static struct aouthdr ohdr; + unsigned bias; + unsigned lnno_start, syms_start; + unsigned text_scn_start, data_scn_start; + unsigned data_end; + int pagemask = COFF_PAGESIZE-1; +#else + struct exec hdr, shdr; + unsigned data_start, data_end; + int pagemask = getpagesize () - 1; +#endif + char *afn; + register n; + char buf[BUFSIZ]; + + Dump_Prolog; + + if (read (afd, (char *)&hdr, sizeof (hdr)) != sizeof (hdr) + || N_BADMAG(hdr)) { +#ifdef COFF +badaout: +#endif + Dump_Finalize; + Primitive_Error ("corrupt a.out file"); + } +#ifdef COFF + data_end = ((unsigned)sbrk (0) + pagemask) & ~pagemask; + syms_start = sizeof (hdr); + if (hdr.f_opthdr > 0) { + if (read (afd, (char *)&ohdr, sizeof (ohdr)) != sizeof (ohdr)) + goto badaout; + } + for (n = 0; n < hdr.f_nscns; n++) { + if (read (afd, (char *)&scn, sizeof (scn)) != sizeof (scn)) + goto badaout; + if (scn.s_scnptr > 0 && syms_start < scn.s_scnptr + scn.s_size) + syms_start = scn.s_scnptr + scn.s_size; + if (strcmp (scn.s_name, ".text") == 0) + thdr = scn; + else if (strcmp (scn.s_name, ".data") == 0) + dhdr = scn; + else if (strcmp (scn.s_name, ".bss") == 0) + bhdr = scn; + } + hdr.f_flags |= (F_RELFLG|F_EXEC); + ohdr.dsize = data_end - ohdr.data_start; + ohdr.bsize = 0; + thdr.s_size = ohdr.tsize; + thdr.s_scnptr = sizeof (hdr) + sizeof (ohdr) + + hdr.f_nscns * sizeof (thdr); + lnno_start = thdr.s_lnnoptr; + text_scn_start = thdr.s_scnptr; + dhdr.s_paddr = dhdr.s_vaddr = ohdr.data_start; + dhdr.s_size = ohdr.dsize; + dhdr.s_scnptr = thdr.s_scnptr + thdr.s_size; + data_scn_start = dhdr.s_scnptr; + bhdr.s_paddr = bhdr.s_vaddr = ohdr.data_start + ohdr.dsize; + bhdr.s_size = ohdr.bsize; + bhdr.s_scnptr = 0; + + bias = dhdr.s_scnptr + dhdr.s_size - syms_start; + if (hdr.f_symptr > 0) + hdr.f_symptr += bias; + if (thdr.s_lnnoptr > 0) + thdr.s_lnnoptr += bias; + + if (write (ofd, (char *)&hdr, sizeof (hdr)) != sizeof (hdr)) { +badwrite: + Dump_Finalize; + Primitive_Error ("error writing dump file: ~E"); + } + if (write (ofd, (char *)&ohdr, sizeof (ohdr)) != sizeof (ohdr)) + goto badwrite; + if (write (ofd, (char *)&thdr, sizeof (thdr)) != sizeof (thdr)) + goto badwrite; + if (write (ofd, (char *)&dhdr, sizeof (dhdr)) != sizeof (dhdr)) + goto badwrite; + if (write (ofd, (char *)&bhdr, sizeof (bhdr)) != sizeof (bhdr)) + goto badwrite; + lseek (ofd, (off_t)text_scn_start, 0); + if (write (ofd, (char *)ohdr.text_start, ohdr.tsize) != ohdr.tsize) + goto badwrite; + Was_Dumped = 1; + lseek (ofd, (off_t)data_scn_start, 0); + if (write (ofd, (char *)ohdr.data_start, ohdr.dsize) != ohdr.dsize) + goto badwrite; + lseek (afd, lnno_start ? (off_t)lnno_start : (off_t)syms_start, 0); +#else + close (afd); +#if defined(__bsdi__) + data_start = N_DATADDR(hdr); +#else + data_start = hdr.a_text; +#if defined(sun) || defined(__sun__) + data_start += pagemask+1; +#endif + data_start = (data_start + SEG_SIZ-1) & ~(SEG_SIZ-1); +#endif + data_end = (unsigned)sbrk (0); +#if !defined(__bsdi__) + data_end = (data_end + pagemask) & ~pagemask; +#endif + hdr.a_data = data_end - data_start; + hdr.a_bss = 0; + hdr.a_trsize = hdr.a_drsize = 0; + + afn = Loader_Input; + if (!afn) + afn = A_Out_Name; + if ((afd = open (afn, O_RDONLY|O_BINARY)) == -1) { + Dump_Finalize; + Primitive_Error ("cannot open symbol table file: ~E"); + } + if (read (afd, (char *)&shdr, sizeof (shdr)) != sizeof (shdr) + || N_BADMAG(shdr)) { + Dump_Finalize; + Primitive_Error ("corrupt symbol table file"); + } +#if defined(hp9000s300) || defined(__hp9000s300) || defined(__hp9000s300__) + hdr.a_lesyms = shdr.a_lesyms; +#else + hdr.a_syms = shdr.a_syms; +#endif + + (void)lseek (ofd, (off_t)FILE_TEXT_START, 0); + n = hdr.a_text - TEXT_LENGTH_ADJ; + if (write (ofd, (char *)MEM_TEXT_START, n) != n) { +badwrite: + Dump_Finalize; + Primitive_Error ("error writing dump file: ~E"); + } + Was_Dumped = 1; + +#if defined(hp9000s300) || defined(__hp9000s300) || defined(__hp9000s300__) + (void)lseek (ofd, (off_t)DATA_OFFSET(hdr), 0); +#endif +#if defined(__bsdi__) + (void)lseek (ofd, (off_t)N_DATOFF(hdr), 0); +#endif +#ifdef GENERATIONAL_GC + n = data_end - data_start; + if (write (ofd, (char *)data_start, n) != n) + goto badwrite; +#else + + if (Heap_Start > Free_Start) { + n = (unsigned)Free_Start - data_start; + if (write (ofd, (char *)data_start, n) != n) + goto badwrite; + (void)lseek (ofd, (off_t)(Free_End - Free_Start), 1); + n = Hp - Heap_Start; + if (write (ofd, Heap_Start, n) != n) + goto badwrite; + (void)lseek (ofd, (off_t)(Heap_End - Hp), 1); + n = data_end - (unsigned)Heap_End; + if (write (ofd, Heap_End, n) != n) + goto badwrite; + } else { + n = (unsigned)Hp - data_start; + if (write (ofd, (char *)data_start, n) != n) + goto badwrite; + (void)lseek (ofd, (off_t)(Free_End - Hp), 1); + n = data_end - (unsigned)Free_End; + if (write (ofd, Free_End, n) != n) + goto badwrite; + } +#endif +#if defined(hp9000s300) || defined(__hp9000s300) || defined(__hp9000s300__) + (void)lseek (afd, (off_t)LESYM_OFFSET(shdr), 0); + (void)lseek (ofd, (off_t)LESYM_OFFSET(hdr), 0); +#else + (void)lseek (afd, (off_t)N_SYMOFF(shdr), 0); +#if defined(__bsdi__) + (void)lseek (ofd, (off_t)N_SYMOFF(hdr), 0); +#endif +#endif +#endif /* !COFF */ + while ((n = read (afd, buf, BUFSIZ)) > 0) { + if (write (ofd, buf, n) != n) + goto badwrite; + } + if (n < 0) { + Dump_Finalize; + Primitive_Error ("error reading symbol table: ~E"); + } +#if !defined(COFF) + (void)lseek (ofd, (off_t)0L, 0); + if (write (ofd, (char *)&hdr, sizeof (hdr)) != sizeof (hdr)) + goto badwrite; +#endif + + Dump_Epilog; +} diff --git a/src/dump.c b/src/dump.c new file mode 100644 index 0000000..3267ba4 --- /dev/null +++ b/src/dump.c @@ -0,0 +1,102 @@ +#include "kernel.h" + +#ifdef CAN_DUMP + +#include +#include +#include +#include + +#ifndef O_BINARY +# define O_BINARY 0 +#endif + +extern int errno; + +Object Dump_Control_Point; + +Init_Dump () { + Dump_Control_Point = Null; + Global_GC_Link (Dump_Control_Point); +} + +#ifdef GENERATIONAL_GC +# define GC_FINALIZE Generational_GC_Finalize() +#else +# define GC_FINALIZE +#endif + +#define Dump_Prolog \ + Object ret;\ + int ofd, afd;\ + char *ofn;\ + GC_Node;\ +\ + Check_If_Dump_Works ();\ + if (!EQ (Curr_Input_Port, Standard_Input_Port) ||\ + !EQ (Curr_Output_Port, Standard_Output_Port))\ + Primitive_Error ("cannot dump with current ports redirected");\ + Flush_Output (Curr_Output_Port);\ + Close_All_Files ();\ + GC_FINALIZE;\ +\ + GC_Link (ofile);\ + ret = Internal_Call_CC (1, Null);\ + if (Truep (ret))\ + return ret;\ + GC_Unlink;\ +\ + Disable_Interrupts;\ +\ + ofn = Get_Strsym (ofile);\ + if ((ofd = open (ofn, O_RDWR|O_CREAT|O_TRUNC|O_BINARY, 0666)) == -1) {\ + Saved_Errno = errno;\ + Primitive_Error ("cannot open ~s: ~E", ofile);\ + }\ + if ((afd = open (A_Out_Name, O_RDONLY|O_BINARY)) == -1) {\ + Saved_Errno = errno;\ + close (ofd);\ + Primitive_Error ("cannot open a.out file: ~E");\ + } + +#define Dump_Finalize Saved_Errno = errno; close (afd); close (ofd) + + +#define Dump_Epilog {\ + close (afd);\ + Set_File_Executable (ofd, ofn);\ + close (ofd);\ + Enable_Interrupts;\ + return False;\ +} + +#ifdef ELF +# include "dump-elf.c" +#else +#ifdef ECOFF +# include "dump-ecoff.c" +#else +#ifdef HP9K +# include "dump-hp9k.c" +#else +# include "dump-vanilla.c" +#endif +#endif +#endif + +/*ARGSUSED1*/ +Set_File_Executable (fd, fn) int fd; char *fn; { + struct stat st; + + if (fstat (fd, &st) != -1) { + int omask = umask (0); + (void)umask (omask); +#ifdef FCHMOD_BROKEN + (void)chmod (fn, st.st_mode & 0777 | 0111 & ~omask); +#else + (void)fchmod (fd, st.st_mode & 0777 | 0111 & ~omask); +#endif + } +} + +#endif /* CAN_DUMP */ diff --git a/src/env.c b/src/env.c new file mode 100644 index 0000000..651f24c --- /dev/null +++ b/src/env.c @@ -0,0 +1,213 @@ +/* Environments, define, set!, etc. + */ + +#include "kernel.h" + +#define Env_To_List(env, list) SET((list), T_Pair, POINTER(env)) +#define List_To_Env(list, env) SET((env), T_Environment, POINTER(list)) + +Object The_Environment, Global_Environment; + +Object General_Define(); + +Init_Env () { + List_To_Env (Cons (Null, Null), Global_Environment); + The_Environment = Global_Environment; + Global_GC_Link (Global_Environment); + Global_GC_Link (The_Environment); +} + +Object P_Environment_To_List (env) Object env; { + Object e; + + Check_Type (env, T_Environment); + Env_To_List (env, e); + return Copy_List (e); +} + +Object P_Environmentp (x) Object x; { + return TYPE(x) == T_Environment ? True : False; +} + +Push_Frame (frame) Object frame; { + Object e; + + Memoize_Frame (frame); + Env_To_List (The_Environment, e); + List_To_Env (Cons (frame, e), The_Environment); +} + +Pop_Frame () { + Object e; + + Env_To_List (The_Environment, e); + List_To_Env (Cdr (e), The_Environment); + Forget_Frame (Car (e)); +} + +Switch_Environment (to) Object to; { + Object old, new, n; + + if (EQ(The_Environment,to)) + return; + Env_To_List (The_Environment, old); + Env_To_List (to, new); + for ( ; !Nullp (old); old = Cdr (old)) { + for (n = new; !Nullp (n) && !EQ(n,old); + n = Cdr (n)) + ; + if (EQ(n,old)) + break; + Forget_Frame (Car (old)); + } + Memoize_Frames (new, n); + The_Environment = to; +} + +Memoize_Frames (this, last) Object this, last; { + if (Nullp (this) || EQ(this,last)) + return; + Memoize_Frames (Cdr (this), last); + Memoize_Frame (Car (this)); +} + +Memoize_Frame (frame) Object frame; { + Object binding; + + for (; !Nullp (frame); frame = Cdr (frame)) { + binding = Car (frame); + SYMBOL(Car (binding))->value = Cdr (binding); + } +} + +Forget_Frame (frame) Object frame; { + for (; !Nullp (frame); frame = Cdr (frame)) + SYMBOL(Car (Car (frame)))->value = Unbound; +} + +Object Add_Binding (frame, sym, val) Object frame, sym, val; { + Object b; + GC_Node; + + GC_Link (frame); + b = Cons (sym, val); + GC_Unlink; + return Cons (b, frame); +} + +Object Lookup_Symbol (sym, err) Object sym; { + Object p, f, b; + + Env_To_List (The_Environment, p); + for (; !Nullp (p); p = Cdr (p)) { + for (f = Car (p); !Nullp (f); f = Cdr (f)) { /* Inlined Assq() */ + b = Car (f); + if (EQ(Car (b), sym)) + return b; + } + } + if (err) + Primitive_Error ("unbound variable: ~s", sym); + return Null; +} + +Object P_The_Environment () { return The_Environment; } + +Object P_Global_Environment () { return Global_Environment; } + +Object Define_Procedure (form, body, sym) Object form, body, sym; { + Object ret; + GC_Node3; + + GC_Link3 (form, body, sym); + body = Cons (Cdr (form), body); + body = Cons (sym, body); + body = Cons (body, Null); + body = Cons (Car (form), body); + ret = General_Define (body, sym); + GC_Unlink; + return ret; +} + +Object General_Define (argl, sym) Object argl, sym; { + Object val, var, frame, binding; + GC_Node3; + TC_Prolog; + + var = Car (argl); + val = Cdr (argl); + if (TYPE(var) == T_Symbol) { + frame = Null; + GC_Link3 (var, val, frame); + if (Nullp (val)) { + val = Void; + } else { + TC_Disable; + val = Eval (Car (val)); + TC_Enable; + } + Set_Name (var, val); + frame = Car (The_Environment); + binding = Assq (var, frame); + if (EQ(binding, False)) { + frame = Add_Binding (frame, var, val); + Car (The_Environment) = frame; + } else + Cdr (binding) = val; + SYMBOL(var)->value = val; + GC_Unlink; + return var; + } else if (TYPE(var) == T_Pair) { + if (Nullp (val)) + Primitive_Error ("no sub-forms in compound: ~s", var); + return Define_Procedure (var, val, sym); + } else Wrong_Type_Combination (var, "symbol or pair"); + /*NOTREACHED*/ +} + +Object P_Define (argl) Object argl; { + return General_Define (argl, Sym_Lambda); +} + +Object P_Define_Macro (argl) Object argl; { + return General_Define (argl, Sym_Macro); +} + +Object P_Set (argl) Object argl; { + Object val, var, binding, old; + GC_Node3; + TC_Prolog; + + var = Car (argl); + val = Car (Cdr (argl)); + Check_Type (var, T_Symbol); + binding = Lookup_Symbol (var, 1); + old = Cdr (binding); + GC_Link3 (var, binding, old); + TC_Disable; + val = Eval (val); + TC_Enable; + Set_Name (var, val); + Cdr (binding) = val; + SYMBOL(var)->value = val; + GC_Unlink; + return old; +} + +Set_Name (var, val) Object var, val; { + register t; + + t = TYPE(val); + if (t == T_Compound) { + if (Nullp (COMPOUND(val)->name)) + COMPOUND(val)->name = var; + } else if (t == T_Macro) { + if (Nullp (MACRO(val)->name)) + MACRO(val)->name = var; + } +} + +Object P_Boundp (x) Object x; { + Check_Type (x, T_Symbol); + return Nullp (Lookup_Symbol (x, 0)) ? False : True; +} diff --git a/src/error.c b/src/error.c new file mode 100644 index 0000000..7b09071 --- /dev/null +++ b/src/error.c @@ -0,0 +1,166 @@ +#include +#include + +#include "kernel.h" + +Object Arg_True; + +static Object V_Error_Handler, V_Top_Level_Control_Point; + +/* Error_Tag should be static and users should only use the functions + * Set_Error_Tag() and Get_Error_Tag(). However, in older versions + * the variable was manipulated directly, therefore it will remain global + * for some time for backwards compatibility. + */ +const char *Error_Tag; + +char *appname; + +Init_Error () { + Arg_True = Cons (True, Null); + Global_GC_Link (Arg_True); + Define_Variable (&V_Error_Handler, "error-handler", Null); + Define_Variable (&V_Top_Level_Control_Point, "top-level-control-point", + Null); +} + +const char *Get_Error_Tag () { + return Error_Tag; +} + +void Set_Error_Tag (tag) const char *tag; { + Error_Tag = tag; +} + +void Set_App_Name (name) char *name; { + appname = name; +} + +#ifdef lint +/*VARARGS1*/ +Fatal_Error (foo) char *foo; { foo = foo; } +#else +Fatal_Error (va_alist) va_dcl { + va_list args; + char *fmt; + + Disable_Interrupts; + va_start (args); + fmt = va_arg (args, char *); + (void)fflush (stdout); + if (appname) + fprintf (stderr, "\n%s: fatal error: ", appname); + else + fprintf (stderr, "\nFatal error: "); + vfprintf (stderr, fmt, args); + fprintf (stderr, ".\n"); + va_end (args); + exit (1); +} +#endif + +Panic (msg) const char *msg; { + Disable_Interrupts; + (void)fflush (stdout); + if (appname) + fprintf (stderr, "\n%s: panic: ", appname); + else + fprintf (stderr, "\nPanic: "); + fprintf (stderr, "%s (dumping core).\n", msg); + abort (); +} + +Uncatchable_Error (errmsg) char *errmsg; { + Disable_Interrupts; + Reset_IO (0); + /* + * The message can be sent to stdout, as Reset_IO() resets the + * current output port back to the Standard_Output_Port: + */ + if (appname) { + printf ("%s: %c", appname, tolower (errmsg[0])); + errmsg++; + } + printf("%s\n", errmsg); + Reset (); +} + +#ifdef lint +/*VARARGS1*/ +Primitive_Error (foo) char *foo; { foo = foo; } +#else +Primitive_Error (va_alist) va_dcl { + va_list args; + register char *p, *fmt; + register i, n; + Object msg, sym, argv[10]; + GC_Node; GCNODE gcv; + + va_start (args); + fmt = va_arg (args, char *); + for (n = 0, p = fmt; *p; p++) + if (*p == '~' && p[1] != '~' && p[1] != '%' + && p[1] != 'E' && p[1] != 'e') + n++; + if (n > 10) + Panic ("Primitive_Error args"); + for (i = 0; i < n; i++) + argv[i] = va_arg (args, Object); + sym = Null; + GC_Link (sym); + gcv.gclen = 1 + i; gcv.gcobj = argv; gcv.next = &gc1; GC_List = &gcv; + sym = Intern (Error_Tag); + msg = Make_String (fmt, p - fmt); + Err_Handler (sym, msg, i, argv); + /*NOTREACHED*/ +} +#endif + +Object P_Error (argc, argv) Object *argv; { + Check_Type (argv[1], T_String); + Err_Handler (argv[0], argv[1], argc-2, argv+2); + /*NOTREACHED*/ +} + +Err_Handler (sym, fmt, argc, argv) Object sym, fmt, *argv; { + Object fun, args, a[1]; + GC_Node3; + + Reset_IO (0); + args = Null; + GC_Link3 (args, sym, fmt); + args = P_List (argc, argv); + args = Cons (fmt, args); + args = Cons (sym, args); + fun = Var_Get (V_Error_Handler); + if (TYPE(fun) == T_Compound) + (void)Funcall (fun, args, 0); + a[0] = sym; + Format (Curr_Output_Port, "~s: ", 4, 1, a); + Format (Curr_Output_Port, STRING(fmt)->data, STRING(fmt)->size, + argc, argv); + (void)P_Newline (0, (Object *)0); + GC_Unlink; + Reset (); + /*NOTREACHED*/ +} + +Reset () { + Object cp; + + cp = Var_Get (V_Top_Level_Control_Point); + if (TYPE(cp) == T_Control_Point) + (void)Funcall_Control_Point (cp, Arg_True, 0); + (void)fflush (stdout); + exit (1); +} + +Object P_Reset () { + Reset_IO (0); + Reset (); + /*NOTREACHED*/ +} + +Range_Error (i) Object i; { + Primitive_Error ("argument out of range: ~s", i); +} diff --git a/src/exception.c b/src/exception.c new file mode 100644 index 0000000..aa00191 --- /dev/null +++ b/src/exception.c @@ -0,0 +1,72 @@ +#include "kernel.h" + +int Intr_Was_Ignored; +unsigned long Intr_Level; + +#ifdef POSIX_SIGNALS +sigset_t Sigset_Old, Sigset_Block; +#else +#ifdef BSD_SIGNALS +int Sigmask_Old, Sigmask_Block; +#endif +#endif + +static Object V_Interrupt_Handler; + +/* Make sure temp files are removed on hangup and broken pipe. + */ +/*ARGSUSED*/ +void Signal_Exit (sig) int sig; { + Exit_Handler (); + exit (1); +} + +Init_Exception () { + Define_Variable (&V_Interrupt_Handler, "interrupt-handler", Null); +#ifdef POSIX_SIGNALS + sigemptyset (&Sigset_Block); + sigaddset (&Sigset_Block, SIGINT); + (void)sigprocmask (0, (sigset_t *)0, &Sigset_Old); +#else +#ifdef BSD_SIGNALS + Sigmask_Block = sigmask (SIGINT); + Sigmask_Old = sigblock (0); +#endif +#endif + (void)signal (SIGHUP, Signal_Exit); + (void)signal (SIGPIPE, Signal_Exit); +} + +/*ARGSUSED*/ +void Intr_Handler (sig) int sig; { + Object fun; + +#ifndef BSD_SIGNALS + (void)signal (SIGINT, Intr_Handler); +#endif + Set_Error_Tag ("interrupt-handler"); + Reset_IO (1); + fun = Var_Get (V_Interrupt_Handler); + if (TYPE(fun) == T_Compound && COMPOUND(fun)->min_args == 0) + (void)Funcall (fun, Null, 0); + Format (Curr_Output_Port, "~%\7Interrupt!~%", 15, 0, (Object *)0); + Reset (); + /*NOTREACHED*/ +} + +void Install_Intr_Handler () { + if (signal (SIGINT, SIG_IGN) == SIG_IGN) + Intr_Was_Ignored = 1; + else + (void)signal (SIGINT, Intr_Handler); +} + +Object P_Disable_Interrupts () { + Disable_Interrupts; + return Make_Unsigned_Long (Intr_Level); +} + +Object P_Enable_Interrupts () { + Enable_Interrupts; + return Make_Unsigned_Long (Intr_Level); +} diff --git a/src/feature.c b/src/feature.c new file mode 100644 index 0000000..06f5b5a --- /dev/null +++ b/src/feature.c @@ -0,0 +1,80 @@ +/* provide, require, and related primitives. + */ + +#include "kernel.h" + +static Object Features; + +Init_Features () { + Features = Null; + Global_GC_Link (Features); +#ifdef CAN_DUMP + P_Provide (Intern ("elk:dump")); +#endif +#ifdef CAN_LOAD_OBJ + P_Provide (Intern ("elk:load-object")); +#endif +} + +Object P_Features () { + return Features; +} + +Object P_Featurep (sym) Object sym; { + Object member; + + Check_Type (sym, T_Symbol); + member = P_Memq (sym, Features); + return Truep (member) ? True : False; +} + +Object P_Provide (sym) Object sym; { + Object member; + + Check_Type (sym, T_Symbol); + member = P_Memq (sym, Features); + if (!Truep (member)) + Features = Cons (sym, Features); + return Void; +} + +static Object Feature_Filename (str) Object str; { + struct S_String *sp = STRING(str); + int len = sp->size; + char *p; + Object s; + GC_Node; + + for (p = sp->data+len-1; p >= sp->data && *p != '.'; p--) + ; + if (p >= sp->data) + return str; + GC_Link (str); + s = Make_String ((char *)0, len+4); + bcopy (STRING(str)->data, STRING(s)->data, len); + bcopy (".scm", STRING(s)->data+len, 4); + GC_Unlink; + return s; +} + +Object P_Require (argc, argv) Object *argv; { + Object sym, a[1], isfeature; + GC_Node; + + sym = argv[0]; + GC_Link (sym); + isfeature = P_Featurep (sym); + if (!Truep (isfeature)) { + if (argc == 3) + Check_Type (argv[2], T_Environment); + a[0] = argc == 1 ? Feature_Filename (SYMBOL(sym)->name) : argv[1]; + if (Var_Is_True (V_Autoload_Notifyp)) + Format (Standard_Output_Port, "[Autoloading ~a]~%", 18, 1, a); + (void)General_Load (a[0], argc == 3 ? argv[2] : The_Environment); + isfeature = P_Featurep (sym); + if (!Truep (isfeature)) + Primitive_Error ("feature ~s was not provided", sym); + } + GC_Unlink; + return Void; +} diff --git a/src/heap-gen.c b/src/heap-gen.c new file mode 100644 index 0000000..c0dfa2b --- /dev/null +++ b/src/heap-gen.c @@ -0,0 +1,1627 @@ +/* The generational, incremental garbage collector. + * Written by Marco Scheibe. Fixes provided by Craig McPheeters, + * Carsten Bormann, Jon Hartlaub, Charlie Xiaoli Huang, Gal Shalif. + * + * This garbage collector is still experimental and probably needs to be + * rewritten at least in parts. See also ../BUGS. If your application + * does not work correctly and you suspect the generational garbage + * collector to be the culprit, try the stop-and-copy GC instead. + */ + +#include +#include +#ifdef HAS_MPROTECT +# include +#endif +#ifdef SYSCONF_PAGESIZE +# define link FOO +# include +# undef link +# if defined(_SC_PAGE_SIZE) && !defined(_SC_PAGESIZE) /* Wrong in HP-UX */ +# define _SC_PAGESIZE _SC_PAGE_SIZE +# endif +#endif +#ifdef SIGSEGV_SIGINFO +# include +# include +#endif + +/* The following variables may be set from outside the collector to + * fine-tune some used parameters. + */ + +int tuneable_forward_region = 5; /* fraction of heap pages that are tried + * to allocate as forward region when + * collecting. + */ +int tuneable_force_total = 35; /* % newly allocated during collection + * to force total collection + */ +int tuneable_newly_expand = 25; /* % of heap newly allocated during + * a total collection to force heap + * expansion. + */ +int tuneable_force_expand = 20; /* % stable to force heap expansion + */ + +/* ------------------------------------------------------------------------ + +defined in object.h: + +typedef int gcspace_t; // type used for space and type arrays +typedef unsigned gcptr_t; // type used for pointers + + ------------------------------------------------------------------------ */ + +static int percent = 0; +static pageno_t old_logical_pages; + +static int inc_collection = 0; + +static int incomplete_msg = 0; + +static pageno_t logical_pages, spanning_pages, physical_pages; + +/* pagebase is #defined in object.h if ARRAY_BROKEN is not defined. */ + +#ifdef ARRAY_BROKEN + pageno_t pagebase; +#endif + +static pageno_t firstpage, lastpage; + +gcspace_t *space; +static gcspace_t *type, *pmap; +static pageno_t *link; + +static pageno_t current_pages, forwarded_pages; +static pageno_t protected_pages, allocated_pages; + +static addrarith_t bytes_per_pp, pp_shift; /* bytes per physical page */ +static addrarith_t hp_per_pp; /* number of heap pages per physical page */ +static addrarith_t pp_mask; /* ANDed with a virtual address gives + * base address of physical page + */ +static addrarith_t hp_per_pp_mask; /* ANDed with heap page number gives + * first page number in the physical + * page the heap page belongs to. + */ +#define SAME_PHYSPAGE(a,b) (((a) & pp_mask) == ((b) & pp_mask)) + +gcspace_t current_space; /* has to be exported because IS_ALIVE depends on it */ + +static gcspace_t forward_space, previous_space; +static pageno_t current_freepage, current_free; +static pageno_t forward_freepage, forward_free; +static pageno_t last_forward_freepage; + +static Object *current_freep, *forward_freep; + +static int scanning = 0; /* set to true if scanning a + * physical page is in progress */ +static Object *scanpointer; +static Object *scanfirst, *scanlast; +#define IN_SCANREGION(addr) ((Object*)(addr) >= scanfirst \ + && (Object*)(addr) <= scanlast) +#define IS_SCANNED(addr) ((Object *)(addr) < scanpointer) +#define MAXRESCAN 10 +static pageno_t rescan[MAXRESCAN]; +static int rescanpages = 0; +static int allscan = 0; + +static pageno_t stable_queue, stable_tail; /* head and tail of the queue + * of stable pages */ + +#define DIRTYENTRIES 20 +struct dirty_rec { + pageno_t pages[DIRTYENTRIES]; + struct dirty_rec *next; +}; + +static struct dirty_rec *dirtylist, *dirtyhead; +static int dirtyentries; + +static int ScanCluster (); +static int Scanner (); +static void TerminateGC (); + +/*****************************************************************************/ + +/* PAGEBYTES is defined in object.h */ + +#define PAGEWORDS (PAGEBYTES / sizeof (Object)) +#define HEAPPAGEMASK ~(PAGEBYTES-1) + +#ifdef ALIGN_8BYTE +# define MAX_OBJECTWORDS (PAGEWORDS - 1) +# define NEEDED_PAGES(size) (((size) + PAGEWORDS) / PAGEWORDS) +#else +# define MAX_OBJECTWORDS PAGEWORDS +# define NEEDED_PAGES(size) (((size) + PAGEWORDS - 1) / PAGEWORDS) +#endif + +#define MAKE_HEADER(obj,words,type) (SET(obj, type, words)) +#define HEADER_TO_TYPE(header) ((unsigned)TYPE(header)) +#define HEADER_TO_WORDS(header) ((unsigned)FIXNUM(header)) + +/* some conversion stuff. PHYSPAGE converts a logical page number into the + * start address of the physical page the logical page lies on. + * If ARRAY_BROKEN is defined, page numbering will start at 0 for the + * first heap page. Not that this will introduce some extra overhead. + * Note that PAGE_TO_ADDR(0) == 0 if ARRAY_BROKEN is not defined... + */ + +#define OBJ_TO_PPADDR(obj) ((gcptr_t)POINTER(obj) & pp_mask) +#define PTR_TO_PPADDR(ptr) ((gcptr_t)(ptr) & pp_mask) +#define ADDR_TO_PAGE(addr) ((((addr) & HEAPPAGEMASK) / PAGEBYTES) - pagebase) +#define PAGE_TO_ADDR(page) (((page) + pagebase) * PAGEBYTES) +#define PHYSPAGE(page) ((((page) + pagebase) * PAGEBYTES) & pp_mask) + +#define UNALLOCATED_PAGE (gcspace_t)(-2) +#define FREE_PAGE 1 + +#define OBJECTPAGE 0 +#define CONTPAGE 1 + +#define PERCENT(x, y) (((x) * 100) / (y)) +#define HEAPPERCENT(x) PERCENT(x, logical_pages) + +#define IS_CLUSTER(a,b) (SAME_PHYSPAGE (PAGE_TO_ADDR ((a)), \ + PAGE_TO_ADDR ((b))) || \ + (type[(a)&hp_per_pp_mask] == OBJECTPAGE && \ + type[((b)&hp_per_pp_mask)+hp_per_pp] == OBJECTPAGE)) + +/* check whether the (physical) page starting at address addr is protected + * or not. SET_PROTECT and SET_UNPROTECT are used to set or clear the flag + * for the page starting at address addr in the pmap array. The job of + * protecting a page (by calling mprotect) is done in PROTECT/UNPROTECT. + */ + +#define PMAP(addr) pmap[((addr) - PAGE_TO_ADDR(0)) >> pp_shift] + +#define IS_PROTECTED(addr) ( PMAP (addr) ) +#define SET_PROTECT(addr) { PMAP (addr) = 1; protected_pages++; } +#define SET_UNPROTECT(addr) { PMAP (addr) = 0; protected_pages--; } + +#ifdef HAS_MPROTECT +# ifndef PROT_RW +# define PROT_RW (PROT_READ | PROT_WRITE) +# endif +# ifndef PROT_NONE +# define PROT_NONE 0 +# endif +# define MPROTECT(addr,len,prot) { if (inc_collection) \ + mprotect ((caddr_t)(addr), (len), \ + (prot)); } +#else +# define PROT_RW +# define PROT_NONE +# define MPROTECT(addr,len,prot) +#endif + +#define PROTECT(addr) { if (!IS_PROTECTED (addr)) { \ + if (!scanning) { \ + SET_PROTECT (addr); \ + MPROTECT ((addr), bytes_per_pp, PROT_NONE); \ + } else \ + AddDirty ((addr)); \ + } } + +#define UNPROTECT(addr) { if (IS_PROTECTED (addr)) { \ + SET_UNPROTECT (addr); \ + MPROTECT ((addr), bytes_per_pp, PROT_RW); \ + } } + +/*****************************************************************************/ + +/* the following functions maintain a linked list to remember pages that + * are "endangered" while scanning goes on. The list elements are arrays, + * each one containing some page addresses. If an array is filled, a new + * one is appended to the list (dynamically). + * An address is not added to the list if the most recently added entry + * is the same address. It is not necessary to add an address if it is in + * the list anywhere, but searching would be too time-consuming. + */ + +static void SetupDirtyList () { + dirtylist = (struct dirty_rec *) malloc (sizeof (struct dirty_rec)); + if (dirtylist == (struct dirty_rec *)0) + Fatal_Error ("SetupDirtyList: unable to allocate memory"); + bzero ((char *)dirtylist->pages, sizeof (dirtylist->pages)); + dirtylist->next = (struct dirty_rec *)0; + dirtyhead = dirtylist; + dirtyentries = 0; +} + +static void AddDirty (addr) pageno_t addr; { + struct dirty_rec *p; + + if (dirtyentries != 0 && + dirtylist->pages[(dirtyentries-1) % DIRTYENTRIES] == addr) + return; + else + dirtylist->pages[dirtyentries++ % DIRTYENTRIES] = addr; + + if (dirtyentries % DIRTYENTRIES == 0) { + p = (struct dirty_rec *) malloc (sizeof (struct dirty_rec)); + if (p == (struct dirty_rec *)0) + Fatal_Error ("AddDirty: unable to allocate memory"); + bzero ((char *)p->pages, sizeof (p->pages)); + p->next = (struct dirty_rec *)0; + dirtylist->next = p; + dirtylist = p; + } +} + +static void ReprotectDirty () { + int i; + + dirtylist = dirtyhead; + while (dirtylist) { + for (i = 0; i < DIRTYENTRIES && dirtyentries--; i++) + PROTECT (dirtylist->pages[i]); + dirtylist = dirtylist->next; + } + + dirtyentries = 0; + dirtylist = dirtyhead; + dirtylist->next = (struct dirty_rec *)0; +} + + +/* register a page which has been promoted into the scan region by the + * Visit function. If that page has not been scanned yet, return, else + * remember the page to be scanned later. If there is not enough space + * to remember pages, set a flag to rescan the whole scan region. + */ + +static void RegisterPage (page) pageno_t page; { + if (allscan) + return; + + if (IS_SCANNED (PAGE_TO_ADDR (page))) { + if (rescanpages < MAXRESCAN) + rescan[rescanpages++] = page; + else + allscan = 1; + } +} + +/* determine a physical page cluster. Search backward until the beginning + * of the cluster is found, then forward until the length of the cluster + * is determined. The first parameter is the address of the first physical + * page in the cluster, the second one is the length in physical pages. + * Note that these parameters are value-result parameters ! + */ + +static void DetermineCluster (addr, len) gcptr_t *addr; int *len; { + gcptr_t addr1; + + *len = 1; + while (type[ADDR_TO_PAGE (*addr)] != OBJECTPAGE) { + *addr -= bytes_per_pp; + (*len)++; + } + addr1 = *addr + ((*len) << pp_shift); + + while (ADDR_TO_PAGE(addr1) <= lastpage && + space[ADDR_TO_PAGE(addr1)] > 0 && + type[ADDR_TO_PAGE(addr1)] != OBJECTPAGE) { + addr1 += bytes_per_pp; + (*len)++; + } +} + + +/* the following two functions are used to protect or unprotect a page + * cluster. The first parameter is the address of the first page of the + * cluster, the second one is the length in physical pages. If the length + * is 0, DetermineCluster is called to set length accordingly. + */ + +static void ProtectCluster (addr, len) gcptr_t addr; { + if (!len) DetermineCluster (&addr, &len); + if (len > 1) { + while (len) { + if (!IS_PROTECTED (addr)) { + MPROTECT (addr, len << pp_shift, PROT_NONE); + break; + } + len--; + addr += bytes_per_pp; + } + while (len--) { + if (!IS_PROTECTED (addr)) SET_PROTECT (addr); + addr += bytes_per_pp; + } + } else { + if (!IS_PROTECTED (addr)) { + MPROTECT (addr, bytes_per_pp, PROT_NONE); + SET_PROTECT (addr); + } + } +} + + +static void UnprotectCluster (addr, len) gcptr_t addr; { + if (!len) DetermineCluster (&addr, &len); + MPROTECT (addr, len << pp_shift, PROT_RW); + while (len--) { + if (IS_PROTECTED (addr)) SET_UNPROTECT (addr); + addr += bytes_per_pp; + } +} + + +/* add one page to the stable set queue */ + +static void AddQueue (page) pageno_t page; { + + if (stable_queue != (pageno_t)-1) + link[stable_tail] = page; + else + stable_queue = page; + link[page] = (pageno_t)-1; + stable_tail = page; +} + + +/* the following function promotes all heap pages in the stable set queue + * into current space. After this, there are no more forwarded pages in the + * heap. + */ + +static void PromoteStableQueue () { + Object *p; + int pcount, size; + pageno_t start; + + while (stable_queue != (pageno_t)-1) { + p = PAGE_TO_OBJ (stable_queue); +#ifdef ALIGN_8BYTE + p++; +#endif + size = HEADER_TO_WORDS (*p); + pcount = NEEDED_PAGES (size); + + start = stable_queue; + while (pcount--) + space[start++] = current_space; + stable_queue = link[stable_queue]; + } + current_pages = allocated_pages; + forwarded_pages = 0; +} + +/* calculate the logarithm (base 2) for arguments == 2**n + */ + +static Logbase2 (psize) addrarith_t psize; { + int shift = 0; + +#if LONG_BITS-64 == 0 + if (psize & 0xffffffff00000000) shift += 32; + if (psize & 0xffff0000ffff0000) shift += 16; + if (psize & 0xff00ff00ff00ff00) shift += 8; + if (psize & 0xf0f0f0f0f0f0f0f0) shift += 4; + if (psize & 0xcccccccccccccccc) shift += 2; + if (psize & 0xaaaaaaaaaaaaaaaa) shift += 1; +#else + if (psize & 0xffff0000) shift += 16; + if (psize & 0xff00ff00) shift += 8; + if (psize & 0xf0f0f0f0) shift += 4; + if (psize & 0xcccccccc) shift += 2; + if (psize & 0xaaaaaaaa) shift += 1; +#endif + + return (shift); +} + +/* return next heap page number, wrap around at the end of the heap. */ + +static pageno_t next (page) pageno_t page; { + return ((page < lastpage) ? page+1 : firstpage); +} + +/*****************************************************************************/ + +#ifdef MPROTECT_MMAP + +static char *heapmalloc (s) { + char *ret = mmap (0, s, PROT_READ|PROT_WRITE, MAP_ANON, -1, 0); + + if (ret == (char*)-1) + ret = 0; + + return ret; +} + +#else + +# define heapmalloc(size) (char *)malloc ((size)) + +#endif + +/* + * make a heap of size kilobytes. It is divided into heappages of + * PAGEBYTES byte and is aligned at a physical page boundary. The + * heapsize is rounded up to the nearest multiple of the physical + * pagesize. + */ + +Make_Heap (size) { + addrarith_t heapsize = size * 2 * 1024; + char *heap_ptr, *aligned_heap_ptr; + Object heap_obj; + pageno_t i; + +#ifdef HAS_MPROTECT + InstallHandler (); +#endif + + /* calculate number of logical heappages and of used physical pages. + * First, round up to the nearest multiple of the physical pagesize, + * then calculate the resulting number of heap pages. + */ + +#ifdef SYSCONF_PAGESIZE + if ((bytes_per_pp = sysconf (_SC_PAGESIZE)) == -1) + Fatal_Error ("sysconf(_SC_PAGESIZE) failed; can't get pagesize"); +#else +#ifdef GETPAGESIZE + bytes_per_pp = getpagesize (); +#else +# ifdef HAS_MPROTECT +# include "mprotect requires getpagesize or sysconf_pagesize" +# else + bytes_per_pp = 4096; +# endif +#endif +#endif + physical_pages = (heapsize+bytes_per_pp-1)/bytes_per_pp; + hp_per_pp = bytes_per_pp / PAGEBYTES; + hp_per_pp_mask = ~(hp_per_pp - 1); + logical_pages = spanning_pages = physical_pages * hp_per_pp; + pp_mask = ~(bytes_per_pp-1); + pp_shift = Logbase2 (bytes_per_pp); + + heap_ptr = heapmalloc (logical_pages*PAGEBYTES+bytes_per_pp-1); + + if (heap_ptr == NULL) + Fatal_Error ("cannot allocate heap (%u KBytes)", size); + + /* Align heap at a memory page boundary */ + + if ((gcptr_t)heap_ptr & (bytes_per_pp-1)) + aligned_heap_ptr = (char*)(((gcptr_t)heap_ptr+bytes_per_pp) + & ~(bytes_per_pp-1)); + else + aligned_heap_ptr = heap_ptr; + + SET(heap_obj, 0, aligned_heap_ptr); + +#ifdef ARRAY_BROKEN + pagebase = ((gcptr_t)POINTER (heap_obj)) / PAGEBYTES; +#endif + firstpage = OBJ_TO_PAGE (heap_obj); + lastpage = firstpage+logical_pages-1; + + space = (gcspace_t *)malloc (logical_pages*sizeof (gcspace_t)); + type = (gcspace_t *)malloc ((logical_pages + 1)*sizeof (gcspace_t)); + pmap = (gcspace_t *)malloc (physical_pages*sizeof (gcspace_t)); + link = (pageno_t *)malloc (logical_pages*sizeof (pageno_t)); + if (!space || !type || !pmap || !link) { + free (heap_ptr); + if (space) free ((char*)space); + if (type) free ((char*)type); + if (pmap) free ((char*)pmap); + if (link) free ((char*)link); + Fatal_Error ("cannot allocate heap maps"); + } + + bzero ((char *)type, (logical_pages + 1)*sizeof (gcspace_t)); + bzero ((char *)pmap, physical_pages*sizeof (gcspace_t)); + bzero ((char *)link, logical_pages*sizeof (unsigned)); + space -= firstpage; /* to index the arrays with the heap page number */ + type -= firstpage; + type[lastpage+1] = OBJECTPAGE; + link -= firstpage; +#ifndef ARRAY_BROKEN + pmap -= (PAGE_TO_ADDR (firstpage) >> pp_shift); +#endif + + for (i = firstpage; i <= lastpage; i++) + space[i] = FREE_PAGE; + + allocated_pages = 0; + forwarded_pages = 0; + current_pages = 0; + protected_pages = 0; + stable_queue = (pageno_t)-1; + SetupDirtyList (); + + current_space = forward_space = previous_space = 3; + current_freepage = firstpage; current_free = 0; +} + +/* + * increment the heap by 1024 KB. + */ + +static int ExpandHeap (reason) char *reason; { + int increment = (1024 * 1024 + bytes_per_pp - 1) / bytes_per_pp; + int incpages = increment * hp_per_pp; + addrarith_t heapinc = incpages * PAGEBYTES; + pageno_t new_first, inc_first; + pageno_t new_last, inc_last; + pageno_t new_logpages, new_physpages; + pageno_t new_spanpages; + gcptr_t addr; + gcspace_t *new_space, *new_type, *new_pmap; + pageno_t *new_link, i; + char *heap_ptr, *aligned_heap_ptr; + Object heap_obj; +#ifdef ARRAY_BROKEN + pageno_t new_pagebase, offset; + pageno_t new_firstpage, new_lastpage; +#else +# define offset 0 +#endif + + heap_ptr = heapmalloc (heapinc+bytes_per_pp-1); + + if (heap_ptr == NULL) { + if (Var_Is_True (V_Garbage_Collect_Notifyp)) { + char buf[243]; + sprintf(buf, "[Heap expansion failed (%s)]~%%", reason); + Format (Standard_Output_Port, buf, + strlen(buf), 0, (Object *)0); + (void)fflush (stdout); + } + return (0); + } + + /* Align heap at a memory page boundary */ + + if ((gcptr_t)heap_ptr & (bytes_per_pp-1)) + aligned_heap_ptr = (char*)(((gcptr_t)heap_ptr+bytes_per_pp-1) + & ~(bytes_per_pp-1)); + else + aligned_heap_ptr = heap_ptr; + + SET(heap_obj, 0, aligned_heap_ptr); + + new_first = firstpage; + new_last = lastpage; + +#ifdef ARRAY_BROKEN + new_pagebase = ((gcptr_t)POINTER (heap_obj)) / PAGEBYTES; + inc_first = 0; /* = OBJ_TO_PAGE (heap_obj) - new_pagebase */ + + new_firstpage = (pagebase > new_pagebase) + ? new_pagebase : pagebase; + + new_lastpage = (pagebase > new_pagebase) + ? pagebase + lastpage + : new_pagebase + incpages - 1; + + offset = pagebase - new_firstpage; +#else + inc_first = OBJ_TO_PAGE (heap_obj); +#endif + + inc_last = inc_first+incpages-1; + if (inc_last > lastpage) + new_last = inc_last; + if (inc_first < firstpage) + new_first = inc_first; + new_logpages = logical_pages+incpages; +#ifdef ARRAY_BROKEN + new_spanpages = new_lastpage-new_firstpage+1; + new_last = new_spanpages-1; +#else + new_spanpages = new_last-new_first+1; +#endif + new_physpages = new_spanpages / hp_per_pp; + + new_space = (gcspace_t *)malloc (new_spanpages*sizeof (gcspace_t)); + new_type = (gcspace_t *)malloc ((new_spanpages + 1)*sizeof (gcspace_t)); + new_pmap = (gcspace_t *)malloc (new_physpages*sizeof (gcspace_t)); + new_link = (pageno_t *)malloc (new_spanpages*sizeof (pageno_t)); + if (!new_space || !new_type || !new_pmap || !new_link) { + free (heap_ptr); + if (new_space) free ((char*)new_space); + if (new_type) free ((char*)new_type); + if (new_pmap) free ((char*)new_pmap); + if (new_link) free ((char*)new_link); + if (Var_Is_True (V_Garbage_Collect_Notifyp)) { + Format (Standard_Output_Port, "[Heap expansion failed]~%", + 25, 0, (Object *)0); + (void)fflush (stdout); + } + return (0); + } + + /* new_first will be 0 if ARRAY_BROKEN is defined. */ + + new_space -= new_first; + new_type -= new_first; + new_link -= new_first; + bzero ((char*)new_pmap, new_physpages * sizeof (gcspace_t)); +#ifndef ARRAY_BROKEN + new_pmap -= (PHYSPAGE (new_first) >> pp_shift); +#endif + + for (i = firstpage; i <= lastpage; i++) { + new_link[i + offset] = link[i] + offset; + new_type[i + offset] = type[i]; + } + for (addr = PAGE_TO_ADDR (firstpage); addr <= PAGE_TO_ADDR (lastpage); + addr += bytes_per_pp) { + new_pmap[((addr - PAGE_TO_ADDR(0)) >> pp_shift) + offset] = + IS_PROTECTED (addr); + } + +#ifdef ARRAY_BROKEN + for (i = 0; i < new_spanpages; i++) new_space[i] = UNALLOCATED_PAGE; + for (i = firstpage; i <= lastpage; i++) new_space[i+offset] = space[i]; + offset = offset ? 0 : new_pagebase - pagebase; + for (i = offset; i <= offset + inc_last; i++) new_space[i] = FREE_PAGE; + new_type[new_spanpages] = OBJECTPAGE; +#else + for (i = new_first; i < firstpage; i++) new_space[i] = UNALLOCATED_PAGE; + for (i = firstpage; i <= lastpage; i++) new_space[i] = space[i]; + + for (i = lastpage+1; i <= new_last; i++) new_space[i] = UNALLOCATED_PAGE; + for (i = inc_first; i <= inc_last; i++) new_space[i] = FREE_PAGE; + new_type[new_last+1] = OBJECTPAGE; +#endif + + current_freepage += offset; + forward_freepage += offset; + last_forward_freepage += offset; + + free ((char*)(link+firstpage)); + free ((char*)(type+firstpage)); + free ((char*)(space+firstpage)); + +#ifndef ARRAY_BROKEN + free ((char*)(pmap+(PAGE_TO_ADDR (firstpage) >> pp_shift))); +#else + free ((char*)pmap); +#endif + + link = new_link; + type = new_type; + space = new_space; + pmap = new_pmap; + firstpage = new_first; + lastpage = new_last; + logical_pages = new_logpages; + spanning_pages = new_spanpages; + physical_pages = new_physpages; + + if (Var_Is_True (V_Garbage_Collect_Notifyp)) { + int a = (logical_pages * PAGEBYTES) >> 10; + char buf[243]; + + sprintf(buf, "[Heap expanded to %dK (%s)]~%%", a, reason); + Format (Standard_Output_Port, buf, strlen(buf), 0, (Object *)0); + (void)fflush (stdout); + } + return (1); +} + + +/* allocate new logical heappages. npg is the number of pages to allocate. + * If there is not enough space left, the heap will be expanded if possible. + * The new page is allocated in current space. + */ + +static int ProtectedInRegion (start, npages) pageno_t start, npages; { + gcptr_t beginpage = PHYSPAGE (start); + gcptr_t endpage = PHYSPAGE (start+npages-1); + + do { + if (IS_PROTECTED (beginpage)) + return (1); + beginpage += bytes_per_pp; + } while (beginpage <= endpage); + + return (0); +} + +static void AllocPage (npg) pageno_t npg; { + pageno_t first_freepage; /* first free heap page */ + pageno_t cont_free; /* contiguous free pages */ + pageno_t n, p; + + if (current_space != forward_space) { + (void)Scanner ((pageno_t)1); + if (!protected_pages) + TerminateGC (); + } else { + if (inc_collection) { + if (allocated_pages+npg >= logical_pages/3) + P_Collect_Incremental (); + } else { + if (allocated_pages+npg >= logical_pages/2) + P_Collect (); + } + } + + /* now look for a cluster of npg free pages. cont_free counts the + * number of free pages found, first_freepage is the number of the + * first free heap page in the cluster. + */ + + for (p = spanning_pages, cont_free = 0; p; p--) { + if (space[current_freepage] < previous_space + && !STABLE (current_freepage)) { + if (!(cont_free++)) { + if (IS_CLUSTER (current_freepage, current_freepage+npg-1)) + first_freepage = current_freepage; + else { + current_freepage = next (current_freepage - + current_freepage % hp_per_pp + + hp_per_pp-1); + cont_free = 0; + continue; + } + } + + if (cont_free == npg) { + space[first_freepage] = current_space; + type[first_freepage] = OBJECTPAGE; + for (n = 1; n < npg; n++) { + space[first_freepage+n] = current_space; + type[first_freepage+n] = CONTPAGE; + } + current_freep = PAGE_TO_OBJ (first_freepage); + current_free = npg*PAGEWORDS; + current_pages += npg; + allocated_pages += npg; + current_freepage = next (first_freepage+npg-1); + if (ProtectedInRegion (first_freepage, npg)) + (void)ScanCluster (PHYSPAGE (first_freepage)); + return; + } else { + current_freepage = next (current_freepage); + if (current_freepage == firstpage) cont_free = 0; + } + } else { + current_freepage = next (current_freepage); + cont_free = 0; + } + } + + /* no space available, try to expand heap */ + + if (ExpandHeap ("to allocate new object")) { + AllocPage (npg); + return; + } + + Fatal_Error ("unable to allocate %lu bytes in heap", npg*PAGEBYTES); + + /*NOTREACHED*/ +} + + +/* allocate an object in the heap. size is the size of the new object + * in bytes, type describes the object's type (see object.h), and konst + * determines whether the object is immutable. + */ + +Object Alloc_Object (size, type, konst) { + Object obj; + register addrarith_t s = /* size in words */ + ((size + sizeof(Object) - 1) / sizeof(Object)) + 1; + int big = 0; + + if (GC_Debug) { + if (inc_collection) + P_Collect_Incremental (); + else + P_Collect (); + } + + /* if there is not enough space left on the current page, discard + * the left space and allocate a new page. Space is discarded by + * writing a T_Freespace object. + */ + + if (s > current_free) { + if (current_free) { + MAKE_HEADER (*current_freep, current_free, T_Freespace); + current_free = 0; + } + + /* If we are about to allocate an object bigger than one heap page, + * set a flag. The space behind big objects is discarded, see below. + */ + +#ifdef ALIGN_8BYTE + if (s < PAGEWORDS-1) + AllocPage ((pageno_t)1); + else { + AllocPage ((pageno_t)(s+PAGEWORDS)/PAGEWORDS); + big = 1; + } + MAKE_HEADER (*current_freep, 1, T_Align_8Byte); + current_freep++; + current_free--; +#else + if (s < PAGEWORDS) + AllocPage ((pageno_t)1); + else { + AllocPage ((pageno_t)(s+PAGEWORDS-1)/PAGEWORDS); + big = 1; + } +#endif + } + + /* now write a header for the object into the heap and update the + * pointer to the next free location and the counter of free words + * in the current heappage. + */ + + MAKE_HEADER (*current_freep, s, type); + current_freep++; + *current_freep = Null; + SET (obj, type, current_freep); + if (big) + current_freep = (Object*)0, current_free = 0; + else + current_freep += (s-1), current_free -= s; +#ifdef ALIGN_8BYTE + if (!((gcptr_t)current_freep & 7) && current_free) { + MAKE_HEADER (*current_freep, 1, T_Align_8Byte); + current_freep++; + current_free--; + } +#endif + if (type == T_Control_Point) + CONTROL(obj)->reloc = 0; + + if (konst) SETCONST (obj); + return (obj); +} + + +/* allocate a page in forward space. If there is no space left, the heap + * is expanded. The argument prevents allocation of a heap page which lies + * on the same physical page the referenced object lies on. + */ + +static void AllocForwardPage (bad) Object bad; { + Object *badaddr = (Object *)POINTER (bad); + pageno_t whole_heap = spanning_pages; + pageno_t tpage; + + while (whole_heap--) { + if (space[forward_freepage] < previous_space + && !STABLE (forward_freepage) + && !SAME_PHYSPAGE ((gcptr_t)badaddr, + PAGE_TO_ADDR (forward_freepage)) + && !IN_SCANREGION (PAGE_TO_ADDR (forward_freepage))) { + + allocated_pages++; + forwarded_pages++; + space[forward_freepage] = forward_space; + type[forward_freepage] = OBJECTPAGE; + forward_freep = PAGE_TO_OBJ (forward_freepage); + forward_free = PAGEWORDS; + AddQueue (forward_freepage); + + tpage = last_forward_freepage; + last_forward_freepage = next (forward_freepage); + forward_freepage = tpage; + return; + } else { + forward_freepage = next (forward_freepage); + } + } + + if (ExpandHeap ("to allocate forward page")) { + AllocForwardPage (bad); + return; + } + + Fatal_Error ("unable to allocate forward page in %lu KBytes heap", + (logical_pages * PAGEBYTES) >> 10); + + /*NOTREACHED*/ +} + + +/* Visit an object and move it into forward space. The forwarded + * object must be protected because it is to be scanned later. + */ + +Visit (cp) register Object *cp; { + register pageno_t page = OBJ_TO_PAGE (*cp); + register Object *obj_ptr = (Object *)POINTER (*cp); + int tag = TYPE (*cp); + int konst = ISCONST (*cp); + addrarith_t objwords; + pageno_t objpages, pcount; + gcptr_t ffreep, pageaddr = 0; + int outside; + + /* if the Visit function is called via the REVIVE_OBJ macro and we are + * not inside an incremental collection, exit immediately. + */ + + if (current_space == forward_space) + return; + + if (page < firstpage || page > lastpage || STABLE (page) + || space[page] == current_space || space[page] == UNALLOCATED_PAGE + || !Types[tag].haspointer) + return; + + if (space[page] != previous_space) { + char buf[100]; + sprintf (buf, "Visit: object not in prev space at 0x%lx ('%s') %d %d", + obj_ptr, Types[tag].name, space[page], previous_space); + Panic (buf); + } + + if (!IN_SCANREGION (obj_ptr) && IS_PROTECTED ((gcptr_t)obj_ptr)) { + pageaddr = OBJ_TO_PPADDR (*cp); + UNPROTECT (pageaddr); + } + + if (WAS_FORWARDED (*cp)) { + if (pageaddr != 0) + PROTECT (pageaddr); + MAKEOBJ (*cp, tag, POINTER(*obj_ptr)); + if (konst) + SETCONST (*cp); + return; + } + + ffreep = PTR_TO_PPADDR (forward_freep); + outside = !IN_SCANREGION (forward_freep); + objwords = HEADER_TO_WORDS (*(obj_ptr - 1)); + if (objwords >= forward_free) { +#ifdef ALIGN_8BYTE + if (objwords >= PAGEWORDS - 1) { + objpages = (objwords + PAGEWORDS) / PAGEWORDS; +#else + if (objwords >= PAGEWORDS) { + objpages = (objwords + PAGEWORDS - 1) / PAGEWORDS; +#endif + forwarded_pages += objpages; + for (pcount = 0; pcount < objpages; pcount++) + space[page + pcount] = forward_space; + AddQueue (page); + if (IN_SCANREGION (PAGE_TO_ADDR (page))) + RegisterPage (page); + else + ProtectCluster (PHYSPAGE (page), 0); + + if (pageaddr != 0) + PROTECT (pageaddr); + + return; + } + + if (forward_free) { + if (outside && IS_PROTECTED (ffreep) + && !SAME_PHYSPAGE ((gcptr_t)obj_ptr, ffreep)) { + + UNPROTECT (ffreep); + MAKE_HEADER (*forward_freep, forward_free, T_Freespace); + forward_free = 0; + PROTECT (ffreep); + } else { + MAKE_HEADER (*forward_freep, forward_free, T_Freespace); + forward_free = 0; + } + } + + AllocForwardPage (*cp); + outside = !IN_SCANREGION (forward_freep); + ffreep = PTR_TO_PPADDR (forward_freep); /* re-set ffreep ! */ +#ifdef ALIGN_8BYTE + if (outside && IS_PROTECTED (ffreep)) + UNPROTECT (ffreep); + MAKE_HEADER (*forward_freep, 1, T_Align_8Byte); + forward_freep++; + forward_free--; + goto do_forward; +#endif + } + + if (outside && IS_PROTECTED (ffreep)) + UNPROTECT (ffreep); + +#ifdef ALIGN_8BYTE +do_forward: +#endif + if (tag == T_Control_Point) { + CONTROL (*cp)->reloc = + (char*)(forward_freep + 1) - (char*)obj_ptr; + } + + MAKE_HEADER (*forward_freep, objwords, tag); + forward_freep++; + bcopy ((char*)obj_ptr, (char*)forward_freep, (objwords-1)*sizeof(Object)); + SET (*obj_ptr, T_Broken_Heart, forward_freep); + MAKEOBJ (*cp, tag, forward_freep); + if (konst) + SETCONST (*cp); + forward_freep += (objwords - 1); + forward_free -= objwords; + +#ifdef ALIGN_8BYTE + if (!((gcptr_t)forward_freep & 7) && forward_free) { + MAKE_HEADER (*forward_freep, 1, T_Align_8Byte); + forward_freep++; + forward_free--; + } +#endif + + if (outside) + PROTECT (ffreep); + + if (pageaddr != 0) + PROTECT (pageaddr); + + return; +} + + +/* Scan a page and visit all objects referenced by objects lying on the + * page. This will possibly forward the referenced objects. + */ + +static void ScanPage (currentp, nextcp) Object *currentp, *nextcp; { + Object *cp = currentp, obj; + addrarith_t len, m, n; + int t; + + while (cp < nextcp && (cp != forward_freep || forward_free == 0)) { + t = HEADER_TO_TYPE (*cp); + len = HEADER_TO_WORDS (*cp); + cp++; + + /* cp now points to the real Scheme object in the heap. t denotes + * the type of the object, len its length inclusive header in + * words. + */ + + SET(obj, t, cp); + + switch (t) { + case T_Symbol: + Visit (&SYMBOL(obj)->next); + Visit (&SYMBOL(obj)->name); + Visit (&SYMBOL(obj)->value); + Visit (&SYMBOL(obj)->plist); + break; + + case T_Pair: + case T_Environment: + Visit (&PAIR(obj)->car); + Visit (&PAIR(obj)->cdr); + break; + + case T_Vector: + for (n = 0, m = VECTOR(obj)->size; n < m; n++ ) + Visit (&VECTOR(obj)->data[n]); + break; + + case T_Compound: + Visit (&COMPOUND(obj)->closure); + Visit (&COMPOUND(obj)->env); + Visit (&COMPOUND(obj)->name); + break; + + case T_Control_Point: + (CONTROL(obj)->delta) += CONTROL(obj)->reloc; + +#ifdef USE_ALLOCA + Visit_GC_List (CONTROL(obj)->gclist, CONTROL(obj)->delta); +#else + Visit (&CONTROL(obj)->gcsave); +#endif + Visit_Wind (CONTROL(obj)->firstwind, + (CONTROL(obj)->delta) ); + + Visit (&CONTROL(obj)->env); + break; + + case T_Promise: + Visit (&PROMISE(obj)->env); + Visit (&PROMISE(obj)->thunk); + break; + + case T_Port: + Visit (&PORT(obj)->name); + break; + + case T_Autoload: + Visit (&AUTOLOAD(obj)->files); + Visit (&AUTOLOAD(obj)->env); + break; + + case T_Macro: + Visit (&MACRO(obj)->body); + Visit (&MACRO(obj)->name); + break; + + default: + if (Types[t].visit) + (Types[t].visit) (&obj, Visit); + } + cp += (len - 1); + } +} + + +/* rescan all pages remembered by the RegisterPage function. */ + +static void RescanPages () { + register Object *cp; + register int i; + int pages = rescanpages; + + rescanpages = 0; + for (i = 0; i < pages; i++) { + cp = PAGE_TO_OBJ (rescan[i]); +#ifdef ALIGN_8BYTE + ScanPage (cp + 1, cp + PAGEWORDS); +#else + ScanPage (cp, cp + PAGEWORDS); +#endif + } +} + +static int ScanCluster (addr) gcptr_t addr; { + register pageno_t page, lastpage; + pageno_t npages; + int n = 0; + + scanning = 1; + DetermineCluster (&addr, &n); + npages = n; + scanfirst = (Object *)addr; + scanlast = (Object *)(addr + (npages << pp_shift) - sizeof (Object)); + UnprotectCluster ((gcptr_t)scanfirst, (int)npages); + + rescan_cluster: + lastpage = ADDR_TO_PAGE ((gcptr_t)scanlast); + for (page = ADDR_TO_PAGE ((gcptr_t)scanfirst); page <= lastpage; page++) { + if (STABLE (page) && type[page] == OBJECTPAGE) { + scanpointer = PAGE_TO_OBJ (page); +#ifdef ALIGN_8BYTE + ScanPage (scanpointer + 1, scanpointer + PAGEWORDS); +#else + ScanPage (scanpointer, scanpointer + PAGEWORDS); +#endif + } + } + + while (rescanpages) { + if (allscan) { + allscan = 0; + goto rescan_cluster; + } else + RescanPages (); + } + + scanfirst = (Object *)0; + scanlast = (Object *)0; + scanning = 0; + ReprotectDirty (); + + return (npages); /* return number of scanned pages */ +} + + +static int Scanner (npages) pageno_t npages; { + register gcptr_t addr, lastaddr; + pageno_t spages; + pageno_t scanned = 0; + + while (npages > 0 && protected_pages) { + lastaddr = PAGE_TO_ADDR (lastpage); + for (addr = PAGE_TO_ADDR(firstpage); addr < lastaddr && npages > 0; + addr += bytes_per_pp) { + + if (IS_PROTECTED (addr)) { + if (space[ADDR_TO_PAGE (addr)] == UNALLOCATED_PAGE) + Panic ("Scanner: found incorrect heap page"); + spages = ScanCluster (addr); + scanned += spages; + npages -= spages; + } + } + } + + scanfirst = (Object *)0; + scanlast = scanfirst; + + return (scanned); +} + +#ifdef HAS_MPROTECT +/* the following function handles a page fault. If the fault was caused + * by the mutator and incremental collection is enabled, this will result + * in scanning the physical page the fault occured on. + */ + +#ifdef SIGSEGV_SIGCONTEXT + +static void PagefaultHandler (sig, code, scp) struct sigcontext *scp; { + char *addr = (char *)(scp->sc_badvaddr); + +#else +#ifdef SIGSEGV_AIX + +static void PagefaultHandler (sig, code, scp) struct sigcontext *scp; { + char *addr = (char *)scp->sc_jmpbuf.jmp_context.except[3]; + /* + * Or should that be .jmp_context.o_vaddr? + */ + +#else +#ifdef SIGSEGV_SIGINFO + +static void PagefaultHandler (sig, sip, ucp) siginfo_t *sip; ucontext_t *ucp; { + char *addr; + +#else +#ifdef SIGSEGV_ARG4 + +static void PagefaultHandler (sig, code, scp, addr) struct sigcontext *scp; + char *addr; { + +#else +#ifdef SIGSEGV_HPUX + +static void PagefaultHandler (sig, code, scp) struct sigcontext *scp; { + +#else +# include "HAS_MPROTECT defined, but missing SIGSEGV_xxx" +#endif +#endif +#endif +#endif +#endif + + pageno_t page; + gcptr_t ppage; + char *errmsg = 0; + +#ifdef SIGSEGV_AIX + if ((char *)scp->sc_jmpbuf.jmp_context.except[0] != addr) + Panic ("except"); +#endif + +#ifdef SIGSEGV_SIGINFO + if (sip == 0) + Fatal_Error ("SIGSEGV handler got called with zero siginfo_t"); + addr = sip->si_addr; +#endif + +#ifdef SIGSEGV_HPUX + char *addr; + + if (scp == 0) + Fatal_Error ("SIGSEGV handler got called with zero sigcontext"); + addr = (char *)scp->sc_sl.sl_ss.ss_cr21; +#endif + + ppage = PTR_TO_PPADDR(addr); + page = ADDR_TO_PAGE((gcptr_t)addr); + + if (!inc_collection) + errmsg = "SIGSEGV signal received"; + else if (current_space == forward_space) + errmsg = "SIGSEGV signal received while not garbage collecting"; + else if (page < firstpage || page > lastpage) + errmsg = "SIGSEV signal received; address outside of heap"; + if (errmsg) { + fprintf (stderr, "\n[%s]\n", errmsg); + abort (); + } + + GC_In_Progress = 1; + (void)ScanCluster (ppage); + GC_In_Progress = 0; +#ifdef SIGSEGV_AIX + InstallHandler (); +#endif + return; +} + +InstallHandler () { +#ifdef SIGSEGV_SIGINFO + struct sigaction sact; + sigset_t mask; + + sact.sa_handler = (void (*)())PagefaultHandler; + sigemptyset (&mask); + sact.sa_mask = mask; + sact.sa_flags = SA_SIGINFO; + if (sigaction (SIGSEGV, &sact, 0) == -1) { + perror ("sigaction"); exit (1); + } +#else + (void)signal (SIGSEGV, (void (*)())PagefaultHandler); +#endif +} +#endif + +static void TerminateGC () { + int save_force_total; + + forward_space = current_space; + previous_space = current_space; + + if (protected_pages) + Panic ("TerminateGC: protected pages after collection"); + + allocated_pages = current_pages + forwarded_pages; + current_pages = 0; + + if (forward_free) { + MAKE_HEADER (*forward_freep, forward_free, T_Freespace); + forward_free = 0; + } + forward_freep = (Object *)0; + + Call_After_GC(); + GC_In_Progress = 0; + Enable_Interrupts; + + if (Var_Is_True (V_Garbage_Collect_Notifyp) && !GC_Debug) { + int foo = percent - HEAPPERCENT (allocated_pages); + Object bar; + + bar = Make_Integer (foo); + if (!incomplete_msg) + Format (Standard_Output_Port, "[", 1, 0, (Object *)0); + + if (foo >= 0) + Format (Standard_Output_Port, "~s% reclaimed]~%", 16, 1, &bar); + else + Format (Standard_Output_Port, "finished]~%", 11, 0, (Object *)0); + (void)fflush (stdout); + incomplete_msg = 0; + } + + if (PERCENT (allocated_pages, old_logical_pages) >= tuneable_force_total) { + PromoteStableQueue (); + save_force_total = tuneable_force_total; + tuneable_force_total = 100; + if (inc_collection) + P_Collect_Incremental (); + else + P_Collect (); + tuneable_force_total = save_force_total; + if (HEAPPERCENT (allocated_pages) >= tuneable_newly_expand) + /* return value should not be ignore here: */ + (void)ExpandHeap ("after full collection"); + } +} + + +static void Finish_Collection () { + register gcptr_t addr; + + do { + for (addr = PAGE_TO_ADDR(firstpage); + addr < PAGE_TO_ADDR(lastpage); + addr += bytes_per_pp) { + + if (IS_PROTECTED (addr)) { + (void)ScanCluster (addr); + if (protected_pages == 0) TerminateGC (); + } + } + } while (protected_pages); + + return; +} + + +static void General_Collect (initiate) { + pageno_t fpage, free_fpages, i; + pageno_t page; + pageno_t fregion_pages; + Object obj; + + if (!Interpreter_Initialized) + Fatal_Error ("Out of heap space (increase heap size)"); + + if (current_space != forward_space && !inc_collection) { + Format (Standard_Output_Port, "GC while GC in progress~%", + 25, 0, (Object*)0); + return; + } + + /* Call all user-registered functions to be executed just before GC. */ + + Disable_Interrupts; + GC_In_Progress = 1; + Call_Before_GC(); + percent = HEAPPERCENT (allocated_pages); + old_logical_pages = logical_pages; + + if (Var_Is_True (V_Garbage_Collect_Notifyp) && !GC_Debug) { + if (initiate) { + Format (Standard_Output_Port, "[Garbage collecting...]~%", + 25, 0, (Object *)0); + incomplete_msg = 0; + } else { + Format (Standard_Output_Port, "[Garbage collecting... ", + 23, 0, (Object *)0); + incomplete_msg = 1; + } + (void)fflush (stdout); + } + + if (GC_Debug) { + printf ("."); (void)fflush (stdout); + } + + /* discard any remaining portion of the current heap page */ + + if (current_free) { + MAKE_HEADER (*current_freep, current_free, T_Freespace); + current_free = 0; + } + + /* partition regions for forwarded and newly-allocated objects. Then + * advance the current free pointer so that - if possible - there will + * be RESERVEDPAGES free heap pages in the forward region. + */ + + forward_freepage = current_freepage; + last_forward_freepage = forward_freepage; + + current_freep = PAGE_TO_OBJ (current_freepage); + forward_freep = current_freep; + + fpage = forward_freepage; + free_fpages = 0; + fregion_pages = logical_pages / tuneable_forward_region; + + for (i = 0; free_fpages <= fregion_pages && i < spanning_pages; i++) { + if (space[fpage] != current_space && !STABLE (fpage)) + free_fpages++; + fpage = next (fpage); + } + current_freep = (Object *)PHYSPAGE (fpage); + SET(obj, 0, current_freep); + current_freepage = OBJ_TO_PAGE (obj); + + /* advance spaces. Then forward all objects directly accessible + * via the global GC lists and the WIND list. + */ + + current_pages = 0; + forward_space = current_space + 1; + current_space = current_space + 2; + + Visit_GC_List (Global_GC_Obj, 0); + Visit_GC_List (GC_List, 0); + Visit_Wind (First_Wind, 0); + + /* If collecting in a non-incremental manner, scan all heap pages which + * have been protected, else check whether to expand the heap because + * the stable set has grown too big. + */ + + page = stable_queue; + while (page != (pageno_t)-1) { + ProtectCluster (PHYSPAGE (page), 0); + page = link[page]; + } + + if (!initiate) { + Finish_Collection (); + } else + if (HEAPPERCENT (forwarded_pages) > tuneable_force_expand) + /* return value should not be ignored here: */ + (void)ExpandHeap ("large stable set"); + + GC_In_Progress = 0; + return; +} + + +Object P_Collect_Incremental () { + /* if already collecting, scan a few pages and return */ + + if (!inc_collection) { + if (current_space == forward_space) + Primitive_Error ("incremental garbage collection not enabled"); + else { + inc_collection = 1; + Finish_Collection (); + inc_collection = 0; + return (True); + } + } else { + if (current_space != forward_space) { + (void)Scanner ((pageno_t)1); + GC_In_Progress = 0; + if (protected_pages == 0) + TerminateGC (); + return (protected_pages ? False : True); + } else { + General_Collect (1); + return (False); + } + } + /*NOTREACHED*/ +} + +Object P_Collect () { + /* Check the inc_collection flag. If an incremental GC is in + * progress and the flag has been changed to false, finish + * the collection. + */ + + if (!inc_collection && current_space != forward_space) { + inc_collection = 1; + Finish_Collection (); + inc_collection = 0; + return (Void); + } + + if (current_space != forward_space) { + Finish_Collection (); + return (Void); + } else { + General_Collect (0); + return (Void); + } +} + +Generational_GC_Finalize () { + if (current_space != forward_space) + Finish_Collection (); +} + +Generational_GC_Reinitialize () { +#ifdef HAS_MPROTECT + InstallHandler (); +#endif +} + + +Object Internal_GC_Status (strat, flags) { + Object list, cell; + GC_Node; + + list = Cons (Sym_Generational_GC, Null); + GC_Link (list); + switch (strat) { + default: /* query or stop-and-copy */ +#ifdef HAS_MPROTECT + if (inc_collection) { + cell = Cons (Sym_Incremental_GC, Null); + (void)P_Set_Cdr (list, cell); + } +#endif + break; + case GC_STRAT_GEN: + if (flags == GC_FLAGS_INCR) { +#ifdef HAS_MPROTECT + inc_collection = 1; + cell = Cons (Sym_Incremental_GC, Null); + (void)P_Set_Cdr (list, cell); +#endif + } else inc_collection = 0; + break; + } + GC_Unlink; + return (list); +} diff --git a/src/heap-sc.c b/src/heap-sc.c new file mode 100644 index 0000000..d9388d7 --- /dev/null +++ b/src/heap-sc.c @@ -0,0 +1,242 @@ +/* Stop-and-copy garbage collector + */ + +extern void *sbrk(); + +#define Recursive_Visit(p) {\ + register Object *pp = p;\ + if (Stack_Size () > Max_Stack)\ + Fatal_Error("stack overflow during GC (increase stack limit)");\ + if (Types[TYPE(*pp)].haspointer) Visit (pp);\ +} + +char *Heap_Start, + *Hp, /* First free byte */ + *Heap_End, /* Points behind free bytes */ + *Free_Start, /* Start of free area */ + *Free_End; /* Points behind free area */ + +static char *To; + +Make_Heap (size) { + register unsigned k = 1024 * size; + register unsigned s = 2 * k; + + if ((Hp = Heap_Start = (char *)sbrk (s)) == (char *)-1) + Fatal_Error ("cannot allocate heap (%u KBytes)", 2*size); + Heap_End = Heap_Start + k; + Free_Start = Heap_End; + Free_End = Free_Start + k; +} + +Object Alloc_Object (size, type, konst) { + register char *p = Hp; + Object ret; + + if (GC_Debug) { + (void)P_Collect (); + p = Hp; + } + ALIGN(p); + if (p + size > Heap_End) { + (void)P_Collect (); + p = Hp; + ALIGN(p); + if (p + size > Heap_End - HEAP_MARGIN) + Uncatchable_Error ("Out of heap space"); + } + Hp = p + size; + *(Object *)p = Null; + SET(ret, type, p); + if (konst) + SETCONST(ret); + return ret; +} + +Object P_Collect () { + register char *tmp; + register msg = 0; + Object a[2]; + + if (!Interpreter_Initialized) + Fatal_Error ("heap too small (increase heap size)"); + if (GC_In_Progress) + Fatal_Error ("GC while GC in progress"); + Disable_Interrupts; + GC_In_Progress = 1; + Call_Before_GC (); + if (GC_Debug) { + printf ("."); (void)fflush (stdout); + } else if (Var_Is_True (V_Garbage_Collect_Notifyp)) { + msg++; + Format (Standard_Output_Port, "[Garbage collecting... ", 23, 0, + (Object *)0); + (void)fflush (stdout); + } + To = Free_Start; + Visit_GC_List (Global_GC_Obj, 0); + Visit_GC_List (GC_List, 0); + Visit_Wind (First_Wind, 0); + Hp = To; + tmp = Heap_Start; Heap_Start = Free_Start; Free_Start = tmp; + tmp = Heap_End; Heap_End = Free_End; Free_End = tmp; + if (!GC_Debug) { + if (msg) { + a[0] = Make_Integer ((Hp-Heap_Start) / 1024); + a[1] = Make_Integer ((Heap_End-Heap_Start) / 1024); + Format (Standard_Output_Port, "~sK of ~sK]~%", 13, 2, a); + } + } + Call_After_GC (); + GC_In_Progress = 0; + Enable_Interrupts; + return Void; +} + +Visit (p) register Object *p; { + register Object *tag; + register t, size, reloc; + +again: + t = TYPE(*p); + if (!Types[t].haspointer) + return; + tag = (Object *)POINTER(*p); + if ((char *)tag >= Free_Start && (char *)tag < Free_End) + return; + if (TYPE(*tag) == T_Broken_Heart) { + SETPOINTER(*p, POINTER(*tag)); + return; + } + ALIGN(To); + switch (t) { + case T_Bignum: + size = sizeof (struct S_Bignum) - sizeof (gran_t) + + BIGNUM(*p)->size * sizeof (gran_t); + bcopy ((char *)tag, To, size); + break; + case T_Flonum: + size = sizeof (struct S_Flonum); + *(struct S_Flonum *)To = *(struct S_Flonum *)tag; + break; + case T_Symbol: + size = sizeof (struct S_Symbol); + *(struct S_Symbol *)To = *(struct S_Symbol *)tag; + break; + case T_Pair: + case T_Environment: + size = sizeof (struct S_Pair); + *(struct S_Pair *)To = *(struct S_Pair *)tag; + break; + case T_String: + size = sizeof (struct S_String) + STRING(*p)->size - 1; + bcopy ((char *)tag, To, size); + break; + case T_Vector: + size = sizeof (struct S_Vector) + (VECTOR(*p)->size - 1) * + sizeof (Object); + bcopy ((char *)tag, To, size); + break; + case T_Primitive: + size = sizeof (struct S_Primitive); + *(struct S_Primitive *)To = *(struct S_Primitive *)tag; + break; + case T_Compound: + size = sizeof (struct S_Compound); + *(struct S_Compound *)To = *(struct S_Compound *)tag; + break; + case T_Control_Point: + size = sizeof (struct S_Control) + CONTROL(*p)->size - 1; + reloc = To - (char *)tag; + bcopy ((char *)tag, To, size); + break; + case T_Promise: + size = sizeof (struct S_Promise); + *(struct S_Promise *)To = *(struct S_Promise *)tag; + break; + case T_Port: + size = sizeof (struct S_Port); + *(struct S_Port *)To = *(struct S_Port *)tag; + break; + case T_Autoload: + size = sizeof (struct S_Autoload); + *(struct S_Autoload *)To = *(struct S_Autoload *)tag; + break; + case T_Macro: + size = sizeof (struct S_Macro); + *(struct S_Macro *)To = *(struct S_Macro *)tag; + break; + case T_Broken_Heart: + Panic ("broken heart in GC"); + default: + if (t < 0 || t >= Num_Types) + Panic ("bad type in GC"); + if (Types[t].size == NOFUNC) + size = Types[t].const_size; + else + size = (Types[t].size)(*p); + bcopy ((char *)tag, To, size); + } + SETPOINTER(*p, To); + SET(*tag, T_Broken_Heart, To); + To += size; + if (To > Free_End) + Panic ("free exhausted in GC"); + switch (t) { + case T_Symbol: + Recursive_Visit (&SYMBOL(*p)->next); + Recursive_Visit (&SYMBOL(*p)->name); + Recursive_Visit (&SYMBOL(*p)->value); + p = &SYMBOL(*p)->plist; + goto again; + case T_Pair: + case T_Environment: + Recursive_Visit (&PAIR(*p)->car); + p = &PAIR(*p)->cdr; + goto again; + case T_Vector: { + register i, n; + for (i = 0, n = VECTOR(*p)->size; i < n; i++) + Recursive_Visit (&VECTOR(*p)->data[i]); + break; + } + case T_Compound: + Recursive_Visit (&COMPOUND(*p)->closure); + Recursive_Visit (&COMPOUND(*p)->env); + p = &COMPOUND(*p)->name; + goto again; + case T_Control_Point: + Recursive_Visit (&CONTROL(*p)->memsave); + CONTROL(*p)->delta += reloc; +#ifdef USE_ALLOCA + Visit_GC_List (CONTROL(*p)->gclist, CONTROL(*p)->delta); +#else + Recursive_Visit (&CONTROL(*p)->gcsave); +#endif + Visit_Wind (CONTROL(*p)->firstwind, CONTROL(*p)->delta); + p = &CONTROL(*p)->env; + goto again; + case T_Promise: + Recursive_Visit (&PROMISE(*p)->env); + p = &PROMISE(*p)->thunk; + goto again; + case T_Port: + p = &PORT(*p)->name; + goto again; + case T_Autoload: + Recursive_Visit (&AUTOLOAD(*p)->files); + p = &AUTOLOAD(*p)->env; + goto again; + case T_Macro: + Recursive_Visit (&MACRO(*p)->body); + p = &MACRO(*p)->name; + goto again; + default: + if (Types[t].visit) + (Types[t].visit)(p, Visit); + } +} + +Object Internal_GC_Status (strat, flags) { + return (Cons (Sym_Stop_And_Copy_GC, Null)); +} diff --git a/src/heap.c b/src/heap.c new file mode 100644 index 0000000..72ff94d --- /dev/null +++ b/src/heap.c @@ -0,0 +1,125 @@ +/* Code that is common to both garbage collectors. + */ + +#include "kernel.h" + +int GC_In_Progress; + +GCNODE *GC_List; + +static GCNODE *Global_GC_Obj; + +static FUNCT *Before_GC_Funcs, *After_GC_Funcs; + +static Object V_Garbage_Collect_Notifyp; +static Object Sym_Stop_And_Copy_GC, Sym_Generational_GC, Sym_Incremental_GC; + +Init_Heap () { + Define_Variable (&V_Garbage_Collect_Notifyp, "garbage-collect-notify?", + True); + + Define_Symbol (&Sym_Stop_And_Copy_GC, "stop-and-copy"); + Define_Symbol (&Sym_Generational_GC, "generational"); + Define_Symbol (&Sym_Incremental_GC, "incremental"); +} + +Register_Before_GC (f) void (*f)(); { + FUNCT *p; + + p = (FUNCT *)Safe_Malloc (sizeof (*p)); + p->func = f; + p->next = Before_GC_Funcs; + Before_GC_Funcs = p; +} + +Call_Before_GC () { + FUNCT *p; + + for (p = Before_GC_Funcs; p; p = p->next) + p->func(); +} + +Register_After_GC (f) void (*f)(); { + FUNCT *p; + + p = (FUNCT *)Safe_Malloc (sizeof (*p)); + p->func = f; + p->next = After_GC_Funcs; + After_GC_Funcs = p; +} + +Call_After_GC () { + FUNCT *p; + + for (p = After_GC_Funcs; p; p = p->next) + p->func(); +} + +Visit_GC_List (list, delta) GCNODE *list; { + register GCNODE *gp, *p; + register n; + register Object *vec; + + for (gp = list; gp; gp = p->next) { + p = (GCNODE *)NORM(gp); + if (p->gclen <= 0) { + Visit ((Object *)NORM(p->gcobj)); + } else { + vec = (Object *)NORM(p->gcobj); + for (n = 0; n < p->gclen-1; n++) + Visit (&vec[n]); + } + } +} + +Visit_Wind (list, delta) WIND *list; unsigned delta; { + register WIND *wp, *p; + + for (wp = list; wp; wp = p->next) { + p = (WIND *)NORM(wp); + Visit (&p->inout); + } +} + +Func_Global_GC_Link (x) Object *x; { + GCNODE *p; + + p = (GCNODE *)Safe_Malloc (sizeof (*p)); + p->gclen = 0; + p->gcobj = x; + p->next = Global_GC_Obj; + Global_GC_Obj = p; +} + +#define GC_STRAT_SAC 1 +#define GC_STRAT_GEN 2 + +#define GC_FLAGS_INCR 1 + +Object Internal_GC_Status(); + +Object P_Garbage_Collect_Status (argc, argv) Object* argv; { + int strat = 0, flags = 0; + + if (argc > 0) { + Check_Type (argv[0], T_Symbol); + if (EQ (argv[0], Sym_Stop_And_Copy_GC)) + strat = GC_STRAT_SAC; + else if (EQ (argv[0], Sym_Generational_GC)) + strat = GC_STRAT_GEN; + else Primitive_Error ("unknown GC strategy: ~s", argv[0]); + if (argc == 2) { + Check_Type (argv[1], T_Symbol); + if (EQ (argv[1], Sym_Incremental_GC)) + flags = GC_FLAGS_INCR; + else Primitive_Error ("unknown GC strategy: ~s", argv[1]); + } + } + return Internal_GC_Status (strat, flags); +} + +#ifdef GENERATIONAL_GC +# include "heap-gen.c" +#else +# include "heap-sc.c" +#endif diff --git a/src/io.c b/src/io.c new file mode 100644 index 0000000..8dd410c --- /dev/null +++ b/src/io.c @@ -0,0 +1,362 @@ +/* Ports and I/O primitives. + */ + +#include "kernel.h" + +#include +#include +#include +#include +#include + +#ifdef PATHCONF_PATH_MAX +# include +#endif + +extern int errno; +extern char *getenv(); + +Object Curr_Input_Port, Curr_Output_Port; +Object Standard_Input_Port, Standard_Output_Port; + +Init_Io () { + Standard_Input_Port = Make_Port (P_INPUT, stdin, Make_String ("stdin", 5)); + Standard_Output_Port = Make_Port (0, stdout, Make_String ("stdout", 6)); + Curr_Input_Port = Standard_Input_Port; + Curr_Output_Port = Standard_Output_Port; + Global_GC_Link (Standard_Input_Port); + Global_GC_Link (Standard_Output_Port); + Global_GC_Link (Curr_Input_Port); + Global_GC_Link (Curr_Output_Port); +} + +Reset_IO (destructive) { + Discard_Input (Curr_Input_Port); + if (destructive) + Discard_Output (Curr_Output_Port); + else + Flush_Output (Curr_Output_Port); + Curr_Input_Port = Standard_Input_Port; + Curr_Output_Port = Standard_Output_Port; +} + +Object Make_Port (flags, f, name) FILE *f; Object name; { + Object port; + extern fclose(); + GC_Node; + + GC_Link (name); + port = Alloc_Object (sizeof (struct S_Port), T_Port, 0); + PORT(port)->flags = flags|P_OPEN; + PORT(port)->file = f; + PORT(port)->name = name; + PORT(port)->ptr = 0; + PORT(port)->lno = 1; + PORT(port)->closefun = fclose; + GC_Unlink; + return port; +} + +Object P_Port_File_Name (p) Object p; { + Check_Type (p, T_Port); + return (PORT(p)->flags & P_STRING) ? False : PORT(p)->name; +} + +Object P_Port_Line_Number (p) Object p; { + Check_Type (p, T_Port); + return Make_Unsigned (PORT(p)->lno); +} + +Object P_Eof_Objectp (x) Object x; { + return TYPE(x) == T_End_Of_File ? True : False; +} + +Object P_Current_Input_Port () { return Curr_Input_Port; } + +Object P_Current_Output_Port () { return Curr_Output_Port; } + +Object P_Input_Portp (x) Object x; { + return TYPE(x) == T_Port && IS_INPUT(x) ? True : False; +} + +Object P_Output_Portp (x) Object x; { + return TYPE(x) == T_Port && IS_OUTPUT(x) ? True : False; +} + +int Path_Max () { +#ifdef PATH_MAX /* POSIX */ + return PATH_MAX; +#else +#ifdef MAXPATHLEN /* 4.3 BSD */ + return MAXPATHLEN; +#else +#ifdef PATHCONF_PATH_MAX + static r; + if (r == 0) { + if ((r = pathconf ("/", _PC_PATH_MAX)) == -1) + r = 1024; + r++; + } + return r; +#else + return 1024; +#endif +#endif +#endif +} + +Object Get_File_Name (name) Object name; { + register len; + + if (TYPE(name) == T_Symbol) + name = SYMBOL(name)->name; + else if (TYPE(name) != T_String) + Wrong_Type_Combination (name, "string or symbol"); + if ((len = STRING(name)->size) > Path_Max () || len == 0) + Primitive_Error ("invalid file name"); + return name; +} + +char *Internal_Tilde_Expand (s, dirp) register char *s, **dirp; { + register char *p; + struct passwd *pw, *getpwnam(); + + if (*s++ != '~') + return 0; + for (p = s; *p && *p != '/'; p++) + ; + if (*p == '/') *p++ = 0; + if (*s == '\0') { + if ((*dirp = getenv ("HOME")) == 0) + *dirp = ""; + } else { + if ((pw = getpwnam (s)) == 0) + Primitive_Error ("unknown user: ~a", Make_String (s, strlen (s))); + *dirp = pw->pw_dir; + } + return p; +} + +Object General_File_Operation (s, op) Object s; register op; { + register char *r; + Object ret, fn; + Alloca_Begin; + + fn = Get_File_Name (s); + Get_Strsym_Stack (fn, r); + switch (op) { + case 0: { + char *p, *dir; + if ((p = Internal_Tilde_Expand (r, &dir)) == 0) { + Alloca_End; + return s; + } + Alloca (r, char*, strlen (dir) + 1 + strlen (p) + 1); + sprintf (r, "%s/%s", dir, p); + ret = Make_String (r, strlen (r)); + Alloca_End; + return ret; + } + case 1: { + struct stat st; + /* Doesn't make much sense to check for errno != ENOENT here: + */ + ret = stat (r, &st) == 0 ? True : False; + Alloca_End; + return ret; + }} + /*NOTREACHED*/ +} + +Object P_Tilde_Expand (s) Object s; { + return General_File_Operation (s, 0); +} + +Object P_File_Existsp (s) Object s; { + return General_File_Operation (s, 1); +} + +Close_All_Files () { + Terminate_Type (T_Port); +} + +Object Terminate_File (port) Object port; { + (void)(PORT(port)->closefun) (PORT(port)->file); + PORT(port)->flags &= ~P_OPEN; + return Void; +} + +Object Open_File (name, flags, err) char *name; { + register FILE *f; + char *dir, *p; + Object fn, port; + struct stat st; + Alloca_Begin; + + if (p = Internal_Tilde_Expand (name, &dir)) { + Alloca (name, char*, strlen (dir) + 1 + strlen (p) + 1); + sprintf (name, "%s/%s", dir, p); + } + if (!err && stat (name, &st) == -1 && + (errno == ENOENT || errno == ENOTDIR)) { + Alloca_End; + return Null; + } + switch (flags & (P_INPUT|P_BIDIR)) { + case 0: p = "w"; break; + case P_INPUT: p = "r"; break; + default: p = "r+"; break; + } + fn = Make_String (name, strlen (name)); + Disable_Interrupts; + if ((f = fopen (name, p)) == NULL) { + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("~s: ~E", fn); + } + port = Make_Port (flags, f, fn); + Register_Object (port, (GENERIC)0, Terminate_File, 0); + Enable_Interrupts; + Alloca_End; + return port; +} + +Object General_Open_File (name, flags, path) Object name, path; { + Object port, pref; + char *buf = 0; + register char *fn; + register plen, len, blen = 0, gotpath = 0; + Alloca_Begin; + + name = Get_File_Name (name); + len = STRING(name)->size; + fn = STRING(name)->data; + if (fn[0] != '/' && fn[0] != '~') { + for ( ; TYPE(path) == T_Pair; path = Cdr (path)) { + pref = Car (path); + if (TYPE(pref) == T_Symbol) + pref = SYMBOL(pref)->name; + if (TYPE(pref) != T_String) + continue; + gotpath = 1; + if ((plen = STRING(pref)->size) > Path_Max () || plen == 0) + continue; + if (len + plen + 2 > blen) { + blen = len + plen + 2; + Alloca (buf, char*, blen); + } + bcopy (STRING(pref)->data, buf, plen); + if (buf[plen-1] != '/') + buf[plen++] = '/'; + bcopy (fn, buf+plen, len); + buf[len+plen] = '\0'; + port = Open_File (buf, flags, 0); + /* No GC has been taken place in Open_File() if it returns Null. + */ + if (!Nullp (port)) { + Alloca_End; + return port; + } + } + } + if (gotpath) + Primitive_Error ("file ~s not found", name); + if (len + 1 > blen) + Alloca (buf, char*, len + 1); + bcopy (fn, buf, len); + buf[len] = '\0'; + port = Open_File (buf, flags, 1); + Alloca_End; + return port; +} + +Object P_Open_Input_File (name) Object name; { + return General_Open_File (name, P_INPUT, Null); +} + +Object P_Open_Output_File (name) Object name; { + return General_Open_File (name, 0, Null); +} + +Object P_Open_Input_Output_File (name) Object name; { + return General_Open_File (name, P_BIDIR, Null); +} + +Object General_Close_Port (port) Object port; { + register flags, err = 0; + FILE *f; + + Check_Type (port, T_Port); + flags = PORT(port)->flags; + if (!(flags & P_OPEN) || (flags & P_STRING)) + return Void; + f = PORT(port)->file; + if (f == stdin || f == stdout) + return Void; + if ((PORT(port)->closefun) (f) == EOF) { + Saved_Errno = errno; /* errno valid here? */ + err++; + } + PORT(port)->flags &= ~P_OPEN; + Deregister_Object (port); + if (err) + Primitive_Error ("write error on ~s: ~E", port); + return Void; +} + +Object P_Close_Input_Port (port) Object port; { + return General_Close_Port (port); +} + +Object P_Close_Output_Port (port) Object port;{ + return General_Close_Port (port); +} + +#define General_With(prim,curr,flags) Object prim (name, thunk)\ + Object name, thunk; {\ + Object old, ret;\ + GC_Node2;\ +\ + Check_Procedure (thunk);\ + old = curr;\ + GC_Link2 (thunk, old);\ + curr = General_Open_File (name, flags, Null);\ + ret = Funcall (thunk, Null, 0);\ + (void)General_Close_Port (curr);\ + GC_Unlink;\ + curr = old;\ + return ret;\ +} + +General_With (P_With_Input_From_File, Curr_Input_Port, P_INPUT) +General_With (P_With_Output_To_File, Curr_Output_Port, 0) + +Object General_Call_With (name, flags, proc) Object name, proc; { + Object port, ret; + GC_Node2; + + Check_Procedure (proc); + GC_Link2 (proc, port); + port = General_Open_File (name, flags, Null); + port = Cons (port, Null); + ret = Funcall (proc, port, 0); + (void)General_Close_Port (Car (port)); + GC_Unlink; + return ret; +} + +Object P_Call_With_Input_File (name, proc) Object name, proc; { + return General_Call_With (name, P_INPUT, proc); +} + +Object P_Call_With_Output_File (name, proc) Object name, proc; { + return General_Call_With (name, 0, proc); +} + +Object P_Open_Input_String (string) Object string; { + Check_Type (string, T_String); + return Make_Port (P_STRING|P_INPUT, (FILE *)0, string); +} + +Object P_Open_Output_String () { + return Make_Port (P_STRING, (FILE *)0, Make_String ((char *)0, 0)); +} diff --git a/src/list.c b/src/list.c new file mode 100644 index 0000000..f0f0f42 --- /dev/null +++ b/src/list.c @@ -0,0 +1,346 @@ +#include "kernel.h" + +Object Const_Cons (car, cdr) Object car, cdr; { + Object ret; + + ret = P_Cons (car, cdr); + SETCONST(ret); + return ret; +} + +Object P_Cons (car, cdr) Object car, cdr; { + Object cell; + GC_Node2; + +#ifdef GENERATIONAL_GC + GC_Link2 (car, cdr); + cell = Alloc_Object (sizeof (struct S_Pair), T_Pair, 0); + GC_Unlink; +#else + /* This is an optimization (it duplicates parts of Alloc_Object()): + */ + + register char *p; + + p = Hp; + ALIGN(p); + if (p + sizeof (struct S_Pair) <= Heap_End && !GC_Debug) { + Hp = p + sizeof (struct S_Pair); + SET(cell, T_Pair, (struct S_Pair *)p); + } else { + GC_Link2 (car, cdr); + cell = Alloc_Object (sizeof (struct S_Pair), T_Pair, 0); + GC_Unlink; + } +#endif + Car (cell) = car; + Cdr (cell) = cdr; + return cell; +} + +Object P_Car (x) Object x; { + Check_Type (x, T_Pair); + return Car (x); +} + +Object P_Cdr (x) Object x; { + Check_Type (x, T_Pair); + return Cdr (x); +} + +Object Cxr (x, pat, len) Object x; register char *pat; register len; { + Object ret; + + for (ret = x, pat += len; len > 0; len--) + switch (*--pat) { + case 'a': ret = P_Car (ret); break; + case 'd': ret = P_Cdr (ret); break; + default: Primitive_Error ("invalid pattern"); + } + return ret; +} + +Object P_Cddr (x) Object x; { return Cxr (x, "dd", 2); } +Object P_Cdar (x) Object x; { return Cxr (x, "da", 2); } +Object P_Cadr (x) Object x; { return Cxr (x, "ad", 2); } +Object P_Caar (x) Object x; { return Cxr (x, "aa", 2); } + +Object P_Cdddr (x) Object x; { return Cxr (x, "ddd", 3); } +Object P_Cddar (x) Object x; { return Cxr (x, "dda", 3); } +Object P_Cdadr (x) Object x; { return Cxr (x, "dad", 3); } +Object P_Cdaar (x) Object x; { return Cxr (x, "daa", 3); } +Object P_Caddr (x) Object x; { return Cxr (x, "add", 3); } +Object P_Cadar (x) Object x; { return Cxr (x, "ada", 3); } +Object P_Caadr (x) Object x; { return Cxr (x, "aad", 3); } +Object P_Caaar (x) Object x; { return Cxr (x, "aaa", 3); } + +Object P_Caaaar (x) Object x; { return Cxr (x, "aaaa", 4); } +Object P_Caaadr (x) Object x; { return Cxr (x, "aaad", 4); } +Object P_Caadar (x) Object x; { return Cxr (x, "aada", 4); } +Object P_Caaddr (x) Object x; { return Cxr (x, "aadd", 4); } +Object P_Cadaar (x) Object x; { return Cxr (x, "adaa", 4); } +Object P_Cadadr (x) Object x; { return Cxr (x, "adad", 4); } +Object P_Caddar (x) Object x; { return Cxr (x, "adda", 4); } +Object P_Cadddr (x) Object x; { return Cxr (x, "addd", 4); } +Object P_Cdaaar (x) Object x; { return Cxr (x, "daaa", 4); } +Object P_Cdaadr (x) Object x; { return Cxr (x, "daad", 4); } +Object P_Cdadar (x) Object x; { return Cxr (x, "dada", 4); } +Object P_Cdaddr (x) Object x; { return Cxr (x, "dadd", 4); } +Object P_Cddaar (x) Object x; { return Cxr (x, "ddaa", 4); } +Object P_Cddadr (x) Object x; { return Cxr (x, "ddad", 4); } +Object P_Cdddar (x) Object x; { return Cxr (x, "ddda", 4); } +Object P_Cddddr (x) Object x; { return Cxr (x, "dddd", 4); } + +Object P_Cxr (x, pat) Object x, pat; { + Check_List (x); + if (TYPE(pat) == T_Symbol) + pat = SYMBOL(pat)->name; + else if (TYPE(pat) != T_String) + Wrong_Type_Combination (pat, "string or symbol"); + return Cxr (x, STRING(pat)->data, STRING(pat)->size); +} + +Object P_Nullp (x) Object x; { + return Nullp (x) ? True : False; +} + +Object P_Pairp (x) Object x; { + return TYPE(x) == T_Pair ? True : False; +} + +Object P_Listp (x) Object x; { + Object s; + register f; + + for (s = x, f = 0; !Nullp (x); f ^= 1) { + if (TYPE(x) != T_Pair) + return False; + x = Cdr (x); + if (EQ(x, s)) + return False; + if (f) s = Cdr (s); + } + return True; +} + +Object P_Set_Car (x, new) Object x, new; { + Check_Type (x, T_Pair); + Check_Mutable (x); + Car (x) = new; + return new; +} + +Object P_Set_Cdr (x, new) Object x, new; { + Check_Type (x, T_Pair); + Check_Mutable (x); + Cdr (x) = new; + return new; +} + +Object General_Member (key, list, comp) Object key, list; register comp; { + register r; + + for ( ; !Nullp (list); list = Cdr (list)) { + Check_List (list); + if (comp == 0) + r = EQ(Car (list), key); + else if (comp == 1) + r = Eqv (Car (list), key); + else + r = Equal (Car (list), key); + if (r) return list; + } + return False; +} + +Object P_Memq (key, list) Object key, list; { + return General_Member (key, list, 0); +} + +Object P_Memv (key, list) Object key, list; { + return General_Member (key, list, 1); +} + +Object P_Member (key, list) Object key, list; { + return General_Member (key, list, 2); +} + +Object General_Assoc (key, alist, comp) Object key, alist; register comp; { + Object elem; + register r; + + for ( ; !Nullp (alist); alist = Cdr (alist)) { + Check_List (alist); + elem = Car (alist); + if (TYPE(elem) != T_Pair) + continue; + if (comp == 0) + r = EQ(Car (elem), key); + else if (comp == 1) + r = Eqv (Car (elem), key); + else + r = Equal (Car (elem), key); + if (r) return elem; + } + return False; +} + +Object P_Assq (key, alist) Object key, alist; { + return General_Assoc (key, alist, 0); +} + +Object P_Assv (key, alist) Object key, alist; { + return General_Assoc (key, alist, 1); +} + +Object P_Assoc (key, alist) Object key, alist; { + return General_Assoc (key, alist, 2); +} + +Fast_Length (list) Object list; { + Object tail; + register i; + + for (i = 0, tail = list; TYPE(tail) == T_Pair; tail = Cdr (tail), i++) + ; + return i; +} + +Object P_Length (list) Object list; { + Object tail; + register i; + + for (i = 0, tail = list; !Nullp (tail); tail = Cdr (tail), i++) + Check_List (tail); + return Make_Integer (i); +} + +Object P_Make_List (n, init) Object n, init; { + register len; + Object list; + GC_Node; + + if ((len = Get_Exact_Integer (n)) < 0) + Range_Error (n); + list = Null; + GC_Link (init); + while (len-- > 0) + list = Cons (init, list); + GC_Unlink; + return list; +} + +Object P_List (argc, argv) Object *argv; { + Object list, tail, cell; + GC_Node2; + + GC_Link2 (list, tail); + for (list = tail = Null; argc-- > 0; tail = cell) { + cell = Cons (*argv++, Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + } + GC_Unlink; + return list; +} + +Object P_Last_Pair (x) Object x; { + Check_Type (x, T_Pair); + for ( ; TYPE(Cdr (x)) == T_Pair; x = Cdr (x)) ; + return x; +} + +Object P_Append (argc, argv) Object *argv; { + Object list, last, tail, cell; + register i; + GC_Node3; + + list = last = Null; + GC_Link3 (list, last, tail); + for (i = 0; i < argc-1; i++) { + for (tail = argv[i]; !Nullp (tail); tail = Cdr (tail)) { + Check_List (tail); + cell = Cons (Car (tail), Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (last, cell); + last = cell; + } + } + if (argc) + if (Nullp (list)) + list = argv[i]; + else + (void)P_Set_Cdr (last, argv[i]); + GC_Unlink; + return list; +} + +Object P_Append_Set (argc, argv) Object *argv; { + register i, j; + + for (i = j = 0; i < argc; i++) + if (!Nullp (argv[i])) + argv[j++] = argv[i]; + if (j == 0) + return Null; + for (i = 0; i < j-1; i++) + (void)P_Set_Cdr (P_Last_Pair (argv[i]), argv[i+1]); + return *argv; +} + +Object P_Reverse (x) Object x; { + Object ret; + GC_Node; + + GC_Link (x); + for (ret = Null; !Nullp (x); x = Cdr (x)) { + Check_List (x); + ret = Cons (Car (x), ret); + } + GC_Unlink; + return ret; +} + +Object P_Reverse_Set (x) Object x; { + Object prev, tail; + + for (prev = Null; !Nullp (x); prev = x, x = tail) { + Check_List (x); + tail = Cdr (x); + (void)P_Set_Cdr (x, prev); + } + return prev; +} + +Object P_List_Tail (x, num) Object x, num; { + register n; + + for (n = Get_Exact_Integer (num); n > 0 && !Nullp (x); n--, x = P_Cdr (x)) + ; + return x; +} + +Object P_List_Ref (x, num) Object x, num; { + return P_Car (P_List_Tail (x, num)); +} + +Object Copy_List (x) Object x; { + Object car, cdr; + GC_Node3; + + if (TYPE(x) == T_Pair) { + if (Stack_Size () > Max_Stack) + Uncatchable_Error ("Out of stack space"); + car = cdr = Null; + GC_Link3 (x, car, cdr); + car = Copy_List (Car (x)); + cdr = Copy_List (Cdr (x)); + x = Cons (car, cdr); + GC_Unlink; + } + return x; +} diff --git a/src/load-dl.c b/src/load-dl.c new file mode 100644 index 0000000..a4565bd --- /dev/null +++ b/src/load-dl.c @@ -0,0 +1,134 @@ +#include +#include + +extern char *strrchr(); +extern char *getenv(); + +Dlopen_File (fn) char *fn; { + void *handle; + SYM *sp; + + if (Verb_Load) + printf ("[dlopen %s]\n", fn); + if ((handle = dlopen (fn, RTLD_NOW)) == 0) { + char *errstr = dlerror (); + Primitive_Error ("dlopen failed:~%~s", + Make_String (errstr, strlen (errstr))); + } + if (The_Symbols) + Free_Symbols (The_Symbols); + The_Symbols = Open_File_And_Snarf_Symbols (fn); + /* + * dlsym() may fail for symbols not exported by object file; + * this can be safely ignored. + */ + for (sp = The_Symbols->first; sp; sp = sp->next) + sp->value = (unsigned long)dlsym (handle, sp->name); + Call_Initializers (The_Symbols, 0, PR_CONSTRUCTOR); + Call_Initializers (The_Symbols, 0, PR_EXTENSION); +} + +static char *tempname; +static char *tmpdir; +static tmplen; +static Seq_Num; + +char *Temp_Name (seq) int seq; { + if (!tempname) { + if (!(tmpdir = getenv ("TMPDIR"))) + tmpdir = "/tmp"; + tempname = Safe_Malloc (tmplen = strlen (tmpdir) + 20); + sprintf (tempname, "%s/ldXXXXXX", tmpdir); + (void)mktemp (tempname); + strcat (tempname, "."); + } + sprintf (strrchr (tempname, '.'), ".%d", seq); + return tempname; +} + +void Fork_Load () { + int i; + char *newtemp; + + if (!tempname) + return; + Disable_Interrupts; + newtemp = Safe_Malloc (tmplen); + sprintf (newtemp, "%s/ldXXXXXX", tmpdir); + (void)mktemp (newtemp); + strcat (newtemp, "."); + for (i = 0; i < Seq_Num; i++) { + sprintf (strrchr (newtemp, '.'), ".%d", i); + (void)link (Temp_Name (i), newtemp); + } + free (tempname); + tempname = newtemp; + Enable_Interrupts; +} + +Load_Object (names) Object names; { + Object port, tail, fullnames, libs; + char *lp, *buf, *outfile; + int len, liblen, i; + GC_Node3; + Alloca_Begin; + + port = tail = fullnames = Null; + GC_Link3 (port, tail, fullnames); + for (len = 0, tail = names; !Nullp (tail); tail = Cdr (tail)) { + port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); + fullnames = Cons (PORT(port)->name, fullnames); + len += STRING(Car (fullnames))->size + 1; + (void)P_Close_Input_Port (port); + } + GC_Unlink; + + libs = Var_Get (V_Load_Libraries); + if (TYPE(libs) == T_String) { + liblen = STRING(libs)->size; + lp = STRING(libs)->data; + } else + liblen = 0; + + Disable_Interrupts; + + buf = Temp_Name (Seq_Num); + Seq_Num++; + Alloca (outfile, char*, tmplen); + strcpy (outfile, buf); + Alloca (buf, char*, len + liblen + Seq_Num*tmplen + 100); + sprintf (buf, "%s %s -o %s ", LD_NAME, LDFLAGS_SHARED, outfile); + + for (tail = fullnames; !Nullp (tail); tail = Cdr (tail)) { + register struct S_String *str = STRING(Car (tail)); + strncat (buf, str->data, str->size); + strcat (buf, " "); + } + for (i = 0; i < Seq_Num-1; i++) { + strcat (buf, Temp_Name (i)); + strcat (buf, " "); + } + strncat (buf, lp, liblen); + + if (Verb_Load) + printf ("[%s]\n", buf); + if (system (buf) != 0) { + Seq_Num--; + (void)unlink (outfile); + Primitive_Error ("system linker failed"); + } + Dlopen_File (outfile); + Enable_Interrupts; + Alloca_End; +} + +void Finit_Load () { + int i; + + for (i = 0; i < Seq_Num; i++) + (void)unlink (Temp_Name (i)); + /* + * The linker in SGI Irix 5 produces this file: + */ + (void)unlink ("so_locations"); +} diff --git a/src/load-ld.c b/src/load-ld.c new file mode 100644 index 0000000..9cfe838 --- /dev/null +++ b/src/load-ld.c @@ -0,0 +1,168 @@ +#include AOUT_H +#include +#include +#include + +#ifndef O_BINARY +# define O_BINARY 0 +#endif + +#ifdef ECOFF +# ifdef CACHECTL_H +# include CACHECTL_H +# endif + +struct headers { + struct filehdr fhdr; + struct aouthdr aout; + struct scnhdr section[3]; +}; +#endif + +extern void *sbrk(); +extern char *getenv(); + +static char *Loader_Output; +static char *tmpdir; + +Load_Object (names) Object names; { +#ifdef ECOFF + struct headers hdr; +#else + struct exec hdr; +#endif + register char *brk, *obrk, *lp, *li; + char *buf; + register n, f, len, liblen; + Object port, tail, fullnames, libs; + FILE *fp; + GC_Node3; + Alloca_Begin; + + li = Loader_Input; + if (!li) + li = A_Out_Name; + if (!Loader_Output) { + if (!(tmpdir = getenv ("TMPDIR"))) + tmpdir = "/tmp"; + Loader_Output = Safe_Malloc (strlen (tmpdir) + 20); + } + sprintf (Loader_Output, "%s/ldXXXXXX", tmpdir); + (void)mktemp (Loader_Output); + + port = tail = fullnames = Null; + GC_Link3 (port, tail, fullnames); + for (len = 0, tail = names; !Nullp (tail); tail = Cdr (tail)) { + port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); + fullnames = Cons (PORT(port)->name, fullnames); + len += STRING(Car (fullnames))->size + 1; + (void)P_Close_Input_Port (port); + } + GC_Unlink; + + libs = Var_Get (V_Load_Libraries); + if (TYPE(libs) == T_String) { + liblen = STRING(libs)->size; + lp = STRING(libs)->data; + } else { + liblen = 3; lp = "-lc"; + } + + Alloca (buf, char*, strlen (A_Out_Name) + len + liblen + 100); + + obrk = brk = (char *)sbrk (0); + brk = (char *)((int)brk + 7 & ~7); + +#if defined(hp9000s300) || defined(__hp9000s300) || defined(__hp9000s300__) + sprintf (buf, "%s -N %s -A %s -R %x -o %s ", +#else + sprintf (buf, "%s -N %s -A %s -T %x -o %s ", +#endif + LD_NAME, INC_LDFLAGS, li, (unsigned)brk, Loader_Output); + + for (tail = fullnames; !Nullp (tail); tail = Cdr (tail)) { + register struct S_String *str = STRING(Car (tail)); + strncat (buf, str->data, str->size); + strcat (buf, " "); + } + strncat (buf, lp, liblen); + + if (Verb_Load) + printf ("[%s]\n", buf); + if (system (buf) != 0) { + (void)unlink (Loader_Output); + Primitive_Error ("system linker failed"); + } + Disable_Interrupts; /* To ensure that f gets closed */ + if ((f = open (Loader_Output, O_RDONLY|O_BINARY)) == -1) { + (void)unlink (Loader_Output); + Primitive_Error ("cannot open tempfile"); + } + if (Loader_Input) + (void)unlink (Loader_Input); + else + Loader_Input = Safe_Malloc (strlen (tmpdir) + 20); + strcpy (Loader_Input, Loader_Output); + if (read (f, (char *)&hdr, sizeof (hdr)) != sizeof (hdr)) { +err: + close (f); + Primitive_Error ("corrupt tempfile (`ld' is broken)"); + } +#ifdef ECOFF + n = hdr.aout.tsize + hdr.aout.dsize + hdr.aout.bsize; +#else + n = hdr.a_text + hdr.a_data + hdr.a_bss; +#endif + if ((char *)sbrk (n + brk-obrk) == (char *)-1) { + close (f); + Primitive_Error ("not enough memory to load object file"); + } + bzero (brk, n); +#ifdef ECOFF + n -= hdr.aout.bsize; + (void)lseek (f, (off_t)hdr.section[0].s_scnptr, 0); +#else + n -= hdr.a_bss; +#endif + if (read (f, brk, n) != n) + goto err; + if ((fp = fdopen (f, O_BINARY ? "rb" : "r")) == NULL) { + close (f); + Primitive_Error ("cannot fdopen object file"); + } + if (The_Symbols) + Free_Symbols (The_Symbols); + The_Symbols = Snarf_Symbols (fp, &hdr); + (void)fclose (fp); +#if defined(ECOFF) && defined(CACHECTL_H) + if (cacheflush (brk, n, BCACHE) == -1) { + extern int errno; + Saved_Errno = errno; + Primitive_Error ("cacheflush failed: ~E"); + } +#endif + Call_Initializers (The_Symbols, brk, PR_CONSTRUCTOR); + Call_Initializers (The_Symbols, brk, PR_EXTENSION); + Enable_Interrupts; + Alloca_End; +} + +void Finit_Load () { + if (Loader_Input) + (void)unlink (Loader_Input); +} + +void Fork_Load () { + char *newlink; + + if (Loader_Input) { + Disable_Interrupts; + newlink = Safe_Malloc (strlen (tmpdir) + 20); + sprintf (newlink, "%s/ldXXXXXX", tmpdir); + (void)mktemp (newlink); + (void)link (Loader_Input, newlink); + free (Loader_Input); + Loader_Input = newlink; + Enable_Interrupts; + } +} diff --git a/src/load-rld.c b/src/load-rld.c new file mode 100644 index 0000000..ab7cae6 --- /dev/null +++ b/src/load-rld.c @@ -0,0 +1,76 @@ +#include + +Load_Object (names) Object names; { + long retval; + struct mach_header *hdr; + char **filenames, *libs; + NXStream *err_stream; + register i, n; + Object port, tail, fullnames; + extern char *strtok(); + GC_Node3; + Alloca_Begin; + + port = tail = fullnames = Null; + GC_Link3 (port, tail, fullnames); + for (n = 0, tail = names; !Nullp (tail); n++, tail = Cdr (tail)) { + port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); + fullnames = Cons (PORT(port)->name, fullnames); + (void)P_Close_Input_Port (port); + } + GC_Unlink; + + libs = ""; + tail = Var_Get (V_Load_Libraries); + if (TYPE(tail) == T_String) + Get_Strsym_Stack (tail, libs); + + Alloca (filenames, char**, (n+1 + strlen (libs)/2) * sizeof (char *)); + for (i = 0; i < n; i++, fullnames = Cdr (fullnames)) { + Object s; + + s = Car (fullnames); + Get_Strsym_Stack (s, filenames[i]); + } + + /* Append the load-libraries to the end of the list of filenames + * to be passed to rld_load: + */ + for ( ; (filenames[i] = strtok (libs, " \t")) != 0; i++, libs = 0) + ; + if (Verb_Load) { + printf ("[rld_load: "); + for (i = 0; filenames[i]; i++) printf ("%s ", filenames[i]); + printf ("]\n"); + } + + Disable_Interrupts; + /* Construct a stream for error logging: + */ + if ((err_stream = NXOpenFile (fileno (stderr), NX_WRITEONLY)) == 0) + Primitive_Error ("NXOpenFile failed"); + + retval = rld_load (err_stream, /* report error messages here */ + &hdr, /* return header address here */ + filenames, /* load these */ + "/dev/null"); /* doesn't work if NULL?! */ + NXClose (err_stream); + if (retval != 1) + Primitive_Error ("rld_load() failed"); + + /* Grab the symbol table from the just-loaded file: + */ + if (The_Symbols) + Free_Symbols (The_Symbols); + The_Symbols = Snarf_Symbols (hdr); + Call_Initializers (The_Symbols, 0, PR_CONSTRUCTOR); + Call_Initializers (The_Symbols, 0, PR_EXTENSION); + Enable_Interrupts; + Alloca_End; +} + +void Finit_Load () { +} + +void Fork_Load () { +} diff --git a/src/load-shl.c b/src/load-shl.c new file mode 100644 index 0000000..256606a --- /dev/null +++ b/src/load-shl.c @@ -0,0 +1,82 @@ +#include +#include + +extern int errno; + +static void Load_Them (names) Object names; { + char *fn; + shl_t handle; + SYM *sp; + static struct obj_loaded { + struct obj_loaded *next; + char *name; + } *loaded, *lp; + GC_Node; + Alloca_Begin; + + GC_Link(names); + for ( ; !Nullp (names); names = Cdr (names)) { + Get_Strsym_Stack (Car (names), fn); + for (lp = loaded; lp; lp = lp->next) + if (strcmp (lp->name, fn) == 0) break; + if (lp) continue; + lp = (struct obj_loaded *)Safe_Malloc (sizeof (*lp)); + lp->name = strdup (fn); + lp->next = loaded; + loaded = lp; + if (Verb_Load) + printf ("[shl_load %s]\n", fn); + if ((handle = shl_load (fn, BIND_IMMEDIATE|BIND_VERBOSE, 0L)) == 0) { + Saved_Errno = errno; + Primitive_Error ("shl_load of ~s failed: ~E", Car (names)); + } + if (The_Symbols) + Free_Symbols (The_Symbols); + The_Symbols = Open_File_And_Snarf_Symbols (fn); + for (sp = The_Symbols->first; sp; sp = sp->next) + if (shl_findsym (&handle, sp->name, TYPE_UNDEFINED, &sp->value)) { + Saved_Errno = errno; + Primitive_Error ("~s: shl_findsym on ~s failed: ~E", + Car (names), + Make_String (sp->name, strlen (sp->name))); + } + Call_Initializers (The_Symbols, 0, PR_CONSTRUCTOR); + Call_Initializers (The_Symbols, 0, PR_EXTENSION); + } + GC_Unlink; + Alloca_End; +} + +Load_Object (names) Object names; { + Object port, tail, fullnames, str; + char *p, *libs = ""; + GC_Node3; + Alloca_Begin; + + port = tail = fullnames = Null; + GC_Link3 (port, tail, fullnames); + for (tail = names; !Nullp (tail); tail = Cdr (tail)) { + port = General_Open_File (Car (tail), P_INPUT, Var_Get (V_Load_Path)); + fullnames = Cons (PORT(port)->name, fullnames); + (void)P_Close_Input_Port (port); + } + tail = Var_Get (V_Load_Libraries); + if (TYPE(tail) == T_String) + Get_Strsym_Stack (tail, libs); + Disable_Interrupts; + for (tail = Null; (p = strtok (libs, " \t")) != 0; libs = 0) { + str = Make_String (p, strlen (p)); + tail = Cons (str, tail); + } + Load_Them (tail); + Load_Them (fullnames); + Enable_Interrupts; + GC_Unlink; + Alloca_End; +} + +void Finit_Load () { +} + +void Fork_Load () { +} diff --git a/src/load.c b/src/load.c new file mode 100644 index 0000000..f0f91b6 --- /dev/null +++ b/src/load.c @@ -0,0 +1,163 @@ +#include "kernel.h" + +Object V_Load_Path, V_Load_Noisilyp, V_Load_Libraries; + +#ifdef CAN_LOAD_OBJ +# define Default_Load_Libraries LOAD_LIBRARIES +#else +# define Default_Load_Libraries "" +#endif + +char *Loader_Input; /* tmp file name used by load.xx.c */ + +#ifdef CAN_LOAD_OBJ + void Fork_Load(); +#endif + +#ifdef USE_LD +# include "load-ld.c" +#else +#ifdef USE_RLD +# include "load-rld.c" +#else +#ifdef USE_SHL +# include "load-shl.c" +#else +#ifdef USE_DLOPEN +# include "load-dl.c" +#endif +#endif +#endif +#endif + +Init_Load () { + Define_Variable (&V_Load_Path, "load-path", + Cons (Make_String (".", 1), + Cons (Make_String (SCM_DIR, sizeof (SCM_DIR) - 1), + Cons (Make_String (OBJ_DIR, sizeof (OBJ_DIR) - 1), Null)))); + Define_Variable (&V_Load_Noisilyp, "load-noisily?", False); + Define_Variable (&V_Load_Libraries, "load-libraries", + Make_String (Default_Load_Libraries, sizeof Default_Load_Libraries-1)); +#ifdef CAN_LOAD_OBJ + Register_Onfork (Fork_Load); +#endif +} + +Init_Loadpath (s) char *s; { /* No GC possible here */ + register char *p; + Object path; + + path = Null; + if (s[0] == '\0') + return; + while (1) { + for (p = s; *p && *p != ':'; p++) + ; + path = Cons (Make_String (s, p-s), path); + if (*p == '\0') + break; + s = ++p; + } + Var_Set (V_Load_Path, P_Reverse (path)); +} + +Is_O_File (name) Object name; { + register char *p; + register struct S_String *str; + + if (TYPE(name) == T_Symbol) + name = SYMBOL(name)->name; + str = STRING(name); + p = str->data + str->size; + return str->size >= 2 && *--p == 'o' && *--p == '.'; +} + +void Check_Loadarg (x) Object x; { + Object tail; + register t = TYPE(x); + + if (t == T_Symbol || t == T_String) + return; + if (t != T_Pair) + Wrong_Type_Combination (x, "string, symbol, or list"); + for (tail = x; !Nullp (tail); tail = Cdr (tail)) { + Object f; + + f = Car (tail); + if (TYPE(f) != T_Symbol && TYPE(f) != T_String) + Wrong_Type_Combination (f, "string or symbol"); + if (!Is_O_File (f)) + Primitive_Error ("~s: not an object file", f); + } +} + +Object General_Load (what, env) Object what, env; { + Object oldenv; + GC_Node; + + Check_Type (env, T_Environment); + oldenv = The_Environment; + GC_Link (oldenv); + Switch_Environment (env); + Check_Loadarg (what); + if (TYPE(what) == T_Pair) +#ifdef CAN_LOAD_OBJ + Load_Object (what) +#endif + ; + else if (Is_O_File (what)) +#ifdef CAN_LOAD_OBJ + Load_Object (Cons (what, Null)) +#endif + ; + else + Load_Source (what); + Switch_Environment (oldenv); + GC_Unlink; + return Void; +} + +Object P_Load (argc, argv) Object *argv; { + return General_Load (argv[0], argc == 1 ? The_Environment : argv[1]); +} + +void Load_Source_Port (port) Object port; { + Object val; + GC_Node; + TC_Prolog; + + GC_Link (port); + while (1) { + val = General_Read (port, 1); + if (TYPE(val) == T_End_Of_File) + break; + TC_Disable; + val = Eval (val); + TC_Enable; + if (Var_Is_True (V_Load_Noisilyp)) { + Print (val); + (void)P_Newline (0, (Object *)0); + } + } + GC_Unlink; +} + +Load_Source (name) Object name; { + Object port; + GC_Node; + + port = General_Open_File (name, P_INPUT, Var_Get (V_Load_Path)); + GC_Link (port); + Load_Source_Port (port); + (void)P_Close_Input_Port (port); + GC_Unlink; +} + +/* Interface to P_Load() for use by applications. + */ +void Load_File (name) char *name; { + Object arg; + + arg = Make_String(name, strlen(name)); + (void)P_Load(1, &arg); +} diff --git a/src/main.c b/src/main.c new file mode 100644 index 0000000..10c801b --- /dev/null +++ b/src/main.c @@ -0,0 +1,391 @@ +#include "kernel.h" + +#include +#include +#include + +#ifndef MAX_STACK_SIZE +# include +# include +#endif + +#ifdef FIND_AOUT +# ifdef INCLUDE_UNISTD_H +# include +# else +# include +# endif +#endif + +extern char *getenv(); + +char *stkbase; +int Stack_Grows_Down; +int Max_Stack; +int Interpreter_Initialized; +int GC_Debug = 0; +int Case_Insensitive; +int Verb_Load, Verb_Init; + +char **Argv; +int Argc, First_Arg; + +#ifdef FIND_AOUT +char *A_Out_Name; +char *Find_Executable(); +#endif + +#if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS) +SYMTAB *The_Symbols; +#endif + +void Exit_Handler () { +#if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS) + Call_Finalizers (); +#endif +#ifdef CAN_LOAD_OBJ + Finit_Load (); +#endif +} + +#ifndef ATEXIT +/* Hack: __GNUC_MINOR__ was introduced together with __attribute__ */ +#ifdef __GNUC_MINOR__ +extern void _exit() __attribute__ ((noreturn)); +#endif +#ifndef PROFILING +void exit (n) { + Exit_Handler (); + _cleanup (); + _exit (n); +} +#endif +#endif + +#ifdef CAN_DUMP +int Was_Dumped; +char *Brk_On_Dump; +#endif + + +/* dump currently does not work for applications using Elk_Init(). + * The reason is that in this case the INITIAL_STK_OFFSET which + * compensates for differences in argv[] in the original/dumped a.out + * is not in effect (see comment below). + * This cannot be fixed without changing Elk_Init() and its use in + * an incompatible way. + */ +Check_If_Dump_Works () { +#ifdef NOMAIN + Primitive_Error ("not yet supported for standalone applications"); +#endif +} + + +#ifdef NOMAIN + +void Elk_Init (ac, av, init_objects, toplevel) char **av, *toplevel; { + +#else + +main (ac, av) char **av; { + +#endif + +/* To avoid that the stack copying code overwrites argv if a dumped + * copy of the interpreter is invoked with more arguments than the + * original a.out, move the stack base INITIAL_STK_OFFSET bytes down. + * The call to bzero() is there to prevent the optimizer from removing + * the array. + */ +#ifdef CAN_DUMP + char unused[INITIAL_STK_OFFSET]; +#endif + char *initfile, *loadfile = 0, *loadpath = 0; + int debug = 0, heap = HEAP_SIZE; + Object file; + struct stat st; + extern int errno; + char foo; +#ifdef NOMAIN +# define foo (av[0][0]) +#endif + +#ifdef CAN_DUMP + bzero (unused, 1); /* see comment above */ +#endif + if (ac == 0) { + av[0] = "Elk"; ac = 1; + } + Get_Stack_Limit (); + +#ifdef FIND_AOUT + A_Out_Name = Find_Executable (av[0]); +#endif + + Argc = ac; Argv = av; + First_Arg = 1; +#ifdef CAN_DUMP + if (Was_Dumped) { + /* Check if beginning of stack has moved by a large amount. + * This is the case, for instance, on a Sun-4m when the + * interpreter was dumped on a Sun-4c and vice versa. + */ + if (abs (stkbase - &foo) > INITIAL_STK_OFFSET) { + fprintf (stderr, +"Can't restart dumped interpreter from a different machine architecture\n"); + fprintf (stderr, +" (Stack delta = %d bytes).\n", stkbase - &foo); + exit (1); + } + /* Check if program break must be reset. + */ + if (Brk_On_Dump && (char *)brk (Brk_On_Dump) == (char *)-1) { + perror ("brk"); exit (1); + } +#if defined(HP9K) && defined(CAN_DUMP) && defined(HPSHLIB) + Restore_Shared_Data (); +#endif +#ifdef GENERATIONAL_GC + Generational_GC_Reinitialize (); +#endif + Loader_Input = 0; + Install_Intr_Handler (); + (void)Funcall_Control_Point (Dump_Control_Point, Arg_True, 0); + /*NOTREACHED*/ + } +#endif + + for ( ; First_Arg < ac; First_Arg++) { + if (strcmp (av[First_Arg], "-g") == 0) { + debug = 1; + } else if (strcmp (av[First_Arg], "-i") == 0) { + Case_Insensitive = 1; + } else if (strcmp (av[First_Arg], "-v") == 0) { + if (++First_Arg == ac) + Usage (); + if (strcmp (av[First_Arg], "load") == 0) + Verb_Load = 1; + else if (strcmp (av[First_Arg], "init") == 0) + Verb_Init = 1; + else Usage (); + } else if (strcmp (av[First_Arg], "-h") == 0) { + if (++First_Arg == ac) + Usage (); + if ((heap = atoi (av[First_Arg])) <= 0) { + fprintf (stderr, "Heap size must be a positive number.\n"); + exit (1); + } + } else if (strcmp (av[First_Arg], "-l") == 0) { + if (++First_Arg == ac || loadfile) + Usage (); + loadfile = av[First_Arg]; + } else if (strcmp (av[First_Arg], "-p") == 0) { + if (++First_Arg == ac || loadpath) + Usage (); + loadpath = av[First_Arg]; + } else if (strcmp (av[First_Arg], "--") == 0) { + First_Arg++; + break; + } else if (av[First_Arg][0] == '-') { + Usage (); + } else { + break; + } + } + + stkbase = &foo; + Stack_Grows_Down = Check_Stack_Grows_Down (); + ALIGN(stkbase); + Make_Heap (heap); + Init_Everything (); +#ifdef ATEXIT + if (atexit (Exit_Handler) != 0) + Fatal_Error ("atexit returned non-zero value"); +#endif +#ifdef INIT_OBJECTS +#ifdef NOMAIN + if (init_objects) { + Set_Error_Tag ("init-objects"); + The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name); + Call_Initializers (The_Symbols, (char *)0, PR_EXTENSION); + } +#else + Set_Error_Tag ("init-objects"); + The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name); + Call_Initializers (The_Symbols, (char *)0, PR_CONSTRUCTOR); + Call_Initializers (The_Symbols, (char *)0, PR_EXTENSION); +#endif +#endif + if (loadpath || (loadpath = getenv (LOADPATH_ENV))) + Init_Loadpath (loadpath); + + /* The following code is sort of a hack. initscheme.scm should not + * be resolved against load-path. However, the .scm-files may not + * have been installed yet (note that the interpreter is already + * used in the "make" process). + * Solution: if initscheme.scm hasn't been installed yet, do search + * the load-path, so that -p can be used. + */ + Set_Error_Tag ("scheme-init"); + initfile = Safe_Malloc (strlen (SCM_DIR) + 1 + sizeof (INITFILE) + 1); + sprintf (initfile, "%s/%s", SCM_DIR, INITFILE); + if (stat (initfile, &st) == -1 && errno == ENOENT) + file = Make_String (INITFILE, sizeof(INITFILE)-1); + else + file = Make_String (initfile, strlen (initfile)); + free (initfile); + (void)General_Load (file, The_Environment); + + Install_Intr_Handler (); + + Set_Error_Tag ("top-level"); +#ifdef NOMAIN + if ((loadfile = toplevel) == 0) { + Interpreter_Initialized = 1; + GC_Debug = debug; + return; + } +#endif + if (loadfile == 0) + loadfile = "toplevel.scm"; + file = Make_String (loadfile, strlen (loadfile)); + Interpreter_Initialized = 1; + GC_Debug = debug; + if (loadfile[0] == '-' && loadfile[1] == '\0') + Load_Source_Port (Standard_Input_Port); + else + (void)General_Load (file, The_Environment); +#ifndef NOMAIN + return 0; +#endif +} + +static char *Usage_Msg[] = { + "Options:", + " [-l filename] Load file instead of standard toplevel", + " [-l -] Load from standard input", + " [-h heapsize] Heap size in KBytes", + " [-p loadpath] Initialize load-path (colon-list of directories)", + " [-g] Enable GC-debugging", + " [-i] Case-insensitive symbols", + " [-v type] Be verbose. \"type\" controls what to print:", + " load linker command when loading object file", + " init names of extension [f]init functions when \ +called", + " [--] End options and begin arguments", + 0 }; + +Usage () { + char **p; + + fprintf (stderr, "Usage: %s [options] [arguments]\n", Argv[0]); + for (p = Usage_Msg; *p; p++) + fprintf (stderr, "%s\n", *p); + exit (1); +} + +Init_Everything () { + Init_Type (); + Init_Cstring (); + Init_String (); + Init_Symbol (); + Init_Env (); + Init_Error (); + Init_Exception (); + Init_Io (); + Init_Prim (); + Init_Math (); + Init_Print (); + Init_Auto (); + Init_Heap (); + Init_Load (); + Init_Proc (); + Init_Special (); + Init_Read (); + Init_Features (); + Init_Terminate (); +#ifdef CAN_DUMP + Init_Dump (); +#endif +} + +Get_Stack_Limit () { +#ifdef MAX_STACK_SIZE + Max_Stack = MAX_STACK_SIZE; +#else + struct rlimit rl; + + if (getrlimit (RLIMIT_STACK, &rl) == -1) { + perror ("getrlimit"); + exit (1); + } + Max_Stack = rl.rlim_cur; +#endif + Max_Stack -= STACK_MARGIN; +} + +#ifdef FIND_AOUT +Executable (fn) char *fn; { + struct stat s; + + return stat (fn, &s) != -1 && (s.st_mode & S_IFMT) == S_IFREG + && access (fn, X_OK) != -1; +} + +char *Find_Executable (fn) char *fn; { + char *path, *dir, *getenv(); + static char buf[1025]; /* Can't use Path_Max or Safe_Malloc here */ + register char *p; + + for (p = fn; *p; p++) { + if (*p == '/') { + if (Executable (fn)) + return fn; + else + Fatal_Error ("%s is not executable", fn); + } + } + if ((path = getenv ("PATH")) == 0) + path = ":/usr/ucb:/bin:/usr/bin"; + dir = path; + do { + p = buf; + while (*dir && *dir != ':') + *p++ = *dir++; + if (*dir) + ++dir; + if (p > buf) + *p++ = '/'; + strcpy (p, fn); + if (Executable (buf)) + return buf; + } while (*dir); + if (dir > path && dir[-1] == ':' && Executable (fn)) + return fn; + Fatal_Error ("cannot find pathname of %s", fn); + /*NOTREACHED*/ +} +#endif + +Object P_Command_Line_Args () { + Object ret, tail; + register i; + GC_Node2; + + ret = tail = P_Make_List (Make_Integer (Argc-First_Arg), Null); + GC_Link2 (ret, tail); + for (i = First_Arg; i < Argc; i++, tail = Cdr (tail)) { + Object a; + + a = Make_String (Argv[i], strlen (Argv[i])); + Car (tail) = a; + } + GC_Unlink; + return ret; +} + +Object P_Exit (argc, argv) Object *argv; { + exit (argc == 0 ? 0 : Get_Unsigned (argv[0])); + /*NOTREACHED*/ +} diff --git a/src/malloc.c b/src/malloc.c new file mode 100644 index 0000000..d64804e --- /dev/null +++ b/src/malloc.c @@ -0,0 +1,31 @@ +#include "kernel.h" + +extern char *malloc(), *realloc(); + +char *Safe_Malloc (size) unsigned size; { + char *ret; + + Disable_Interrupts; + if ((ret = malloc (size)) == 0) + if (Interpreter_Initialized) + Primitive_Error ("not enough memory to malloc ~s bytes", + Make_Integer (size)); + else + Fatal_Error ("not enough memory to malloc %u bytes", size); + Enable_Interrupts; + return ret; +} + +char *Safe_Realloc (ptr, size) char *ptr; unsigned size; { + char *ret; + + Disable_Interrupts; + if ((ret = ptr ? realloc (ptr, size) : malloc (size)) == 0) + if (Interpreter_Initialized) + Primitive_Error ("not enough memory to malloc ~s bytes", + Make_Integer (size)); + else + Fatal_Error ("not enough memory to malloc %u bytes", size); + Enable_Interrupts; + return ret; +} diff --git a/src/math.c b/src/math.c new file mode 100644 index 0000000..0acfa81 --- /dev/null +++ b/src/math.c @@ -0,0 +1,1066 @@ +/* Generic math functions. + */ + +#include +#include +#include + +#include "kernel.h" + +extern int errno; + +Object Generic_Multiply(), Generic_Divide(); + +Init_Math () { +#ifdef RANDOM + srandom (getpid ()); +#else + srand (getpid ()); +#endif +} + +Object Make_Integer (n) register n; { + Object num; + + SET(num, T_Fixnum, n); + return num; +} + +Object Make_Unsigned (n) register unsigned n; { + if (UFIXNUM_FITS(n)) + return Make_Integer (n); + else + return Unsigned_To_Bignum (n); +} + +Object Make_Long (n) register long n; { + if (n < 0 ? (n < (long)INT_MIN) : (n > (long)INT_MAX)) + return Long_To_Bignum (n); + else + return Make_Integer ((int)n); +} + +Object Make_Unsigned_Long (n) register unsigned long n; { + if ((n & ~((unsigned long)SIGNBIT-1)) == 0) + return Make_Integer ((int)n); + else + return Unsigned_Long_To_Bignum (n); +} + +Object Fixnum_To_String (x, radix) Object x; { + char buf[32]; + register char *p; + register n = FIXNUM(x), neg = 0; + + if (n == 0) + return Make_String ("0", 1); + if (n < 0) { + neg++; + n = -n; + } + p = buf+31; + *p = '\0'; + while (n > 0) { + *--p = '0' + n % radix; + if (*p > '9') + *p = 'A' + (*p - '9') - 1; + n /= radix; + } + if (neg) + *--p = '-'; + return Make_String (p, strlen (p)); +} + +char *Flonum_To_String (x) Object x; { + static char buf[32]; + char *p; + + sprintf (buf, "%.15g", FLONUM(x)->val); + for (p = buf; *p; p++) + if (*p == '.' || *p == 'e' || *p == 'N' || *p == 'i') + return buf; + *p++ = '.', *p++ = '0', *p++ = '\0'; + return buf; +} + +Object P_Number_To_String (argc, argv) Object *argv; { + int radix = 10; + Object x; + char *s; + + x = argv[0]; + if (argc == 2) { + radix = Get_Exact_Integer (argv[1]); + switch (radix) { + case 2: case 8: case 10: case 16: + break; + default: + Primitive_Error ("invalid radix: ~s", argv[1]); + } + } + Check_Number (x); + switch (TYPE(x)) { + case T_Fixnum: + return Fixnum_To_String (x, radix); + case T_Bignum: + return Bignum_To_String (x, radix); + case T_Flonum: + if (radix != 10) + Primitive_Error ("radix for reals must be 10"); /* bleah! */ + s = Flonum_To_String (x); + return Make_String (s, strlen (s)); + } + /*NOTREACHED*/ +} + +Get_Integer (x) Object x; { + double d; + int expo; + + switch (TYPE(x)) { + case T_Fixnum: + return FIXNUM(x); + case T_Bignum: + return Bignum_To_Integer (x); + case T_Flonum: + d = FLONUM(x)->val; + if (d != floor (d)) + Wrong_Type (x, T_Fixnum); + (void)frexp (d, &expo); + if (expo <= 8 * sizeof(int) - 1) + return d; + Primitive_Error ("integer out of range: ~s", x); + default: + Wrong_Type (x, T_Fixnum); + } + /*NOTREACHED*/ +} + +unsigned Get_Unsigned (x) Object x; { + double d; + int expo; + + switch (TYPE(x)) { + case T_Fixnum: + if (FIXNUM(x) < 0) + goto err; + return FIXNUM(x); + case T_Bignum: + return Bignum_To_Unsigned (x); + case T_Flonum: + d = FLONUM(x)->val; + if (d < 0) + goto err; + if (d != floor (d)) + Wrong_Type (x, T_Fixnum); + (void)frexp (d, &expo); + if (expo <= 8 * sizeof(int)) + return d; +err: + Primitive_Error ("integer out of range: ~s", x); + default: + Wrong_Type (x, T_Fixnum); + } + /*NOTREACHED*/ +} + +long Get_Long (x) Object x; { + double d; + int expo; + + switch (TYPE(x)) { + case T_Fixnum: + return FIXNUM(x); + case T_Bignum: + return Bignum_To_Long (x); + case T_Flonum: + d = FLONUM(x)->val; + if (d != floor (d)) + Wrong_Type (x, T_Fixnum); + (void)frexp (d, &expo); + if (expo <= 8 * sizeof(long) - 1) + return d; + Primitive_Error ("integer out of range: ~s", x); + default: + Wrong_Type (x, T_Fixnum); + } + /*NOTREACHED*/ +} + +unsigned long Get_Unsigned_Long (x) Object x; { + double d; + int expo; + + switch (TYPE(x)) { + case T_Fixnum: + if (FIXNUM(x) < 0) + goto err; + return (unsigned long)FIXNUM(x); + case T_Bignum: + return Bignum_To_Unsigned_Long (x); + case T_Flonum: + d = FLONUM(x)->val; + if (d < 0) + goto err; + if (d != floor (d)) + Wrong_Type (x, T_Fixnum); + (void)frexp (d, &expo); + if (expo <= 8 * sizeof(long)) + return d; +err: + Primitive_Error ("integer out of range: ~s", x); + default: + Wrong_Type (x, T_Fixnum); + } + /*NOTREACHED*/ +} + +Get_Exact_Integer (x) Object x; { + switch (TYPE(x)) { + case T_Fixnum: + return FIXNUM(x); + case T_Bignum: + return Bignum_To_Integer (x); + default: + Wrong_Type (x, T_Fixnum); + } + /*NOTREACHED*/ +} + +unsigned Get_Exact_Unsigned (x) Object x; { + switch (TYPE(x)) { + case T_Fixnum: + if (FIXNUM(x) < 0) + Primitive_Error ("integer out of range: ~s", x); + return FIXNUM(x); + case T_Bignum: + return Bignum_To_Unsigned (x); + default: + Wrong_Type (x, T_Fixnum); + } + /*NOTREACHED*/ +} + +long Get_Exact_Long (x) Object x; { + switch (TYPE(x)) { + case T_Fixnum: + return FIXNUM(x); + case T_Bignum: + return Bignum_To_Long (x); + default: + Wrong_Type (x, T_Fixnum); + } + /*NOTREACHED*/ +} + +unsigned long Get_Exact_Unsigned_Long (x) Object x; { + switch (TYPE(x)) { + case T_Fixnum: + if (FIXNUM(x) < 0) + Primitive_Error ("integer out of range: ~s", x); + return FIXNUM(x); + case T_Bignum: + return Bignum_To_Unsigned_Long (x); + default: + Wrong_Type (x, T_Fixnum); + } + /*NOTREACHED*/ +} + +Get_Index (n, obj) Object n, obj; { + register size, i; + + i = Get_Exact_Integer (n); + size = TYPE(obj) == T_Vector ? VECTOR(obj)->size : STRING(obj)->size; + if (i < 0 || i >= size) + Range_Error (n); + return i; +} + +Object Make_Flonum (d) double d; { + Object num; + + num = Alloc_Object (sizeof (struct S_Flonum), T_Flonum, 0); + FLONUM(num)->tag = Null; + FLONUM(num)->val = d; + return num; +} + +Object Make_Reduced_Flonum (d) double d; { + Object num; + int expo; + + if (floor (d) == d) { + if (d == 0) + return Zero; + (void)frexp (d, &expo); + if (expo <= FIXBITS-1) + return Make_Integer ((int)d); + } + num = Alloc_Object (sizeof (struct S_Flonum), T_Flonum, 0); + FLONUM(num)->tag = Null; + FLONUM(num)->val = d; + return num; +} + +Fixnum_Add (a, b, fits) int *fits; { + int ret = a + b; + + *fits = 1; + if (a > 0 && b > 0) { + if (ret < 0) *fits = 0; + } else if (a < 0 && b < 0) { + if (ret > 0) *fits = 0; + } + return ret; +} + +Fixnum_Sub (a, b, fits) int *fits; { + int ret = a - b; + + *fits = 1; + if (a < 0 && b > 0) { + if (ret > 0) *fits = 0; + } else if (a > 0 && b < 0) { + if (ret < 0) *fits = 0; + } + return ret; +} + +/* This function assumes 32bit integers. This doesn't really matter, + * because if the `*' primitive resorts to bignum multiplication, the + * resulting bignum gets reduced to a fixnum (if it fits) anyway. + * (This should be fixed, though...) + */ +Object Fixnum_Multiply (a, b) { + register unsigned aa = a; + register unsigned ab = b; + register unsigned prod, prod2; + register sign = 1; + if (a < 0) { + aa = -a; + sign = -1; + } + if (b < 0) { + ab = -b; + sign = -sign; + } + prod = (aa & 0xFFFF) * (ab & 0xFFFF); + if (aa & 0xFFFF0000) { + if (ab & 0xFFFF0000) + return Null; + prod2 = (aa >> 16) * ab; + } else { + prod2 = aa * (ab >> 16); + } + prod2 += prod >> 16; + prod &= 0xFFFF; + if (prod2 > (1 << (FIXBITS - 1 - 16)) - 1) { + if (sign == 1 || prod2 != (1 << (FIXBITS - 1 - 16)) || prod != 0) + return Null; + return Make_Integer (-(unsigned)SIGNBIT); + } + prod += prod2 << 16; + if (sign == -1) + prod = - prod; + return Make_Integer (prod); +} + +Object P_Integerp (x) Object x; { + double d; + + switch (TYPE(x)) { + case T_Fixnum: case T_Bignum: + return True; + case T_Flonum: + d = FLONUM(x)->val; + return d == floor(d) ? True : False; + } + return False; +} + +Object P_Rationalp (x) Object x; { + return P_Integerp (x); +} + +Object P_Realp (x) Object x; { + register t = TYPE(x); + return t == T_Flonum || t == T_Fixnum || t == T_Bignum ? True : False; +} + +Object P_Complexp (x) Object x; { + return P_Realp (x); +} + +Object P_Numberp (x) Object x; { + return P_Complexp (x); +} + +Object P_Exactp (n) Object n; { + Check_Number (n); + return TYPE(n) == T_Flonum ? False : True; +} + +Object P_Inexactp (n) Object n; { + Check_Number (n); + return TYPE(n) == T_Flonum ? True : False; +} + +Object P_Exact_To_Inexact (n) Object n; { + Check_Number (n); + switch (TYPE(n)) { + case T_Fixnum: + return Make_Flonum ((double)FIXNUM(n)); + case T_Flonum: + return n; + case T_Bignum: + return Make_Flonum (Bignum_To_Double (n)); + } + /*NOTREACHED*/ +} + +Object P_Inexact_To_Exact (n) Object n; { + double d; + int i; + + Check_Number (n); + switch (TYPE(n)) { + case T_Fixnum: + case T_Bignum: + return n; + case T_Flonum: + d = floor (FLONUM(n)->val + 0.5); + (void)frexp (d, &i); + return (i <= FIXBITS-1) ? Make_Integer ((int)d) : Double_To_Bignum (d); + } + /*NOTREACHED*/ +} + +#define General_Generic_Predicate(prim,op,bigop) Object prim (x) Object x; {\ + register ret;\ + Check_Number (x);\ + switch (TYPE(x)) {\ + case T_Flonum:\ + ret = FLONUM(x)->val op 0; break;\ + case T_Fixnum:\ + ret = FIXNUM(x) op 0; break;\ + case T_Bignum:\ + ret = bigop (x); break;\ + }\ + return ret ? True : False;\ +} + +General_Generic_Predicate (P_Zerop, ==, Bignum_Zero) +General_Generic_Predicate (P_Negativep, <, Bignum_Negative) +General_Generic_Predicate (P_Positivep, >, Bignum_Positive) + +Object P_Evenp (x) Object x; { + register ret; + double d; + + switch (TYPE(x)) { + case T_Fixnum: + ret = !(FIXNUM(x) & 1); break; + case T_Bignum: + ret = Bignum_Even (x); break; + case T_Flonum: + d = FLONUM(x)->val; + if (floor (d) == d) { + d /= 2; + ret = floor (d) == d; + break; + } + /*FALLTHROUGH*/ + default: + Wrong_Type (x, T_Fixnum); + /*NOTREACHED*/ + } + return ret ? True : False; +} + +Object P_Oddp (x) Object x; { + Object tmp; + tmp = P_Evenp (x); + return EQ(tmp,True) ? False : True; +} + +#define General_Generic_Compare(name,op,bigop) name (x, y) Object x, y; {\ + Object b; register ret;\ + GC_Node;\ + \ + switch (TYPE(x)) {\ + case T_Fixnum:\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + return FIXNUM(x) op FIXNUM(y);\ + case T_Flonum:\ + return FIXNUM(x) op FLONUM(y)->val;\ + case T_Bignum:\ + GC_Link (y);\ + b = Integer_To_Bignum (FIXNUM(x));\ + ret = bigop (b, y);\ + GC_Unlink;\ + return ret;\ + }\ + case T_Flonum:\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + return FLONUM(x)->val op FIXNUM(y);\ + case T_Flonum:\ + return FLONUM(x)->val op FLONUM(y)->val;\ + case T_Bignum:\ + return FLONUM(x)->val op Bignum_To_Double (y);\ + }\ + case T_Bignum:\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + GC_Link (x);\ + b = Integer_To_Bignum (FIXNUM(y));\ + ret = bigop (x, b);\ + GC_Unlink;\ + return ret;\ + case T_Flonum:\ + return Bignum_To_Double (x) op FLONUM(y)->val;\ + case T_Bignum:\ + return bigop (x, y);\ + }\ + }\ + /*NOTREACHED*/ /* ...but lint never sees it */\ +} + +General_Generic_Compare (Generic_Equal, ==, Bignum_Equal) +General_Generic_Compare (Generic_Less, <, Bignum_Less) +General_Generic_Compare (Generic_Greater, >, Bignum_Greater) +General_Generic_Compare (Generic_Eq_Less, <=, Bignum_Eq_Less) +General_Generic_Compare (Generic_Eq_Greater, >=, Bignum_Eq_Greater) + +Object General_Compare (argc, argv, op) Object *argv; register (*op)(); { + register i; + + Check_Number (argv[0]); + for (i = 1; i < argc; i++) { + Check_Number (argv[i]); + if (!(*op) (argv[i-1], argv[i])) + return False; + } + return True; +} + +Object P_Generic_Equal (argc, argv) Object *argv; { + return General_Compare (argc, argv, Generic_Equal); +} + +Object P_Generic_Less (argc, argv) Object *argv; { + return General_Compare (argc, argv, Generic_Less); +} + +Object P_Generic_Greater (argc, argv) Object *argv; { + return General_Compare (argc, argv, Generic_Greater); +} + +Object P_Generic_Eq_Less (argc, argv) Object *argv; { + return General_Compare (argc, argv, Generic_Eq_Less); +} + +Object P_Generic_Eq_Greater (argc, argv) Object *argv; { + return General_Compare (argc, argv, Generic_Eq_Greater); +} + +#define General_Generic_Operator(name,op,fixop,bigop) Object name (x, y)\ + Object x, y; {\ + Object b1, b2, ret; register i;\ + int fits;\ + GC_Node2;\ + \ + switch (TYPE(x)) {\ + case T_Fixnum:\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + i = fixop (FIXNUM(x), FIXNUM(y), &fits);\ + if (fits)\ + return Make_Integer (i);\ + b1 = b2 = Null;\ + GC_Link2 (b1, b2);\ + b1 = Integer_To_Bignum (FIXNUM(x));\ + b2 = Integer_To_Bignum (FIXNUM(y));\ + ret = bigop (b1, b2);\ + GC_Unlink;\ + return ret;\ + case T_Flonum:\ + return Make_Flonum (FIXNUM(x) op FLONUM(y)->val);\ + case T_Bignum:\ + GC_Link (y);\ + b1 = Integer_To_Bignum (FIXNUM(x));\ + ret = bigop (b1, y);\ + GC_Unlink;\ + return ret;\ + }\ + case T_Flonum:\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + return Make_Flonum (FLONUM(x)->val op FIXNUM(y));\ + case T_Flonum:\ + return Make_Flonum (FLONUM(x)->val op FLONUM(y)->val);\ + case T_Bignum:\ + return Make_Flonum (FLONUM(x)->val op Bignum_To_Double (y));\ + }\ + case T_Bignum:\ + switch (TYPE(y)) {\ + case T_Fixnum:\ + GC_Link (x);\ + b1 = Integer_To_Bignum (FIXNUM(y));\ + ret = bigop (x, b1);\ + GC_Unlink;\ + return ret;\ + case T_Flonum:\ + return Make_Flonum (Bignum_To_Double (x) op FLONUM(y)->val);\ + case T_Bignum:\ + return bigop (x, y);\ + }\ + }\ + /*NOTREACHED*/ /* ...but lint never sees it */\ +} + +General_Generic_Operator (Generic_Plus, +, Fixnum_Add, Bignum_Plus) +General_Generic_Operator (Generic_Minus, -, Fixnum_Sub, Bignum_Minus) + +Object P_Inc (x) Object x; { + Check_Number (x); + return Generic_Plus (x, One); +} + +Object P_Dec (x) Object x; { + Check_Number (x); + return Generic_Minus (x, One); +} + +Object General_Operator (argc, argv, start, op) Object *argv, start; + register Object (*op)(); { + register i; + Object accum; + + if (argc > 0) + Check_Number (argv[0]); + accum = start; + switch (argc) { + case 0: + break; + case 1: + accum = (*op) (accum, argv[0]); break; + default: + for (accum = argv[0], i = 1; i < argc; i++) { + Check_Number (argv[i]); + accum = (*op) (accum, argv[i]); + } + } + return accum; +} + +Object P_Generic_Plus (argc, argv) Object *argv; { + return General_Operator (argc, argv, Zero, Generic_Plus); +} + +Object P_Generic_Minus (argc, argv) Object *argv; { + return General_Operator (argc, argv, Zero, Generic_Minus); +} + +Object P_Generic_Multiply (argc, argv) Object *argv; { + return General_Operator (argc, argv, One, Generic_Multiply); +} + +Object P_Generic_Divide (argc, argv) Object *argv; { + return General_Operator (argc, argv, One, Generic_Divide); +} + +Object Generic_Multiply (x, y) Object x, y; { + Object b, ret; + + switch (TYPE(x)) { + case T_Fixnum: + switch (TYPE(y)) { + case T_Fixnum: + ret = Fixnum_Multiply (FIXNUM(x), FIXNUM(y)); + if (Nullp (ret)) { + b = Integer_To_Bignum (FIXNUM(x)); + return Bignum_Fixnum_Multiply (b, y); + } + return ret; + case T_Flonum: + return Make_Flonum (FIXNUM(x) * FLONUM(y)->val); + case T_Bignum: + return Bignum_Fixnum_Multiply (y, x); + } + case T_Flonum: + switch (TYPE(y)) { + case T_Fixnum: + return Make_Flonum (FLONUM(x)->val * FIXNUM(y)); + case T_Flonum: + return Make_Flonum (FLONUM(x)->val * FLONUM(y)->val); + case T_Bignum: + return Make_Flonum (FLONUM(x)->val * Bignum_To_Double (y)); + } + case T_Bignum: + switch (TYPE(y)) { + case T_Fixnum: + return Bignum_Fixnum_Multiply (x, y); + case T_Flonum: + return Make_Flonum (Bignum_To_Double (x) * FLONUM(y)->val); + case T_Bignum: + return Bignum_Multiply (x, y); + } + } + /*NOTREACHED*/ +} + +Object Generic_Divide (x, y) Object x, y; { + register t = TYPE(y); + Object b, ret; + GC_Node2; + + if (t == T_Fixnum ? FIXNUM(y) == 0 : + (t == T_Flonum ? FLONUM(y) == 0 : Bignum_Zero (y))) + Range_Error (y); + switch (TYPE(x)) { + case T_Fixnum: + switch (t) { + case T_Fixnum: + return Make_Reduced_Flonum ((double)FIXNUM(x) / (double)FIXNUM(y)); + case T_Flonum: + return Make_Flonum ((double)FIXNUM(x) / FLONUM(y)->val); + case T_Bignum: + GC_Link (y); + b = Integer_To_Bignum (FIXNUM(x)); + ret = Bignum_Divide (b, y); + GC_Unlink; + if (EQ(Cdr (ret),Zero)) + return Car (ret); + return Make_Reduced_Flonum ((double)FIXNUM(x) + / Bignum_To_Double (y)); + } + case T_Flonum: + switch (t) { + case T_Fixnum: + return Make_Flonum (FLONUM(x)->val / (double)FIXNUM(y)); + case T_Flonum: + return Make_Flonum (FLONUM(x)->val / FLONUM(y)->val); + case T_Bignum: + return Make_Flonum (FLONUM(x)->val / Bignum_To_Double (y)); + } + case T_Bignum: + switch (t) { + case T_Fixnum: + GC_Link (x); + ret = Bignum_Fixnum_Divide (x, y); + GC_Unlink; + if (EQ(Cdr (ret),Zero)) + return Car (ret); + return Make_Reduced_Flonum (Bignum_To_Double (x) + / (double)FIXNUM(y)); + case T_Flonum: + return Make_Flonum (Bignum_To_Double (x) / FLONUM(y)->val); + case T_Bignum: + GC_Link2 (x, y); + ret = Bignum_Divide (x, y); + GC_Unlink; + if (EQ(Cdr (ret),Zero)) + return Car (ret); + return Make_Reduced_Flonum (Bignum_To_Double (x) + / Bignum_To_Double (y)); + } + } + /*NOTREACHED*/ +} + +Object P_Abs (x) Object x; { + register i; + + Check_Number (x); + switch (TYPE(x)) { + case T_Fixnum: + i = FIXNUM(x); + return i < 0 ? Make_Integer (-i) : x; + case T_Flonum: + return Make_Flonum (fabs (FLONUM(x)->val)); + case T_Bignum: + return Bignum_Abs (x); + } + /*NOTREACHED*/ +} + +Object General_Integer_Divide (x, y, rem) Object x, y; { + register fx = FIXNUM(x), fy = FIXNUM(y); + Object b, ret; + GC_Node; + + if (TYPE(y) == T_Fixnum ? FIXNUM(y) == 0 : Bignum_Zero (y)) + Range_Error (y); + switch (TYPE(x)) { + case T_Fixnum: + switch (TYPE(y)) { + case T_Fixnum: + return Make_Integer (rem ? (fx % fy) : (fx / fy)); + case T_Bignum: + GC_Link (y); + b = Integer_To_Bignum (fx); + GC_Unlink; + ret = Bignum_Divide (b, y); +done: + return rem ? Cdr (ret) : Car (ret); + } + case T_Bignum: + switch (TYPE(y)) { + case T_Fixnum: + ret = Bignum_Fixnum_Divide (x, y); + goto done; + case T_Bignum: + ret = Bignum_Divide (x, y); + goto done; + } + } + /*NOTREACHED*/ +} + +Object Exact_Quotient (x, y) Object x, y; { + return General_Integer_Divide (x, y, 0); +} + +Object Exact_Remainder (x, y) Object x, y; { + return General_Integer_Divide (x, y, 1); +} + +Object Exact_Modulo (x, y) Object x, y; { + Object rem, xneg, yneg; + GC_Node2; + + GC_Link2 (x, y); + rem = General_Integer_Divide (x, y, 1); + xneg = P_Negativep (x); + yneg = P_Negativep (y); + if (!EQ(xneg,yneg)) + rem = Generic_Plus (rem, y); + GC_Unlink; + return rem; +} + +Object With_Exact_Ints (x, y, fun) Object x, y, (*fun)(); { + Object i, ret; + int inex = 0; + GC_Node3; + + ret = Null; + GC_Link3 (x, y, ret); + i = P_Integerp (x); + if (!EQ(i,True)) + Wrong_Type (x, T_Fixnum); + i = P_Integerp (y); + if (!EQ(i,True)) + Wrong_Type (y, T_Fixnum); + if (TYPE(x) == T_Flonum) { + x = P_Inexact_To_Exact (x); inex++; + } + if (TYPE(y) == T_Flonum) { + y = P_Inexact_To_Exact (y); inex++; + } + ret = fun (x, y); + if (inex) + ret = P_Exact_To_Inexact (ret); + GC_Unlink; + return ret; +} + +Object P_Quotient (x, y) Object x, y; { + return With_Exact_Ints (x, y, Exact_Quotient); +} + +Object P_Remainder (x, y) Object x, y; { + return With_Exact_Ints (x, y, Exact_Remainder); +} + +Object P_Modulo (x, y) Object x, y; { + return With_Exact_Ints (x, y, Exact_Modulo); +} + +Object Exact_Gcd (x, y) Object x, y; { + Object r, z; + GC_Node2; + + GC_Link2 (x, y); + while (1) { + z = P_Zerop (x); + if (EQ(z,True)) { + r = y; + break; + } + z = P_Zerop (y); + if (EQ(z,True)) { + r = x; + break; + } + r = General_Integer_Divide (x, y, 1); + x = y; + y = r; + } + GC_Unlink; + return r; +} + +Object General_Gcd (x, y) Object x, y; { + return With_Exact_Ints (x, y, Exact_Gcd); +} + +Object P_Gcd (argc, argv) Object *argv; { + return P_Abs (General_Operator (argc, argv, Zero, General_Gcd)); +} + +Object Exact_Lcm (x, y) Object x, y; { + Object ret, p, z; + GC_Node3; + + ret = Null; + GC_Link3 (x, y, ret); + ret = Exact_Gcd (x, y); + z = P_Zerop (ret); + if (!EQ(z,True)) { + p = Generic_Multiply (x, y); + ret = General_Integer_Divide (p, ret, 0); + } + GC_Unlink; + return ret; +} + +Object General_Lcm (x, y) Object x, y; { + return With_Exact_Ints (x, y, Exact_Lcm); +} + +Object P_Lcm (argc, argv) Object *argv; { + return P_Abs (General_Operator (argc, argv, One, General_Lcm)); +} + +#define General_Conversion(name,op) Object name (x) Object x; {\ + double d, i;\ +\ + Check_Number (x);\ + if (TYPE(x) != T_Flonum)\ + return x;\ + d = FLONUM(x)->val;\ + (void)modf (op (d), &i);\ + return Make_Flonum (i);\ +} + +#define trunc(x) (x) + +General_Conversion (P_Floor, floor) +General_Conversion (P_Ceiling, ceil) +General_Conversion (P_Truncate, trunc) + +Object P_Round (x) Object x; { + double d, y, f; + Object ret, isodd; + + Check_Number (x); + if (TYPE(x) != T_Flonum) + return x; + d = FLONUM(x)->val; + y = d + 0.5; + f = floor (y); + ret = Make_Flonum (f); + if (y == f) { + isodd = P_Oddp (ret); + if (Truep (isodd)) + FLONUM(ret)->val--; + } + return ret; +} + +double Get_Double (x) Object x; { + Check_Number (x); + switch (TYPE(x)) { + case T_Fixnum: + return (double)FIXNUM(x); + case T_Flonum: + return FLONUM(x)->val; + case T_Bignum: + return Bignum_To_Double (x); + } + /*NOTREACHED*/ +} + +Object General_Function (x, y, fun) Object x, y; double (*fun)(); { + double d, ret; + + d = Get_Double (x); + errno = 0; + if (Nullp (y)) + ret = (*fun) (d); + else + ret = (*fun) (d, Get_Double (y)); + if (errno == ERANGE || errno == EDOM) + Range_Error (x); + return Make_Flonum (ret); +} + +Object P_Sqrt (x) Object x; { return General_Function (x, Null, sqrt); } + +Object P_Exp (x) Object x; { return General_Function (x, Null, exp); } + +Object P_Log (x) Object x; { return General_Function (x, Null, log); } + +Object P_Sin (x) Object x; { return General_Function (x, Null, sin); } + +Object P_Cos (x) Object x; { return General_Function (x, Null, cos); } + +Object P_Tan (x) Object x; { return General_Function (x, Null, tan); } + +Object P_Asin (x) Object x; { return General_Function (x, Null, asin); } + +Object P_Acos (x) Object x; { return General_Function (x, Null, acos); } + +Object P_Atan (argc, argv) Object *argv; { + register a2 = argc == 2; + return General_Function (argv[0], a2 ? argv[1] : Null, a2 ? + (double(*)())atan2 : (double(*)())atan); +} + +Object Min (x, y) Object x, y; { + Object ret; + + ret = Generic_Less (x, y) ? x : y; + if (TYPE(x) == T_Flonum || TYPE(y) == T_Flonum) + ret = P_Exact_To_Inexact (ret); + return ret; +} + +Object Max (x, y) Object x, y; { + Object ret; + + ret = Generic_Less (x, y) ? y : x; + if (TYPE(x) == T_Flonum || TYPE(y) == T_Flonum) + ret = P_Exact_To_Inexact (ret); + return ret; +} + +Object P_Min (argc, argv) Object *argv; { + return General_Operator (argc, argv, argv[0], Min); +} + +Object P_Max (argc, argv) Object *argv; { + return General_Operator (argc, argv, argv[0], Max); +} + +Object P_Random () { +#ifdef RANDOM + extern long random(); + return Make_Long (random ()); +#else + return Make_Integer (rand ()); +#endif +} + +Object P_Srandom (x) Object x; { +#ifdef RANDOM + srandom (Get_Unsigned (x)); +#else + srand (Get_Unsigned (x)); +#endif + return x; +} diff --git a/src/onfork.c b/src/onfork.c new file mode 100644 index 0000000..a55807e --- /dev/null +++ b/src/onfork.c @@ -0,0 +1,31 @@ +/* This module allows code to register `onfork' handlers, similar to + * the way exit handlers are registered in C with atexit(). + * The interpreter kernel proper never calls the onfork handlers, + * but the fork primitive of the UNIX extension does in the newly + * created child process (other extensions may also call the handlers). + * + * The dynamic loading implementation of the interpreter kernel + * may register onfork handlers to add links to the temp files. + * User-supplied extensions may want to register onfork handlers + * as well. + */ + +#include "kernel.h" + +static FUNCT *Onfork_Funcs; + +Register_Onfork (f) void (*f)(); { + FUNCT *p; + + p = (FUNCT *)Safe_Malloc (sizeof (*p)); + p->func = f; + p->next = Onfork_Funcs; + Onfork_Funcs = p; +} + +void Call_Onfork () { + FUNCT *p; + + for (p = Onfork_Funcs; p; p = p->next) + p->func(); +} diff --git a/src/prim.c b/src/prim.c new file mode 100644 index 0000000..2672c55 --- /dev/null +++ b/src/prim.c @@ -0,0 +1,416 @@ +/* Built-in primitives, Define_Primitive(). + */ + +#include "kernel.h" + +struct Prim_Init { + Object (*fun)(); + char *name; + int minargs, maxargs; + enum discipline disc; +} Primitives[] = { + + /* autoload.c: + */ + P_Autoload, "autoload", 2, 2, EVAL, + + /* bool.c: + */ + P_Booleanp, "boolean?", 1, 1, EVAL, + P_Not, "not", 1, 1, EVAL, + P_Eq, "eq?", 2, 2, EVAL, + P_Eqv, "eqv?", 2, 2, EVAL, + P_Equal, "equal?", 2, 2, EVAL, + P_Empty_List_Is_False, "empty-list-is-false-for-backward-compatibility", + 1, 1, EVAL, + + /* char.c: + */ + P_Charp, "char?", 1, 1, EVAL, + P_Char_To_Integer, "char->integer", 1, 1, EVAL, + P_Integer_To_Char, "integer->char", 1, 1, EVAL, + P_Char_Upper_Casep, "char-upper-case?", 1, 1, EVAL, + P_Char_Lower_Casep, "char-lower-case?", 1, 1, EVAL, + P_Char_Alphabeticp, "char-alphabetic?", 1, 1, EVAL, + P_Char_Numericp, "char-numeric?", 1, 1, EVAL, + P_Char_Whitespacep, "char-whitespace?", 1, 1, EVAL, + P_Char_Upcase, "char-upcase", 1, 1, EVAL, + P_Char_Downcase, "char-downcase", 1, 1, EVAL, + P_Char_Eq, "char=?", 2, 2, EVAL, + P_Char_Less, "char?", 2, 2, EVAL, + P_Char_Eq_Less, "char<=?", 2, 2, EVAL, + P_Char_Eq_Greater, "char>=?", 2, 2, EVAL, + P_Char_CI_Eq, "char-ci=?", 2, 2, EVAL, + P_Char_CI_Less, "char-ci?", 2, 2, EVAL, + P_Char_CI_Eq_Less, "char-ci<=?", 2, 2, EVAL, + P_Char_CI_Eq_Greater,"char-ci>=?", 2, 2, EVAL, + + /* cont.c: + */ + P_Control_Pointp, "control-point?", 1, 1, EVAL, + P_Call_With_Current_Continuation, + "call-with-current-continuation", 1, 1, EVAL, + P_Dynamic_Wind, "dynamic-wind", 3, 3, EVAL, + P_Control_Point_Environment, + "control-point-environment", 1, 1, EVAL, + + /* debug.c: + */ + P_Backtrace_List, "backtrace-list", 0, 1, VARARGS, + + /* dump.c: + */ +#ifdef CAN_DUMP + P_Dump, "dump", 1, 1, EVAL, +#endif + + /* env.c: + */ + P_Environmentp, "environment?", 1, 1, EVAL, + P_The_Environment, "the-environment", 0, 0, EVAL, + P_Global_Environment,"global-environment", 0, 0, EVAL, + P_Define, "define", 1, MANY, NOEVAL, + P_Define_Macro, "define-macro", 1, MANY, NOEVAL, + P_Set, "set!", 2, 2, NOEVAL, + P_Environment_To_List, + "environment->list", 1, 1, EVAL, + P_Boundp, "bound?", 1, 1, EVAL, + + /* error.c: + */ + P_Error, "error", 2, MANY, VARARGS, + P_Reset, "reset", 0, 0, EVAL, + + /* exception.c: + */ + P_Disable_Interrupts,"disable-interrupts", 0, 0, EVAL, + P_Enable_Interrupts, "enable-interrupts", 0, 0, EVAL, + + /* feature.c: + */ + P_Features, "features", 0, 0, EVAL, + P_Featurep, "feature?", 1, 1, EVAL, + P_Provide, "provide", 1, 1, EVAL, + P_Require, "require", 1, 3, VARARGS, + + /* heap.c: + */ + P_Collect, "collect", 0, 0, EVAL, + P_Garbage_Collect_Status, "garbage-collect-status", 0, 2, VARARGS, +#ifdef GENERATIONAL_GC + P_Collect_Incremental, "collect-incremental", 0, 0, EVAL, +#endif + + + /* io.c: + */ + P_Port_File_Name, "port-file-name", 1, 1, EVAL, + P_Port_Line_Number, "port-line-number", 1, 1, EVAL, + P_Eof_Objectp, "eof-object?", 1, 1, EVAL, + P_Current_Input_Port, + "current-input-port", 0, 0, EVAL, + P_Current_Output_Port, + "current-output-port", 0, 0, EVAL, + P_Input_Portp, "input-port?", 1, 1, EVAL, + P_Output_Portp, "output-port?", 1, 1, EVAL, + P_Open_Input_File, "open-input-file", 1, 1, EVAL, + P_Open_Output_File, "open-output-file", 1, 1, EVAL, + P_Open_Input_Output_File, "open-input-output-file", 1, 1, EVAL, + P_Close_Input_Port, "close-input-port", 1, 1, EVAL, + P_Close_Output_Port, "close-output-port", 1, 1, EVAL, + P_With_Input_From_File, "with-input-from-file", 2, 2, EVAL, + P_With_Output_To_File, "with-output-to-file", 2, 2, EVAL, + P_Call_With_Input_File, "call-with-input-file", 2, 2, EVAL, + P_Call_With_Output_File, "call-with-output-file", 2, 2, EVAL, + P_Open_Input_String, "open-input-string", 1, 1, EVAL, + P_Open_Output_String,"open-output-string", 0, 0, EVAL, + P_Tilde_Expand, "tilde-expand", 1, 1, EVAL, + P_File_Existsp, "file-exists?", 1, 1, EVAL, + + /* load.c: + */ + P_Load, "load", 1, 2, VARARGS, + + /* list.c: + */ + P_Cons, "cons", 2, 2, EVAL, + P_Car, "car", 1, 1, EVAL, + P_Cdr, "cdr", 1, 1, EVAL, + P_Caar, "caar", 1, 1, EVAL, + P_Cadr, "cadr", 1, 1, EVAL, + P_Cdar, "cdar", 1, 1, EVAL, + P_Cddr, "cddr", 1, 1, EVAL, + + P_Caaar, "caaar", 1, 1, EVAL, + P_Caadr, "caadr", 1, 1, EVAL, + P_Cadar, "cadar", 1, 1, EVAL, + P_Caddr, "caddr", 1, 1, EVAL, + P_Cdaar, "cdaar", 1, 1, EVAL, + P_Cdadr, "cdadr", 1, 1, EVAL, + P_Cddar, "cddar", 1, 1, EVAL, + P_Cdddr, "cdddr", 1, 1, EVAL, + + P_Caaaar, "caaaar", 1, 1, EVAL, + P_Caaadr, "caaadr", 1, 1, EVAL, + P_Caadar, "caadar", 1, 1, EVAL, + P_Caaddr, "caaddr", 1, 1, EVAL, + P_Cadaar, "cadaar", 1, 1, EVAL, + P_Cadadr, "cadadr", 1, 1, EVAL, + P_Caddar, "caddar", 1, 1, EVAL, + P_Cadddr, "cadddr", 1, 1, EVAL, + P_Cdaaar, "cdaaar", 1, 1, EVAL, + P_Cdaadr, "cdaadr", 1, 1, EVAL, + P_Cdadar, "cdadar", 1, 1, EVAL, + P_Cdaddr, "cdaddr", 1, 1, EVAL, + P_Cddaar, "cddaar", 1, 1, EVAL, + P_Cddadr, "cddadr", 1, 1, EVAL, + P_Cdddar, "cdddar", 1, 1, EVAL, + P_Cddddr, "cddddr", 1, 1, EVAL, + + P_Cxr, "cxr", 2, 2, EVAL, + P_Nullp, "null?", 1, 1, EVAL, + P_Pairp, "pair?", 1, 1, EVAL, + P_Listp, "list?", 1, 1, EVAL, + P_Set_Car, "set-car!", 2, 2, EVAL, + P_Set_Cdr, "set-cdr!", 2, 2, EVAL, + P_Assq, "assq", 2, 2, EVAL, + P_Assv, "assv", 2, 2, EVAL, + P_Assoc, "assoc", 2, 2, EVAL, + P_Memq, "memq", 2, 2, EVAL, + P_Memv, "memv", 2, 2, EVAL, + P_Member, "member", 2, 2, EVAL, + P_Make_List, "make-list", 2, 2, EVAL, + P_List, "list", 0, MANY, VARARGS, + P_Length, "length", 1, 1, EVAL, + P_Append, "append", 0, MANY, VARARGS, + P_Append_Set, "append!", 0, MANY, VARARGS, + P_Last_Pair, "last-pair", 1, 1, EVAL, + P_Reverse, "reverse", 1, 1, EVAL, + P_Reverse_Set, "reverse!", 1, 1, EVAL, + P_List_Tail, "list-tail", 2, 2, EVAL, + P_List_Ref, "list-ref", 2, 2, EVAL, + + /* main.c: + */ + P_Command_Line_Args, "command-line-args", 0, 0, EVAL, + P_Exit, "exit", 0, 1, VARARGS, + + /* math.c: + */ + P_Number_To_String, "number->string", 1, 2, VARARGS, + P_Numberp, "number?", 1, 1, EVAL, + P_Complexp, "complex?", 1, 1, EVAL, + P_Realp, "real?", 1, 1, EVAL, + P_Rationalp, "rational?", 1, 1, EVAL, + P_Integerp, "integer?", 1, 1, EVAL, + P_Zerop, "zero?", 1, 1, EVAL, + P_Positivep, "positive?", 1, 1, EVAL, + P_Negativep, "negative?", 1, 1, EVAL, + P_Oddp, "odd?", 1, 1, EVAL, + P_Evenp, "even?", 1, 1, EVAL, + P_Exactp, "exact?", 1, 1, EVAL, + P_Inexactp, "inexact?", 1, 1, EVAL, + P_Exact_To_Inexact, "exact->inexact", 1, 1, EVAL, + P_Inexact_To_Exact, "inexact->exact", 1, 1, EVAL, + P_Generic_Less, "<", 1, MANY, VARARGS, + P_Generic_Greater, ">", 1, MANY, VARARGS, + P_Generic_Equal, "=", 1, MANY, VARARGS, + P_Generic_Eq_Less, "<=", 1, MANY, VARARGS, + P_Generic_Eq_Greater,">=", 1, MANY, VARARGS, + P_Inc, "1+", 1, 1, EVAL, + P_Dec, "-1+", 1, 1, EVAL, + P_Dec, "1-", 1, 1, EVAL, + P_Generic_Plus, "+", 0, MANY, VARARGS, + P_Generic_Minus, "-", 1, MANY, VARARGS, + P_Generic_Multiply, "*", 0, MANY, VARARGS, + P_Generic_Divide, "/", 1, MANY, VARARGS, + P_Abs, "abs", 1, 1, EVAL, + P_Quotient, "quotient", 2, 2, EVAL, + P_Remainder, "remainder", 2, 2, EVAL, + P_Modulo, "modulo", 2, 2, EVAL, + P_Gcd, "gcd", 0, MANY, VARARGS, + P_Lcm, "lcm", 0, MANY, VARARGS, + P_Floor, "floor", 1, 1, EVAL, + P_Ceiling, "ceiling", 1, 1, EVAL, + P_Truncate, "truncate", 1, 1, EVAL, + P_Round, "round", 1, 1, EVAL, + P_Sqrt, "sqrt", 1, 1, EVAL, + P_Exp, "exp", 1, 1, EVAL, + P_Log, "log", 1, 1, EVAL, + P_Sin, "sin", 1, 1, EVAL, + P_Cos, "cos", 1, 1, EVAL, + P_Tan, "tan", 1, 1, EVAL, + P_Asin, "asin", 1, 1, EVAL, + P_Acos, "acos", 1, 1, EVAL, + P_Atan, "atan", 1, 2, VARARGS, + P_Min, "min", 1, MANY, VARARGS, + P_Max, "max", 1, MANY, VARARGS, + P_Random, "random", 0, 0, EVAL, + P_Srandom, "srandom", 1, 1, EVAL, + + /* prim.c: + */ + + /* print.c: + */ + P_Write, "write", 1, 2, VARARGS, + P_Display, "display", 1, 2, VARARGS, + P_Write_Char, "write-char", 1, 2, VARARGS, + P_Newline, "newline", 0, 1, VARARGS, + P_Print, "print", 1, 2, VARARGS, + P_Clear_Output_Port, "clear-output-port", 0, 1, VARARGS, + P_Flush_Output_Port, "flush-output-port", 0, 1, VARARGS, + P_Get_Output_String, "get-output-string", 1, 1, EVAL, + P_Format, "format", 2, MANY, VARARGS, + + /* proc.c: + */ + P_Procedurep, "procedure?", 1, 1, EVAL, + P_Primitivep, "primitive?", 1, 1, EVAL, + P_Compoundp, "compound?", 1, 1, EVAL, + P_Macrop, "macro?", 1, 1, EVAL, + P_Eval, "eval", 1, 2, VARARGS, + P_Apply, "apply", 2, MANY, VARARGS, + P_Lambda, "lambda", 2, MANY, NOEVAL, + P_Procedure_Environment, + "procedure-environment", 1, 1, EVAL, + P_Procedure_Lambda, "procedure-lambda", 1, 1, EVAL, + P_Map, "map", 2, MANY, VARARGS, + P_For_Each, "for-each", 2, MANY, VARARGS, + P_Macro, "macro", 2, MANY, NOEVAL, + P_Macro_Body, "macro-body", 1, 1, EVAL, + P_Macro_Expand, "macro-expand", 1, 1, EVAL, + + /* promise.c: + */ + P_Delay, "delay", 1, 1, NOEVAL, + P_Force, "force", 1, 1, EVAL, + P_Promisep, "promise?", 1, 1, EVAL, + P_Promise_Environment, + "promise-environment", 1, 1, EVAL, + + /* read.c: + */ + P_Clear_Input_Port, "clear-input-port", 0, 1, VARARGS, + P_Read, "read", 0, 1, VARARGS, + P_Read_Char, "read-char", 0, 1, VARARGS, + P_Read_String, "read-string", 0, 1, VARARGS, + P_Unread_Char, "unread-char", 1, 2, VARARGS, + P_Peek_Char, "peek-char", 0, 1, VARARGS, + P_Char_Readyp, "char-ready?", 0, 1, VARARGS, + + /* special.c: + */ + P_Quote, "quote", 1, 1, NOEVAL, + P_Quasiquote, "quasiquote", 1, 1, NOEVAL, + P_Begin, "begin", 1, MANY, NOEVAL, + P_Begin1, "begin1", 1, MANY, NOEVAL, + P_If, "if", 2, MANY, NOEVAL, + P_Case, "case", 2, MANY, NOEVAL, + P_Cond, "cond", 1, MANY, NOEVAL, + P_Do, "do", 2, MANY, NOEVAL, + P_Let, "let", 2, MANY, NOEVAL, + P_Letseq, "let*", 2, MANY, NOEVAL, + P_Letrec, "letrec", 2, MANY, NOEVAL, + P_Fluid_Let, "fluid-let", 2, MANY, NOEVAL, + P_And, "and", 0, MANY, NOEVAL, + P_Or, "or", 0, MANY, NOEVAL, + + /* string.c: + */ + P_String, "string", 0, MANY, VARARGS, + P_Stringp, "string?", 1, 1, EVAL, + P_Make_String, "make-string", 1, 2, VARARGS, + P_String_Length, "string-length", 1, 1, EVAL, + P_String_To_Number, "string->number", 1, 2, VARARGS, + P_String_Ref, "string-ref", 2, 2, EVAL, + P_String_Set, "string-set!", 3, 3, EVAL, + P_Substring, "substring", 3, 3, EVAL, + P_String_Copy, "string-copy", 1, 1, EVAL, + P_String_Append, "string-append", 0, MANY, VARARGS, + P_List_To_String, "list->string", 1, 1, EVAL, + P_String_To_List, "string->list", 1, 1, EVAL, + P_String_Fill, "string-fill!", 2, 2, EVAL, + P_Substring_Fill, "substring-fill!", 4, 4, EVAL, + P_String_Eq, "string=?", 2, 2, EVAL, + P_String_Less, "string?", 2, 2, EVAL, + P_String_Eq_Less, "string<=?", 2, 2, EVAL, + P_String_Eq_Greater, "string>=?", 2, 2, EVAL, + P_String_CI_Eq, "string-ci=?", 2, 2, EVAL, + P_String_CI_Less, "string-ci?", 2, 2, EVAL, + P_String_CI_Eq_Less, "string-ci<=?", 2, 2, EVAL, + P_String_CI_Eq_Greater, + "string-ci>=?", 2, 2, EVAL, + P_Substringp, "substring?", 2, 2, EVAL, + P_CI_Substringp, "substring-ci?", 2, 2, EVAL, + + /* symbol.c: + */ + P_String_To_Symbol, "string->symbol", 1, 1, EVAL, + P_Oblist, "oblist", 0, 0, EVAL, + P_Symbolp, "symbol?", 1, 1, EVAL, + P_Symbol_To_String, "symbol->string", 1, 1, EVAL, + P_Put, "put", 2, 3, VARARGS, + P_Get, "get", 2, 2, EVAL, + P_Symbol_Plist, "symbol-plist", 1, 1, EVAL, + + /* type.c: + */ + P_Type, "type", 1, 1, EVAL, + + /* vector.c: + */ + P_Vectorp, "vector?", 1, 1, EVAL, + P_Make_Vector, "make-vector", 1, 2, VARARGS, + P_Vector, "vector", 0, MANY, VARARGS, + P_Vector_Length, "vector-length", 1, 1, EVAL, + P_Vector_Ref, "vector-ref", 2, 2, EVAL, + P_Vector_Set, "vector-set!", 3, 3, EVAL, + P_Vector_To_List, "vector->list", 1, 1, EVAL, + P_List_To_Vector, "list->vector", 1, 1, EVAL, + P_Vector_Fill, "vector-fill!", 2, 2, EVAL, + P_Vector_Copy, "vector-copy", 1, 1, EVAL, + + 0 +}; + +/* The C-compiler can't initialize unions, thus the primitive procedures + * must be created during run-time (the problem actually is that one can't + * provide an intializer for the "tag" component of an S_Primitive). + */ + +Init_Prim () { + register struct Prim_Init *p; + Object frame, prim, sym; + + for (frame = Car (The_Environment), p = Primitives; p->fun; p++) { + prim = Make_Primitive (p->fun, p->name, p->minargs, p->maxargs, + p->disc); + sym = Intern (p->name); + frame = Add_Binding (frame, sym, prim); + } + Car (The_Environment) = frame; + Memoize_Frame (frame); +} + +Define_Primitive (fun, name, min, max, disc) Object (*fun)(); const char *name; + enum discipline disc; { + Object prim, sym, frame; + GC_Node2; + + Set_Error_Tag ("define-primitive"); + prim = Make_Primitive (fun, name, min, max, disc); + sym = Null; + GC_Link2 (prim, sym); + sym = Intern (name); + if (disc == EVAL && min != max) + Primitive_Error ("~s: number of arguments must be fixed", sym); + frame = Add_Binding (Car (The_Environment), sym, prim); + SYMBOL(sym)->value = prim; + Car (The_Environment) = frame; + GC_Unlink; +} diff --git a/src/print.c b/src/print.c new file mode 100644 index 0000000..30352a6 --- /dev/null +++ b/src/print.c @@ -0,0 +1,604 @@ +/* Output functions and primitives. + */ + +#include "kernel.h" + +#include +#include +#include + +#ifdef FLUSH_TIOCFLUSH +# include +#else +#ifdef FLUSH_TCFLSH +# include +#endif +#endif + +extern int errno; + +int Saved_Errno; + +static Object V_Print_Depth, V_Print_Length; + +Init_Print () { + Define_Variable (&V_Print_Depth, "print-depth", + Make_Integer (DEF_PRINT_DEPTH)); + Define_Variable (&V_Print_Length, "print-length", + Make_Integer (DEF_PRINT_LEN)); +} + +Print_Length () { + Object pl; + + pl = Var_Get (V_Print_Length); + return TYPE(pl) == T_Fixnum ? FIXNUM(pl) : DEF_PRINT_LEN; +} + +Print_Depth () { + Object pd; + + pd = Var_Get (V_Print_Depth); + return TYPE(pd) == T_Fixnum ? FIXNUM(pd) : DEF_PRINT_DEPTH; +} + +Print_Char (port, c) Object port; register c; { + char buf[1]; + + if (PORT(port)->flags & P_STRING) { + buf[0] = c; + Print_String (port, buf, 1); + } else { + if (putc (c, PORT(port)->file) == EOF) { + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("write error on ~s: ~E", port); + } + } +} + +Print_String (port, buf, len) Object port; register char *buf; register len; { + register n; + register struct S_Port *p; + Object new; + GC_Node; + + p = PORT(port); + n = STRING(p->name)->size - p->ptr; + if (n < len) { + GC_Link (port); + n = len - n; + if (n < STRING_GROW_SIZE) + n = STRING_GROW_SIZE; + new = Make_String ((char *)0, STRING(p->name)->size + n); + p = PORT(port); + GC_Unlink; + bcopy (STRING(p->name)->data, STRING(new)->data, p->ptr); + p->name = new; + } + bcopy (buf, STRING(p->name)->data + p->ptr, len); + p->ptr += len; +} + +#ifndef VPRINTF +vfprintf (f, fmt, ap) register FILE *f; register char *fmt; va_list ap; { + _doprnt (fmt, ap, f); +} + +vsprintf (s, fmt, ap) register char *s, *fmt; va_list ap; { + FILE x; + x._flag = _IOWRT|_IOSTRG; + x._ptr = s; + x._cnt = 1024; + _doprnt (fmt, ap, &x); + putc ('\0', &x); +} +#endif + +/*VARARGS0*/ +Printf (va_alist) va_dcl { + va_list args; + Object port; + char *fmt; + char buf[1024]; + + va_start (args); + port = va_arg (args, Object); + fmt = va_arg (args, char *); + if (PORT(port)->flags & P_STRING) { + vsprintf (buf, fmt, args); + Print_String (port, buf, strlen (buf)); + } else { + vfprintf (PORT(port)->file, fmt, args); + if (ferror (PORT(port)->file)) { + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("write error on ~s: ~E", port); + } + } + va_end (args); +} + +Object General_Print (argc, argv, raw) Object *argv; { + General_Print_Object (argv[0], argc == 2 ? argv[1] : Curr_Output_Port, raw); + return Void; +} + +Object P_Write (argc, argv) Object *argv; { + return General_Print (argc, argv, 0); +} + +Object P_Display (argc, argv) Object *argv; { + return General_Print (argc, argv, 1); +} + +Object P_Write_Char (argc, argv) Object *argv; { + Check_Type (argv[0], T_Character); + return General_Print (argc, argv, 1); +} + +/*VARARGS1*/ +Object P_Newline (argc, argv) Object *argv; { + General_Print_Object (Newline, argc == 1 ? argv[0] : Curr_Output_Port, 1); + return Void; +} + +Object P_Print (argc, argv) Object *argv; { + Object port; + GC_Node; + + port = argc == 2 ? argv[1] : Curr_Output_Port; + GC_Link (port); + General_Print_Object (argv[0], port, 0); + Print_Char (port, '\n'); + Flush_Output (port); + GC_Unlink; + return Void; +} + +Object P_Clear_Output_Port (argc, argv) Object *argv; { + Discard_Output (argc == 1 ? argv[0] : Curr_Output_Port); + return Void; +} + +Discard_Output (port) Object port; { + register FILE *f; + + Check_Output_Port (port); + if (PORT(port)->flags & P_STRING) + return; + f = PORT(port)->file; +#ifdef FLUSH_FPURGE + (void)fpurge (f); +#else +#ifdef FLUSH_BSD + f->_cnt = 0; + f->_ptr = f->_base; +#endif +#endif +#ifdef FLUSH_TIOCFLUSH + (void)ioctl (fileno (f), TIOCFLUSH, (char *)0); +#else +#ifdef FLUSH_TCFLSH + (void)ioctl (fileno (f), TCFLSH, (char *)1); +#endif +#endif +} + +Object P_Flush_Output_Port (argc, argv) Object *argv; { + Flush_Output (argc == 1 ? argv[0] : Curr_Output_Port); + return Void; +} + +Flush_Output (port) Object port; { + Check_Output_Port (port); + if (PORT(port)->flags & P_STRING) + return; + if (fflush (PORT(port)->file) == EOF) { + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("write error on ~s: ~E", port); + } +} + +Object P_Get_Output_String (port) Object port; { + register struct S_Port *p; + Object str; + GC_Node; + + Check_Output_Port (port); + GC_Link (port); + str = Make_String ((char *)0, PORT(port)->ptr); + p = PORT(port); + bcopy (STRING(p->name)->data, STRING(str)->data, p->ptr); + p->ptr = 0; + GC_Unlink; + return str; +} + +Check_Output_Port (port) Object port; { + Check_Type (port, T_Port); + if (!(PORT(port)->flags & P_OPEN)) + Primitive_Error ("port has been closed: ~s", port); + if (!IS_OUTPUT(port)) + Primitive_Error ("not an output port: ~s", port); +} + +General_Print_Object (x, port, raw) Object x, port; { + Check_Output_Port (port); + Print_Object (x, port, raw, Print_Depth (), Print_Length ()); +} + +Print_Object (x, port, raw, depth, length) Object x, port; + register raw, depth, length; { + register t; + GC_Node2; + + GC_Link2 (port, x); + t = TYPE(x); + switch (t) { + case T_Null: + Printf (port, "()"); + break; + case T_Fixnum: + Printf (port, "%d", FIXNUM(x)); + break; + case T_Bignum: + Print_Bignum (port, x); + break; + case T_Flonum: + Printf (port, "%s", Flonum_To_String (x)); + break; + case T_Boolean: + Printf (port, "#%c", FIXNUM(x) ? 't' : 'f'); + break; + case T_Unbound: + Printf (port, "#[unbound]"); + break; + case T_Special: + Printf (port, "#[special]"); + break; + case T_Character: { + int c = CHAR(x); + if (raw) + Print_Char (port, c); + else + Pr_Char (port, c); + break; + } + case T_Symbol: + Pr_Symbol (port, x, raw); + break; + case T_Pair: + Pr_List (port, x, raw, depth, length); + break; + case T_Environment: + Printf (port, "#[environment %lu]", POINTER(x)); + break; + case T_String: + Pr_String (port, x, raw); + break; + case T_Vector: + Pr_Vector (port, x, raw, depth, length); + break; + case T_Primitive: + Printf (port, "#[primitive %s]", PRIM(x)->name); + break; + case T_Compound: + if (Nullp (COMPOUND(x)->name)) { + Printf (port, "#[compound %lu]", POINTER(x)); + } else { + Printf (port, "#[compound "); + Print_Object (COMPOUND(x)->name, port, raw, depth, length); + Print_Char (port, ']'); + } + break; + case T_Control_Point: + Printf (port, "#[control-point %lu]", POINTER(x)); + break; + case T_Promise: + Printf (port, "#[promise %lu]", POINTER(x)); + break; + case T_Port: { + int str = PORT(x)->flags & P_STRING; + char *p; + switch (PORT(x)->flags & (P_INPUT|P_BIDIR)) { + case 0: p = "output"; break; + case P_INPUT: p = "input"; break; + default: p = "input-output"; break; + } + Printf (port, "#[%s-%s-port ", str ? "string" : "file", p); + if (str) + Printf (port, "%lu", POINTER(x)); + else + Pr_String (port, PORT(x)->name, 0); + Print_Char (port, ']'); + break; + } + case T_End_Of_File: + Printf (port, "#[end-of-file]"); + break; + case T_Autoload: + Printf (port, "#[autoload "); + Print_Object (AUTOLOAD(x)->files, port, raw, depth, length); + Print_Char (port, ']'); + break; + case T_Macro: + if (Nullp (MACRO(x)->name)) { + Printf (port, "#[macro %lu]", POINTER(x)); + } else { + Printf (port, "#[macro "); + Print_Object (MACRO(x)->name, port, raw, depth, length); + Print_Char (port, ']'); + } + break; + case T_Broken_Heart: + Printf (port, "!!broken-heart!!"); + break; + default: + if (t < 0 || t >= Num_Types) + Panic ("bad type in print"); + (Types[t].print)(x, port, raw, depth, length); + } + GC_Unlink; +} + +Pr_Char (port, c) Object port; register c; { + register char *p = 0; + + switch (c) { + case ' ': + p = "#\\space"; + break; + case '\t': + p = "#\\tab"; + break; + case '\n': + p = "#\\newline"; + break; + case '\r': + p = "#\\return"; + break; + case '\f': + p = "#\\formfeed"; + break; + case '\b': + p = "#\\backspace"; + break; + default: + if (c > ' ' && c < '\177') + Printf (port, "#\\%c", c); + else + Printf (port, "#\\%03o", (unsigned char)c); + } + if (p) Printf (port, p); +} + +Pr_List (port, list, raw, depth, length) Object port, list; + register raw, depth, length; { + Object tail; + register len; + register char *s = 0; + GC_Node2; + + if (depth == 0) { + Printf (port, "&"); + return; + } + GC_Link2 (port, list); + if (!Nullp (list) && ((tail = Cdr (list)), TYPE(tail) == T_Pair) + && ((tail = Cdr (tail)), Nullp (tail))) { + tail = Car (list); + if (EQ(tail, Sym_Quote)) + s = "'"; + else if (EQ(tail, Sym_Quasiquote)) + s = "`"; + else if (EQ(tail, Sym_Unquote)) + s = ","; + else if (EQ(tail, Sym_Unquote_Splicing)) + s = ",@"; + if (s) { + Printf (port, s); + Print_Object (Car (Cdr (list)), port, raw, + depth < 0 ? depth : depth-1, length); + GC_Unlink; + return; + } + } + Print_Char (port, '('); + for (len = 0; !Nullp (list); len++, list = tail) { + if (length >= 0 && len >= length) { + Printf (port, "..."); + break; + } + Print_Object (Car (list), port, raw, depth < 0 ? depth : depth-1, + length); + tail = Cdr (list); + if (!Nullp (tail)) { + if (TYPE(tail) == T_Pair) + Print_Char (port, ' '); + else { + Printf (port, " . "); + Print_Object (tail, port, raw, depth < 0 ? depth : depth-1, + length); + break; + } + } + } + Print_Char (port, ')'); + GC_Unlink; +} + +Pr_Vector (port, vec, raw, depth, length) Object port, vec; + register raw, depth, length; { + register i, j; + GC_Node2; + + if (depth == 0) { + Printf (port, "&"); + return; + } + GC_Link2 (port, vec); + Printf (port, "#("); + for (i = 0, j = VECTOR(vec)->size; i < j; i++) { + if (i) Print_Char (port, ' '); + if (length >= 0 && i >= length) { + Printf (port, "..."); + break; + } + Print_Object (VECTOR(vec)->data[i], port, raw, + depth < 0 ? depth : depth-1, length); + } + Print_Char (port, ')'); + GC_Unlink; +} + +Pr_Symbol (port, sym, raw) Object port, sym; { + Object str; + register c, i; + GC_Node2; + + str = SYMBOL(sym)->name; + if (raw) { + Pr_String (port, str, raw); + return; + } + GC_Link2 (port, str); + for (i = 0; i < STRING(str)->size; i++) { + c = STRING(str)->data[i]; + switch (c) { + case '\\': case ';': case '#': case '(': case ')': + case '\'': case '`': case ',': case '"': case '.': + case '\t': case '\n': case ' ': + Print_Char (port, '\\'); + Print_Char (port, c); + break; + default: + if (c < ' ' || c >= '\177') + Print_Special (port, c); + else + Print_Char (port, c); + } + } + GC_Unlink; +} + +Pr_String (port, str, raw) Object port, str; { + register char *p = STRING(str)->data; + register c, i, len = STRING(str)->size; + GC_Node2; + + if (raw) { + if (PORT(port)->flags & P_STRING) { + Print_String (port, p, len); + } else { + if (fwrite (p, 1, len, PORT(port)->file) != len) { + Saved_Errno = errno; /* errno valid here? */ + Primitive_Error ("write error on ~s: ~E", port); + } + } + return; + } + GC_Link2 (port, str); + Print_Char (port, '"'); + for (i = 0; i < STRING(str)->size; i++) { + c = STRING(str)->data[i]; + if (c == '\\' || c == '"') + Print_Char (port, '\\'); + if (c < ' ' || c >= '\177') + Print_Special (port, c); + else + Print_Char (port, c); + } + Print_Char (port, '"'); + GC_Unlink; +} + +Print_Special (port, c) Object port; register c; { + register char *fmt = "\\%c"; + + switch (c) { + case '\b': c = 'b'; break; + case '\t': c = 't'; break; + case '\r': c = 'r'; break; + case '\n': c = 'n'; break; + default: + fmt = "\\%03o"; + } + Printf (port, fmt, (unsigned char)c); +} + +Object P_Format (argc, argv) Object *argv; { + Object port, str; + register stringret = 0; + GC_Node; + + port = argv[0]; + if (TYPE(port) == T_Boolean) { + if (Truep (port)) { + port = Curr_Output_Port; + } else { + stringret++; + port = P_Open_Output_String (); + } + } else if (TYPE(port) == T_Port) { + Check_Output_Port (port); + } else Wrong_Type_Combination (port, "port or #t or #f"); + str = argv[1]; + Check_Type (str, T_String); + GC_Link (port); + Format (port, STRING(str)->data, STRING(str)->size, argc-2, argv+2); + GC_Unlink; + return stringret ? P_Get_Output_String (port) : Void; +} + +Format (port, fmt, len, argc, argv) Object port; const char *fmt; + int len; Object *argv; { + register const char *s, *ep; + char *p; + register c; + char buf[256]; + extern sys_nerr; +#ifndef __bsdi__ + extern char *sys_errlist[]; +#endif + GC_Node; + Alloca_Begin; + + GC_Link (port); + Alloca (p, char*, len); + bcopy (fmt, p, len); + for (ep = p + len; p < ep; p++) { + if (*p == '~') { + if (++p == ep) break; + if ((c = *p) == '~') { + Print_Char (port, c); + } else if (c == '%') { + Print_Char (port, '\n'); + } else if (c == 'e' || c == 'E') { + if (Saved_Errno > 0 && Saved_Errno < sys_nerr) { + s = sys_errlist[Saved_Errno]; + sprintf (buf, "%c%s", isupper (*s) ? tolower (*s) : + *s, s+1); + } else { + sprintf (buf, "error %d", Saved_Errno); + } + Print_Object (Make_String (buf, strlen (buf)), port, + c == 'E', 0, 0); + } else { + if (--argc < 0) + Primitive_Error ("too few arguments"); + if (c == 's' || c == 'a') { + Print_Object (*argv, port, c == 'a', Print_Depth (), + Print_Length ()); + argv++; + } else if (c == 'c') { + Check_Type (*argv, T_Character); + Print_Char (port, CHAR(*argv)); + argv++; + } else Print_Char (port, c); + } + } else { + Print_Char (port, *p); + } + } + Alloca_End; + GC_Unlink; +} diff --git a/src/proc.c b/src/proc.c new file mode 100644 index 0000000..f4795ff --- /dev/null +++ b/src/proc.c @@ -0,0 +1,560 @@ +/* Eval, funcall, apply, map, lambda, etc. The main-loop of the + * Scheme evaluator. + */ + +#include "kernel.h" + +#ifdef USE_ALLOCA +# define MAX_ARGS_ON_STACK 4 +#else +# define MAX_ARGS_ON_STACK 8 +#endif + +#define Get_Arglist_Length(_cnt, _lst, _x) \ + for (_cnt = 0, _x = _lst; TYPE(_x) == T_Pair; _x = Cdr (_x), _cnt++) \ + ; \ + if (!Nullp(_x)) \ + Primitive_Error("improper argument list"); \ + +#define Funcall_Switch(t,func,args,eval) \ + if (t == T_Primitive) {\ + return Funcall_Primitive (func, args, eval);\ + } else if (t == T_Compound) {\ + return Funcall_Compound (func, args, eval);\ + } else if (t == T_Control_Point) {\ + Funcall_Control_Point (func, args, eval);\ + } else Primitive_Error ("application of non-procedure: ~s", func);\ + + +/* Tail_Call indicates whether we are executing the last form in a + * sequence of forms. If it is true and we are about to call a compound + * procedure, we are allowed to check whether a tail-call can be + * performed instead. + */ +int Tail_Call = 0; + +Object Sym_Lambda, + Sym_Macro; + +static Object tc_fun, tc_argl, tc_env; + +Object Macro_Expand(), Funcall_Primitive(), Funcall_Compound(); + +Init_Proc () { + Define_Symbol (&Sym_Lambda, "lambda"); + Define_Symbol (&Sym_Macro, "macro"); +} + +Check_Procedure (x) Object x; { + register t = TYPE(x); + + if (t != T_Primitive && t != T_Compound) + Wrong_Type_Combination (x, "procedure"); + if (t == T_Primitive && PRIM(x)->disc == NOEVAL) + Primitive_Error ("invalid procedure: ~s", x); +} + +Object P_Procedurep (x) Object x; { + register t = TYPE(x); + return t == T_Primitive || t == T_Compound || t == T_Control_Point + ? True : False; +} + +Object P_Primitivep (x) Object x; { + return TYPE(x) == T_Primitive ? True : False; +} + +Object P_Compoundp (x) Object x; { + return TYPE(x) == T_Compound ? True : False; +} + +Object P_Macrop (x) Object x; { + return TYPE(x) == T_Macro ? True : False; +} + +Object Make_Compound () { + Object proc; + + proc = Alloc_Object (sizeof (struct S_Compound), T_Compound, 0); + COMPOUND(proc)->closure = COMPOUND(proc)->env = COMPOUND(proc)->name = Null; + return proc; +} + +Object Make_Primitive (fun, name, min, max, disc) Object (*fun)(); + const char *name; enum discipline disc; { + Object prim; + register struct S_Primitive *pr; + + prim = Alloc_Object (sizeof (struct S_Primitive), T_Primitive, 0); + pr = PRIM(prim); + pr->tag = Null; + pr->fun = fun; + pr->name = name; + pr->minargs = min; + pr->maxargs = max; + pr->disc = disc; + return prim; +} + +Object Eval (form) Object form; { + register t; + register struct S_Symbol *sym; + Object fun, binding, ret; + static unsigned tick; + GC_Node; + TC_Prolog; + +again: + t = TYPE(form); + if (t == T_Symbol) { + sym = SYMBOL(form); + if (TYPE(sym->value) == T_Unbound) { + binding = Lookup_Symbol (form, 1); + sym->value = Cdr (binding); + } + ret = sym->value; + if (TYPE(ret) == T_Autoload) + ret = Do_Autoload (form, ret); + return ret; + } + if (t != T_Pair) { + if (t == T_Null) + Primitive_Error ("no subexpression in procedure call"); + if (t == T_Vector) + Primitive_Error ("unevaluable object: ~s", form); + return form; + } + if ((tick++ & 7) == 0) + if (Stack_Size () > Max_Stack) + Uncatchable_Error ("Out of stack space"); + /* + * Avoid recursive Eval() for the most common case: + */ + fun = Car (form); + if (TYPE(fun) != T_Symbol || + (fun = SYMBOL(fun)->value, TYPE(fun) == T_Unbound) || + TYPE(fun) == T_Autoload) { + GC_Link (form); + TC_Disable; + fun = Eval (Car (form)); + TC_Enable; + GC_Unlink; + } + form = Cdr (form); + t = TYPE(fun); + if (t == T_Macro) { + form = Macro_Expand (fun, form); + goto again; + } + Funcall_Switch (t, fun, form, 1); + /*NOTREACHED*/ +} + +Object P_Eval (argc, argv) Object *argv; { + Object ret, oldenv; + GC_Node; + + if (argc == 1) + return Eval (argv[0]); + Check_Type (argv[1], T_Environment); + oldenv = The_Environment; + GC_Link (oldenv); + Switch_Environment (argv[1]); + ret = Eval (argv[0]); + Switch_Environment (oldenv); + GC_Unlink; + return ret; +} + +Object P_Apply (argc, argv) Object *argv; { + Object ret, list, tail, cell, last; + register i; + GC_Node3; + + Check_Procedure (argv[0]); + /* Make a list of all args but the last, then append the + * last arg (which must be a proper list) to this list. + */ + list = tail = last = Null; + GC_Link3 (list, tail, last); + for (i = 1; i < argc-1; i++, tail = cell) { + cell = Cons (argv[i], Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + } + for (last = argv[argc-1]; !Nullp (last); last = Cdr (last), tail = cell) { + cell = Cons (P_Car (last), Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + } + ret = Funcall (argv[0], list, 0); + GC_Unlink; + return ret; +} + +Object Funcall_Primitive (fun, argl, eval) Object fun, argl; { + register struct S_Primitive *prim; + register argc, i; + const char *last_tag; + register Object *argv; + Object abuf[MAX_ARGS_ON_STACK], r, e; + GC_Node4; GCNODE gcv; + TC_Prolog; + Alloca_Begin; + + prim = PRIM(fun); + last_tag = Error_Tag; /* avoid function calls here */ + Error_Tag = prim->name; + Get_Arglist_Length (argc, argl, r); /* r is temporary variable */ + if (argc < prim->minargs + || (prim->maxargs != MANY && argc > prim->maxargs)) + Primitive_Error ("wrong number of arguments"); + + e = The_Environment; + GC_Link4_Tag_Primitive (argl, fun, e, r); + + if (prim->disc == NOEVAL) { + r = (prim->fun)(argl); + } else { + TC_Disable; + /* + * Skip the loop if argc==0 or argc==1 (special case below). + */ + if (prim->disc != EVAL || argc >= 2) { + if (argc <= MAX_ARGS_ON_STACK) + argv = abuf; + else + Alloca (argv, Object*, argc * sizeof (Object)); + gcv.gclen = 1; gcv.gcobj = argv; gcv.next = &gc4; GC_List = &gcv; + for (r = argl, i = 0; i < argc; i++, r = Cdr (r)) { + argv[i] = eval ? Eval (Car (r)) : Car (r); + gcv.gclen++; + } + TC_Enable; + prim = PRIM(fun); /* fun has possibly been moved during gc */ + } + if (prim->disc == VARARGS) { + r = (prim->fun)(argc, argv); + } else { + switch (argc) { + case 0: + r = (prim->fun)(); break; + case 1: + TC_Disable; + r = eval ? Eval (Car (argl)) : Car (argl); + TC_Enable; + r = (PRIM(fun)->fun)(r); + break; + case 2: + r = (prim->fun)(argv[0], argv[1]); break; + case 3: + r = (prim->fun)(argv[0], argv[1], argv[2]); break; + case 4: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3]); break; + case 5: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4]); + break; + case 6: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5]); break; + case 7: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5], argv[6]); break; + case 8: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5], argv[6], argv[7]); break; + case 9: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5], argv[6], argv[7], argv[8]); break; + case 10: + r = (prim->fun)(argv[0], argv[1], argv[2], argv[3], argv[4], + argv[5], argv[6], argv[7], argv[8], argv[9]); + break; + default: + Panic ("too many args for primitive"); + } + } + Alloca_End; + } + GC_Unlink; + Error_Tag = last_tag; + return r; +} + +/* This macro is used by Funcall_Compound() below. Note that + * if we are in a tail recursion, we are reusing the old procedure + * frame; we just assign new values to the formal parameters. + * Add_Binding() has been inlined here for speed. r is used as + * a temporary variable. + */ +#define Lambda_Bind(var,val) {\ + r = Cons (var, val);\ + if (tail_calling)\ + newframe = Cons (r, newframe);\ + else\ + frame = Cons (r, frame);\ +} + +Object Funcall_Compound (fun, argl, eval) Object fun, argl; { + register argc, min, max, i, tail_calling = 0; + register Object *argv; + Object abuf[MAX_ARGS_ON_STACK], rest, r, frame, tail, + tail_call_env, oldenv, newframe; + register GCNODE *p; + GC_Node7; GCNODE gcv; + Alloca_Begin; + + if (Tail_Call && eval) { + for (p = GC_List; p && p->gclen != TAG_FUN; p = p->next) { + if (p->gclen == TAG_TCFUN && EQ(*(p->gcobj), fun)) { + SET(r, T_Special, 0); + tc_fun = fun; tc_argl = argl; tc_env = The_Environment; + return r; + } + } + } + r = frame = tail = newframe = Null; + oldenv = The_Environment; + GC_Link7_Tag_Compound (argl, fun, oldenv, frame, tail, newframe, r); +again: + Get_Arglist_Length (argc, argl, r); /* r is temporary variable here */ + min = COMPOUND(fun)->min_args; + max = COMPOUND(fun)->max_args; + if (argc < min) + Primitive_Error ("too few arguments for ~s", fun); + if (max >= 0 && argc > max) + Primitive_Error ("too many arguments for ~s", fun); + if (tail_calling) { + tail = The_Environment; + Switch_Environment (tail_call_env); + } else { + if (argc <= MAX_ARGS_ON_STACK) + argv = abuf; + else + Alloca (argv, Object*, argc * sizeof (Object)); + } + Tail_Call = 0; + gcv.gclen = 1; gcv.gcobj = argv; gcv.next = &gc7; GC_List = &gcv; + for (r = argl, i = 0; i < argc; i++, r = Cdr (r)) { + argv[i] = eval ? Eval (Car (r)) : Car (r); + gcv.gclen++; + } + if (tail_calling) + Switch_Environment (tail); + tail = Car (Cdr (COMPOUND(fun)->closure)); + for (i = 0; i < min; i++, tail = Cdr (tail)) + Lambda_Bind (Car (tail), argv[i]); + if (max == -1) { + rest = P_List (argc-i, argv+i); + Lambda_Bind (tail, rest); + } + if (tail_calling) { + Pop_Frame (); + Push_Frame (newframe); + } else { + Switch_Environment (COMPOUND(fun)->env); + Push_Frame (frame); + } + tail = Cdr (Cdr (COMPOUND(fun)->closure)); + for (i = COMPOUND(fun)->numforms; i > 1; i--, tail = Cdr (tail)) + (void)Eval (Car (tail)); + Tail_Call = 1; + r = Eval (Car (tail)); + /* + * If evaluation of the function body returned a T_Special object, + * a tail-call has been taken place. If it is a tail-call to a + * different function, just return, otherwise unpack new arguments + * and environment and jump to the beginning. + */ + if (TYPE(r) == T_Special && EQ(fun, tc_fun)) { + argl = tc_argl; + tail_call_env = tc_env; + tail_calling = 1; + eval = 1; + newframe = Null; + goto again; + } + Tail_Call = 0; + Pop_Frame (); + Switch_Environment (oldenv); + GC_Unlink; + Alloca_End; + return r; +} + +Object Funcall (fun, argl, eval) Object fun, argl; { + register t = TYPE(fun); + Funcall_Switch (t, fun, argl, eval); + /*NOTREACHED*/ +} + +Check_Formals (x, min, max) Object x; int *min, *max; { + Object s, t1, t2; + + *min = *max = 0; + for (t1 = Car (x); !Nullp (t1); t1 = Cdr (t1)) { + s = TYPE(t1) == T_Pair ? Car (t1) : t1; + Check_Type (s, T_Symbol); + for (t2 = Car (x); !EQ(t2, t1); t2 = Cdr (t2)) + if (EQ(s, Car (t2))) + Primitive_Error ("~s: duplicate variable binding", s); + if (TYPE(t1) != T_Pair) + break; + (*min)++; (*max)++; + } + if (TYPE(t1) == T_Symbol) + *max = -1; + else if (!Nullp (t1)) + Wrong_Type_Combination (t1, "list or symbol"); +} + +Object P_Lambda (argl) Object argl; { + Object proc, closure; + GC_Node2; + + proc = Null; + GC_Link2 (argl, proc); + proc = Make_Compound (); + closure = Cons (Sym_Lambda, argl); + COMPOUND(proc)->closure = closure; + COMPOUND(proc)->env = The_Environment; + COMPOUND(proc)->numforms = Fast_Length (Cdr (argl)); + Check_Formals (argl, &COMPOUND(proc)->min_args, + &COMPOUND(proc)->max_args); + GC_Unlink; + return proc; +} + +Object P_Procedure_Lambda (p) Object p; { + Check_Type (p, T_Compound); + return Copy_List (COMPOUND(p)->closure); +} + +Object P_Procedure_Environment (p) Object p; { + Check_Type (p, T_Compound); + return COMPOUND(p)->env; +} + +Object General_Map (argc, argv, accum) Object *argv; register accum; { + register i; + Object *args; + Object head, list, tail, cell, arglist, val; + GC_Node2; GCNODE gcv; + TC_Prolog; + Alloca_Begin; + + Check_Procedure (argv[0]); + Alloca (args, Object*, (argc-1) * sizeof (Object)); + list = tail = Null; + GC_Link2 (list, tail); + gcv.gclen = argc; gcv.gcobj = args; gcv.next = &gc2; GC_List = &gcv; + while (1) { + for (i = 1; i < argc; i++) { + head = argv[i]; + if (Nullp (head)) { + GC_Unlink; + Alloca_End; + return list; + } + Check_Type (head, T_Pair); + args[i-1] = Car (head); + argv[i] = Cdr (head); + } + arglist = P_List (argc-1, args); + TC_Disable; + val = Funcall (argv[0], arglist, 0); + TC_Enable; + if (!accum) + continue; + cell = Cons (val, Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + tail = cell; + } + /*NOTREACHED*/ +} + +Object P_Map (argc, argv) Object *argv; { + return General_Map (argc, argv, 1); +} + +Object P_For_Each (argc, argv) Object *argv; { + return General_Map (argc, argv, 0); +} + +Object Make_Macro () { + Object mac; + + mac = Alloc_Object (sizeof (struct S_Macro), T_Macro, 0); + MACRO(mac)->body = MACRO(mac)->name = Null; + return mac; +} + +Object P_Macro (argl) Object argl; { + Object mac, body; + GC_Node2; + + mac = Null; + GC_Link2 (argl, mac); + mac = Make_Macro (); + body = Cons (Sym_Macro, argl); + MACRO(mac)->body = body; + Check_Formals (argl, &MACRO(mac)->min_args, &MACRO(mac)->max_args); + GC_Unlink; + return mac; +} + +Object P_Macro_Body (m) Object m; { + Check_Type (m, T_Macro); + return Copy_List (MACRO(m)->body); +} + +Object Macro_Expand (mac, argl) Object mac, argl; { + register argc, min, max, i; + Object frame, r, tail; + GC_Node4; + TC_Prolog; + + frame = tail = Null; + GC_Link4 (argl, frame, tail, mac); + Get_Arglist_Length (argc, argl, r); + min = MACRO(mac)->min_args; + max = MACRO(mac)->max_args; + if (argc < min) + Primitive_Error ("too few arguments for ~s", mac); + if (max >= 0 && argc > max) + Primitive_Error ("too many arguments for ~s", mac); + tail = Car (Cdr (MACRO(mac)->body)); + for (i = 0; i < min; i++, tail = Cdr (tail), argl = Cdr (argl)) + frame = Add_Binding (frame, Car (tail), Car (argl)); + if (max == -1) + frame = Add_Binding (frame, tail, argl); + Push_Frame (frame); + TC_Disable; + r = Begin (Cdr (Cdr (MACRO(mac)->body))); + TC_Enable; + Pop_Frame (); + GC_Unlink; + return r; +} + +Object P_Macro_Expand (form) Object form; { + Object ret, mac; + GC_Node; + + Check_Type (form, T_Pair); + GC_Link (form); + mac = Eval (Car (form)); + if (TYPE(mac) != T_Macro) + ret = form; + else + ret = Macro_Expand (mac, Cdr (form)); + GC_Unlink; + return ret; +} diff --git a/src/promise.c b/src/promise.c new file mode 100644 index 0000000..c1a35bb --- /dev/null +++ b/src/promise.c @@ -0,0 +1,47 @@ +/* Delay and force. + */ + +#include "kernel.h" + +Object P_Promisep (x) Object x; { + return TYPE(x) == T_Promise ? True : False; +} + +Object P_Delay (argl) Object argl; { + Object d; + GC_Node; + + GC_Link (argl); + d = Alloc_Object (sizeof (struct S_Promise), T_Promise, 0); + GC_Unlink; + PROMISE(d)->done = 0; + PROMISE(d)->env = The_Environment; + PROMISE(d)->thunk = Car (argl); + return d; +} + +Object P_Force (d) Object d; { + Object ret, a[2]; + GC_Node; + TC_Prolog; + + Check_Type (d, T_Promise); + if (PROMISE(d)->done) + return PROMISE(d)->thunk; + GC_Link (d); + a[0] = PROMISE(d)->thunk; a[1] = PROMISE(d)->env; + TC_Disable; + ret = P_Eval (2, a); + TC_Enable; + GC_Unlink; + if (PROMISE(d)->done) /* take care of recursive force calls */ + return PROMISE(d)->thunk; + PROMISE(d)->thunk = ret; + PROMISE(d)->done = 1; + return ret; +} + +Object P_Promise_Environment (p) Object p; { + Check_Type (p, T_Promise); + return PROMISE(p)->env; +} diff --git a/src/read.c b/src/read.c new file mode 100644 index 0000000..1eebfe2 --- /dev/null +++ b/src/read.c @@ -0,0 +1,685 @@ +/* Input functions and primitives; the Scheme reader/parser. + */ + +#include "kernel.h" + +#include +#include + +#ifdef FLUSH_TIOCFLUSH +# include +#else +#ifdef FLUSH_TCFLSH +# include +#endif +#endif + +#ifdef FIONREAD_H +# include FIONREAD_H +#endif + +extern char *index(); +extern double atof(); + +Object Sym_Quote, + Sym_Quasiquote, + Sym_Unquote, + Sym_Unquote_Splicing; + +#define Octal(c) ((c) >= '0' && (c) <= '7') + +static READFUN Readers[256]; + +static char *Read_Buf; +static int Read_Size, Read_Max; + +#define Read_Reset() (Read_Size = 0) +#define Read_Store(c) (Read_Size == Read_Max ? \ + (Read_Grow(), Read_Buf[Read_Size++] = (c)) : (Read_Buf[Read_Size++] = (c))) + +static void Read_Grow () { + Read_Max *= 2; + Read_Buf = Safe_Realloc (Read_Buf, Read_Max); +} + +Object General_Read(), Read_Sequence(), Read_Atom(), Read_Special(); +Object Read_String(), Read_Sharp(), Read_True(), Read_False(), Read_Void(); +Object Read_Kludge(), Read_Vector(), Read_Radix(), Read_Char(); + +Init_Read () { + Define_Symbol (&Sym_Quote, "quote"); + Define_Symbol (&Sym_Quasiquote, "quasiquote"); + Define_Symbol (&Sym_Unquote, "unquote"); + Define_Symbol (&Sym_Unquote_Splicing, "unquote-splicing"); + + Readers['t'] = Readers['T'] = Read_True; + Readers['f'] = Readers['F'] = Read_False; + Readers['v'] = Readers['V'] = Read_Void; + Readers['!'] = Read_Kludge; /* for interpreter files */ + Readers['('] = Read_Vector; + Readers['b'] = Readers['B'] = + Readers['o'] = Readers['O'] = + Readers['d'] = Readers['D'] = + Readers['x'] = Readers['X'] = + Readers['e'] = Readers['E'] = + Readers['i'] = Readers['I'] = Read_Radix; + Readers['\\'] = Read_Char; + + Read_Max = 128; + Read_Buf = Safe_Malloc (Read_Max); +} + +String_Getc (port) Object port; { + register struct S_Port *p; + register struct S_String *s; + + p = PORT(port); + if (p->flags & P_UNREAD) { + p->flags &= ~P_UNREAD; + return p->unread; + } + s = STRING(p->name); + return p->ptr >= s->size ? EOF : s->data[p->ptr++]; +} + +String_Ungetc (port, c) Object port; register c; { + PORT(port)->flags |= P_UNREAD; + PORT(port)->unread = c; +} + +Check_Input_Port (port) Object port; { + Check_Type (port, T_Port); + if (!(PORT(port)->flags & P_OPEN)) + Primitive_Error ("port has been closed: ~s", port); + if (!IS_INPUT(port)) + Primitive_Error ("not an input port: ~s", port); +} + +Object P_Clear_Input_Port (argc, argv) Object *argv; { + Discard_Input (argc == 1 ? argv[0] : Curr_Input_Port); + return Void; +} + +Discard_Input (port) Object port; { + register FILE *f; + + Check_Input_Port (port); + if (PORT(port)->flags & P_STRING) + return; + f = PORT(port)->file; +#ifdef FLUSH_FPURGE + (void)fpurge (f); +#else +#ifdef FLUSH_BSD + f->_cnt = 0; + f->_ptr = f->_base; +#endif +#endif +#ifdef FLUSH_TIOCFLUSH + (void)ioctl (fileno (f), TIOCFLUSH, (char *)0); +#else +#ifdef FLUSH_TCFLSH + (void)ioctl (fileno (f), TCFLSH, (char *)0); +#endif +#endif +} + +Object P_Unread_Char (argc, argv) Object *argv; { + Object port, ch; + register struct S_Port *p; + + ch = argv[0]; + Check_Type (ch, T_Character); + port = argc == 2 ? argv[1] : Curr_Input_Port; + Check_Input_Port (port); + p = PORT(port); + if (p->flags & P_STRING) { + if (p->flags & P_UNREAD) + Primitive_Error ("cannot push back more than one char"); + String_Ungetc (port, CHAR(ch)); + } else { + if (ungetc (CHAR(ch), p->file) == EOF) + Primitive_Error ("failed to push back char"); + } + if (CHAR(ch) == '\n' && PORT(port)->lno > 1) PORT(port)->lno--; + return ch; +} + +Object P_Read_Char (argc, argv) Object *argv; { + Object port; + register FILE *f; + register c, str, flags; + + port = argc == 1 ? argv[0] : Curr_Input_Port; + Check_Input_Port (port); + f = PORT(port)->file; + flags = PORT(port)->flags; + str = flags & P_STRING; + Reader_Getc; + Reader_Tweak_Stream; + return c == EOF ? Eof : Make_Char (c); +} + +Object P_Peek_Char (argc, argv) Object *argv; { + Object a[2]; + + a[0] = P_Read_Char (argc, argv); + if (argc == 1) + a[1] = argv[0]; + return EQ(a[0], Eof) ? Eof : P_Unread_Char (argc+1, a); +} + +/* char-ready? cannot be implemented correctly based on FILE pointers. + * The following is only an approximation; even if FIONREAD is supported, + * the primitive may return #f although a call to read-char would not block. + */ +Object P_Char_Readyp (argc, argv) Object *argv; { + Object port; + + port = argc == 1 ? argv[0] : Curr_Input_Port; + Check_Input_Port (port); + if (PORT(port)->flags & P_STRING || feof (PORT(port)->file)) + return True; +#ifdef FIONREAD + { + long num = 0; + (void)ioctl (fileno (PORT(port)->file), FIONREAD, (char *)&num); + if (num != 0) + return True; + } +#endif + return False; +} + +Object P_Read_String (argc, argv) Object *argv; { + Object port; + register FILE *f; + register c, str; + + port = argc == 1 ? argv[0] : Curr_Input_Port; + Check_Input_Port (port); + f = PORT(port)->file; + str = PORT(port)->flags & P_STRING; + Read_Reset (); + while (1) { + Reader_Getc; + if (c == '\n' || c == EOF) + break; + Read_Store (c); + } + Reader_Tweak_Stream; + return c == EOF ? Eof : Make_String (Read_Buf, Read_Size); +} + +Object P_Read (argc, argv) Object *argv; { + return General_Read (argc == 1 ? argv[0] : Curr_Input_Port, 0); +} + +Object General_Read (port, konst) Object port; { + register FILE *f; + register c, str; + Object ret; + + Check_Input_Port (port); + Flush_Output (Curr_Output_Port); + f = PORT(port)->file; + str = PORT(port)->flags & P_STRING; + while (1) { + Reader_Getc; + if (c == EOF) { + ret = Eof; + break; + } + if (Whitespace (c)) + continue; + if (c == ';') { +comment: + if (Skip_Comment (port) == EOF) { + ret = Eof; + break; + } + continue; + } + if (c == '(') { + ret = Read_Sequence (port, 0, konst); + } else if (c == '#') { + ret = Read_Sharp (port, konst); + if (TYPE(ret) == T_Special) /* it was a #! */ + goto comment; + } else { + Reader_Ungetc; + ret = Read_Atom (port, konst); + } + break; + } + Reader_Tweak_Stream; + return ret; +} + +Skip_Comment (port) Object port; { + register FILE *f; + register c, str; + + f = PORT(port)->file; + str = PORT(port)->flags & P_STRING; + do { + Reader_Getc; + } while (c != '\n' && c != EOF); + return c; +} + +Object Read_Atom (port, konst) Object port; { + Object ret; + + ret = Read_Special (port, konst); + if (TYPE(ret) == T_Special) + Reader_Error (port, "syntax error"); + return ret; +} + +Object Read_Special (port, konst) Object port; { + Object ret; + register c, str; + register FILE *f; + +#define READ_QUOTE(sym) \ + ( ret = Read_Atom (port, konst),\ + konst ? (ret = Const_Cons (ret, Null), Const_Cons (sym, ret))\ + : (ret = Cons (ret, Null), Cons (sym, ret))) + + f = PORT(port)->file; + str = PORT(port)->flags & P_STRING; +again: + Reader_Getc; + switch (c) { + case EOF: +eof: + Reader_Tweak_Stream; + Reader_Error (port, "premature end of file"); + case ';': + if (Skip_Comment (port) == EOF) + goto eof; + goto again; + case ')': + SET(ret, T_Special, c); + return ret; + case '(': + return Read_Sequence (port, 0, konst); + case '\'': + return READ_QUOTE(Sym_Quote); + case '`': + return READ_QUOTE(Sym_Quasiquote); + case ',': + Reader_Getc; + if (c == EOF) + goto eof; + if (c == '@') { + return READ_QUOTE(Sym_Unquote_Splicing); + } else { + Reader_Ungetc; + return READ_QUOTE(Sym_Unquote); + } + case '"': + return Read_String (port, konst); + case '#': + ret = Read_Sharp (port, konst); + if (TYPE(ret) == T_Special) + goto again; + return ret; + default: + if (Whitespace (c)) + goto again; + Read_Reset (); + if (c == '.') { + Reader_Getc; + if (c == EOF) + goto eof; + if (Whitespace (c)) { + Reader_Ungetc; + SET(ret, T_Special, '.'); + return ret; + } + Read_Store ('.'); + } + while (!Whitespace (c) && !Delimiter (c) && c != EOF) { + if (c == '\\') { + Reader_Getc; + if (c == EOF) + break; + } + Read_Store (c); + Reader_Getc; + } + Read_Store ('\0'); + if (c != EOF) + Reader_Ungetc; + ret = Parse_Number (port, Read_Buf, 10); + if (Nullp (ret)) + ret = Intern (Read_Buf); + return ret; + } + /*NOTREACHED*/ +} + +Object Read_Sequence (port, vec, konst) Object port; { + Object ret, e, tail, t; + GC_Node3; + + ret = tail = Null; + GC_Link3 (ret, tail, port); + while (1) { + e = Read_Special (port, konst); + if (TYPE(e) == T_Special) { + if (CHAR(e) == ')') { + GC_Unlink; + return ret; + } + if (vec) + Reader_Error (port, "wrong syntax in vector"); + if (CHAR(e) == '.') { + if (Nullp (tail)) { + ret = Read_Atom (port, konst); + } else { + e = Read_Atom (port, konst); + /* + * Possibly modifying pure cons. Must be fixed! + */ + Cdr (tail) = e; + } + e = Read_Special (port, konst); + if (TYPE(e) == T_Special && CHAR(e) == ')') { + GC_Unlink; + return ret; + } + Reader_Error (port, "dot in wrong context"); + } + Reader_Error (port, "syntax error"); + } + if (konst) t = Const_Cons (e, Null); else t = Cons (e, Null); + if (!Nullp (tail)) + /* + * Possibly modifying pure cons. Must be fixed! + */ + Cdr (tail) = t; + else + ret = t; + tail = t; + } + /*NOTREACHED*/ +} + +Object Read_String (port, konst) Object port; { + register FILE *f; + register n, c, oc, str; + + Read_Reset (); + f = PORT(port)->file; + str = PORT(port)->flags & P_STRING; + while (1) { + Reader_Getc; + if (c == EOF) { +eof: + Reader_Tweak_Stream; + Reader_Error (port, "end of file in string"); + } + if (c == '\\') { + Reader_Getc; + switch (c) { + case EOF: goto eof; + case 'b': c = '\b'; break; + case 't': c = '\t'; break; + case 'r': c = '\r'; break; + case 'n': c = '\n'; break; + case '0': case '1': case '2': case '3': + case '4': case '5': case '6': case '7': + oc = n = 0; + do { + oc <<= 3; oc += c - '0'; + Reader_Getc; + if (c == EOF) goto eof; + } while (Octal (c) && ++n <= 2); + Reader_Ungetc; + c = oc; + } + } else if (c == '"') + break; + Read_Store (c); + } + return General_Make_String (Read_Buf, Read_Size, konst); +} + +Object Read_Sharp (port, konst) Object port; { + int c, str; + FILE *f; + char buf[32]; + + f = PORT(port)->file; + str = PORT(port)->flags & P_STRING; + Reader_Getc; + if (c == EOF) + Reader_Sharp_Eof; + if (!Readers[c]) { + sprintf (buf, "no reader for syntax #%c", c); + Reader_Error (port, buf); + } + return Readers[c](port, c, konst); +} + +/*ARGSUSED*/ +Object Read_True (port, chr, konst) Object port; { + return True; +} + +/*ARGSUSED*/ +Object Read_False (port, chr, konst) Object port; { + return False; +} + +/*ARGSUSED*/ +Object Read_Void (port, chr, konst) Object port; { + Object ret; + + ret = Const_Cons (Void, Null); + return Const_Cons (Sym_Quote, ret); +} + +/*ARGSUSED*/ +Object Read_Kludge (port, chr, konst) Object port; { + return Special; +} + +/*ARGSUSED*/ +Object Read_Vector (port, chr, konst) Object port; { + return List_To_Vector (Read_Sequence (port, 1, konst), konst); +} + +/*ARGSUSED*/ +Object Read_Radix (port, chr, konst) Object port; { + int c, str; + FILE *f; + Object ret; + + Read_Reset (); + f = PORT(port)->file; + str = PORT(port)->flags & P_STRING; + Read_Store ('#'); Read_Store (chr); + while (1) { + Reader_Getc; + if (c == EOF) + Reader_Sharp_Eof; + if (Whitespace (c) || Delimiter (c)) + break; + Read_Store (c); + } + Reader_Ungetc; + Read_Store ('\0'); + ret = Parse_Number (port, Read_Buf, 10); + if (Nullp (ret)) + Reader_Error (port, "radix not followed by a valid number"); + return ret; +} + +/*ARGSUSED*/ +Object Read_Char (port, chr, konst) Object port; { + int c, str; + FILE *f; + char buf[10], *p = buf; + + f = PORT(port)->file; + str = PORT(port)->flags & P_STRING; + Reader_Getc; + if (c == EOF) + Reader_Sharp_Eof; + *p++ = c; + while (1) { + Reader_Getc; + if (c == EOF) + Reader_Sharp_Eof; + if (Whitespace (c) || Delimiter (c)) + break; + if (p == buf+9) + Reader_Error (port, "syntax error in character constant"); + *p++ = c; + } + Reader_Ungetc; + if (p == buf+1) + return Make_Char (*buf); + *p = '\0'; + if (p == buf+3) { + for (c = 0, p = buf; p < buf+3 && Octal (*p); p++) + c = c << 3 | (*p - '0'); + if (p == buf+3) + return Make_Char (c); + } + for (p = buf; *p; p++) + if (isupper (*p)) + *p = tolower (*p); + if (strcmp (buf, "space") == 0) + return Make_Char (' '); + if (strcmp (buf, "newline") == 0) + return Make_Char ('\n'); + if (strcmp (buf, "return") == 0) + return Make_Char ('\r'); + if (strcmp (buf, "tab") == 0) + return Make_Char ('\t'); + if (strcmp (buf, "formfeed") == 0) + return Make_Char ('\f'); + if (strcmp (buf, "backspace") == 0) + return Make_Char ('\b'); + Reader_Error (port, "syntax error in character constant"); + /*NOTREACHED*/ +} + +void Define_Reader (c, fun) READFUN fun; { + if (Readers[c] && Readers[c] != fun) + Primitive_Error ("reader for `~a' already defined", Make_Char (c)); + Readers[c] = fun; +} + +Object Parse_Number (port, buf, radix) Object port; const char *buf; { + const char *p; + int c, i; + int mdigit = 0, edigit = 0, expo = 0, neg = 0, point = 0; + int gotradix = 0, exact = 0, inexact = 0; + unsigned max; + int maxdig; + Object ret; + + for ( ; *buf == '#'; buf++) { + switch (*++buf) { + case 'b': case 'B': + if (gotradix++) return Null; + radix = 2; + break; + case 'o': case 'O': + if (gotradix++) return Null; + radix = 8; + break; + case 'd': case 'D': + if (gotradix++) return Null; + radix = 10; + break; + case 'x': case 'X': + if (gotradix++) return Null; + radix = 16; + break; + case 'e': case 'E': + if (exact++ || inexact) return Null; + break; + case 'i': case 'I': + if (inexact++ || exact) return Null; + break; + default: + return Null; + } + } + p = buf; + if (*p == '+' || (neg = *p == '-')) + p++; + for ( ; c = *p; p++) { + if (c == '.') { + if (expo || point++) + return Null; + } else if (radix != 16 && (c == 'e' || c == 'E')) { + if (expo++) + return Null; + if (p[1] == '+' || p[1] == '-') + p++; + } else if (radix == 16 && !index ("0123456789abcdefABCDEF", c)) { + return Null; + } else if (radix < 16 && (c < '0' || c > '0' + radix-1)) { + return Null; + } else { + if (expo) edigit++; else mdigit++; + } + } + if (!mdigit || (expo && !edigit)) + return Null; + if (point || expo) { + if (radix != 10) { + if (Nullp (port)) + return Null; + Reader_Error (port, "reals must be given in decimal"); + } + /* Lacking ratnums, there's nothing we can do if #e has been + * specified-- just return the inexact number. + */ + return Make_Flonum (atof (buf)); + } + max = (neg ? -(unsigned)INT_MIN : INT_MAX); + maxdig = max % radix; + max /= radix; + for (i = 0, p = buf; c = *p; p++) { + if (c == '-' || c == '+') { + buf++; + continue; + } + if (radix == 16) { + if (isupper (c)) + c = tolower (c); + if (c >= 'a') + c = '9' + c - 'a' + 1; + } + c -= '0'; + if ((unsigned)i > max || (unsigned)i == max && c > maxdig) { + ret = Make_Bignum (buf, neg, radix); + return inexact ? Make_Flonum (Bignum_To_Double (ret)) : ret; + } + i *= radix; i += c; + } + if (neg) + i = -i; + return inexact ? Make_Flonum ((double)i) : Make_Integer (i); +} + +Reader_Error (port, msg) Object port; char *msg; { + char buf[100]; + + if (PORT(port)->flags & P_STRING) { + sprintf (buf, "[string-port]: %u: %s", PORT(port)->lno, msg); + Primitive_Error (buf); + } else { + sprintf (buf, "~s: %u: %s", PORT(port)->lno, msg); + Primitive_Error (buf, PORT(port)->name); + } +} diff --git a/src/special.c b/src/special.c new file mode 100644 index 0000000..a8e07dc --- /dev/null +++ b/src/special.c @@ -0,0 +1,498 @@ +/* Special forms. + */ + +#include "kernel.h" + +Object Sym_Else; + +Init_Special () { + Define_Symbol (&Sym_Else, "else"); +} + +Object P_Quote (argl) Object argl; { + return Car (argl); +} + +Object Quasiquote (x, level) Object x; { + Object form, list, tail, cell, qcar, qcdr, ret; + TC_Prolog; + + if (TYPE(x) == T_Vector) { /* Inefficient, but works. */ + x = P_Vector_To_List (x); + x = Quasiquote (x, level); + return P_List_To_Vector (x); + } + if (TYPE(x) != T_Pair) + return x; + if (EQ(Car (x), Sym_Unquote)) { + x = Cdr (x); + if (TYPE(x) != T_Pair) + Primitive_Error ("bad unquote form: ~s", x); + if (level) { + ret = Cons (Car (x), Null); + ret = Quasiquote (ret, level-1); + ret = Cons (Sym_Unquote, ret); + } else { + TC_Disable; + ret = Eval (Car (x)); + TC_Enable; + } + return ret; + } else if (TYPE(Car (x)) == T_Pair + && EQ(Car (Car (x)), Sym_Unquote_Splicing)) { + GC_Node6; + + qcdr = Cdr (x); + form = list = tail = cell = Null; + x = Car (x); + if (TYPE(Cdr (x)) != T_Pair) + Primitive_Error ("bad unquote-splicing form: ~s", x); + if (level) { + GC_Link2 (list, qcdr); + list = Quasiquote (Cdr (x), level-1); + list = Cons (Sym_Unquote_Splicing, list); + qcdr = Quasiquote (qcdr, level); + list = Cons (list, qcdr); + GC_Unlink; + return list; + } + GC_Link6 (x, qcdr, form, list, tail, cell); + TC_Disable; + form = Eval (Car (Cdr (x))); + TC_Enable; + for ( ; TYPE(form) == T_Pair; tail = cell, form = Cdr (form)) { + cell = Cons (Car (form), Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + } + qcdr = Quasiquote (qcdr, level); + GC_Unlink; + if (Nullp (list)) + return qcdr; + (void)P_Set_Cdr (tail, qcdr); + return list; + } else { + GC_Node3; + + qcar = qcdr = Null; + GC_Link3 (x, qcar, qcdr); + if (EQ(Car (x), Sym_Quasiquote)) /* hack! */ + ++level; + qcar = Quasiquote (Car (x), level); + qcdr = Quasiquote (Cdr (x), level); + list = Cons (qcar, qcdr); + GC_Unlink; + return list; + } +} + +Object P_Quasiquote (argl) Object argl; { + return Quasiquote (Car (argl), 0); +} + +Object P_Begin (forms) Object forms; { + GC_Node; + TC_Prolog; + + if (Nullp (forms)) + return Null; + GC_Link (forms); + TC_Disable; + for ( ; !Nullp (Cdr (forms)); forms = Cdr (forms)) + (void)Eval (Car (forms)); + GC_Unlink; + TC_Enable; + return Eval (Car (forms)); +} + +Object P_Begin1 (forms) Object forms; { + register n; + Object r, ret; + GC_Node; + TC_Prolog; + + GC_Link (forms); + TC_Disable; + for (n = 1; !Nullp (Cdr (forms)); n = 0, forms = Cdr (forms)) { + r = Eval (Car (forms)); + if (n) + ret = r; + } + GC_Unlink; + TC_Enable; + r = Eval (Car (forms)); + return n ? r : ret; +} + +Object P_If (argl) Object argl; { + Object cond, ret; + GC_Node; + TC_Prolog; + + GC_Link (argl); + TC_Disable; + cond = Eval (Car (argl)); + TC_Enable; + argl = Cdr (argl); + if (Truep (cond)) { + ret = Eval (Car (argl)); + } else { + /* Special case: avoid calling Begin() for zero/one-form else-part. + */ + argl = Cdr (argl); + if (Nullp (argl)) + ret = Null; + else if (Nullp (Cdr (argl))) + ret = Eval (Car (argl)); + else + ret = Begin (argl); + } + GC_Unlink; + return ret; +} + +Object P_Case (argl) Object argl; { + Object ret, key, clause, select; + GC_Node; + TC_Prolog; + + GC_Link (argl); + ret = False; + TC_Disable; + key = Eval (Car (argl)); + for (argl = Cdr (argl); !Nullp (argl); argl = Cdr (argl)) { + clause = Car (argl); + Check_List (clause); + if (Nullp (clause)) + Primitive_Error ("empty clause"); + select = Car (clause); + if (EQ(select, Sym_Else)) { + if (!Nullp (Cdr (argl))) + Primitive_Error ("`else' not in last clause"); + if (Nullp (Cdr (clause))) + Primitive_Error ("no forms in `else' clause"); + } else if (TYPE(select) == T_Pair) { + select = P_Memv (key, select); + } else + select = P_Eqv (key, select); + if (Truep (select)) { + clause = Cdr (clause); + TC_Enable; + ret = Nullp (clause) ? True : Begin (clause); + break; + } + } + TC_Enable; + GC_Unlink; + return ret; +} + +Object P_Cond (argl) Object argl; { + Object ret, clause, guard; + int else_clause = 0; + GC_Node3; + TC_Prolog; + + ret = False; + clause = guard = Null; + GC_Link3 (argl, clause, guard); + TC_Disable; + for ( ; !Nullp (argl); argl = Cdr (argl)) { + clause = Car (argl); + Check_List (clause); + if (Nullp (clause)) + Primitive_Error ("empty clause"); + guard = Car (clause); + if (EQ(guard, Sym_Else)) { + if (!Nullp (Cdr (argl))) + Primitive_Error ("`else' not in last clause"); + if (Nullp (Cdr (clause))) + Primitive_Error ("no forms in `else' clause"); + else_clause++; + } else + guard = Eval (Car (clause)); + if (Truep (guard)) { + clause = Cdr (clause); + if (!else_clause && !Nullp (clause) && + EQ(Car (clause), Intern ("=>"))) { + clause = Cdr (clause); + if (Nullp (clause) || !Nullp (Cdr (clause))) + Primitive_Error ("syntax error after =>"); + clause = Eval (Car (clause)); + Check_Procedure (clause); + guard = Cons (guard, Null); + TC_Enable; + ret = Funcall (clause, guard, 0); + } else { + TC_Enable; + ret = Nullp (clause) ? guard : Begin (clause); + } + break; + } + } + TC_Enable; + GC_Unlink; + return ret; +} + +Object General_Junction (argl, and) Object argl; register and; { + Object ret; + GC_Node; + TC_Prolog; + + ret = and ? True : False; + if (Nullp (argl)) + return ret; + GC_Link (argl); + TC_Disable; + for ( ; !Nullp (Cdr (argl)); argl = Cdr (argl)) { + ret = Eval (Car (argl)); + if (and != Truep (ret)) + break; + } + TC_Enable; + if (Nullp (Cdr (argl))) + ret = Eval (Car (argl)); + GC_Unlink; + return ret; +} + +Object P_And (argl) Object argl; { + return General_Junction (argl, 1); +} + +Object P_Or (argl) Object argl; { + return General_Junction (argl, 0); +} + +Object P_Do (argl) Object argl; { + Object tail, b, val, test, frame, newframe, len, ret; + register local_vars; + GC_Node6; + TC_Prolog; + + b = test = frame = newframe = Null; + GC_Link6 (argl, tail, b, test, frame, newframe); + TC_Disable; + for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { + Check_List (tail); + b = Car (tail); + if (Nullp (b)) + Primitive_Error ("bad initialization form"); + val = P_Cdr (b); + Check_List (val); + b = Car (b); + Check_Type (b, T_Symbol); + if (!Nullp (val)) + val = Eval (Car (val)); + test = Assq (b, frame); + if (!EQ(test, False)) + Primitive_Error ("~s: duplicate variable binding", b); + frame = Add_Binding (frame, b, val); + } + if (local_vars = !Nullp (frame)) + Push_Frame (frame); + test = Car (Cdr (argl)); + Check_Type (test, T_Pair); + while (1) { + b = Eval (Car (test)); + if (Truep (b)) + break; + (void)Begin (Cdr (Cdr (argl))); + if (!local_vars) + continue; + newframe = Null; + for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { + b = Car (tail); + val = Cdr (b); + len = P_Length (val); + val = FIXNUM(len) > 1 ? Car (Cdr (val)) : Car (b); + val = Eval (val); + newframe = Add_Binding (newframe, Car (b), val); + } + Pop_Frame (); + Push_Frame (newframe); + } + Check_List (Cdr (test)); + TC_Enable; + ret = Begin (Cdr (test)); + if (local_vars) + Pop_Frame (); + GC_Unlink; + return ret; +} + +Object General_Let (argl, disc) Object argl; { + Object frame, b, binding, val, tail, ret; + GC_Node5; + TC_Prolog; + + frame = b = val = Null; + GC_Link5 (argl, frame, b, val, tail); + TC_Disable; + for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { + Check_List (tail); + b = Car (tail); + if (Nullp (b)) + Primitive_Error ("bad binding form"); + val = P_Cdr (b); + Check_List (val); + if (!Nullp (val) && !Nullp (Cdr (val))) + Primitive_Error ("bad binding form"); + b = Car (b); + Check_Type (b, T_Symbol); + if (!Nullp (val)) + val = Car (val); + if (disc == 0) { + if (!Nullp (val)) + val = Eval (val); + } else if (disc == 1) { + Push_Frame (frame); + if (!Nullp (val)) + val = Eval (val); + Pop_Frame (); + } else if (disc == 2) + val = Null; + binding = Assq (b, frame); + if (disc != 1 && !EQ(binding, False)) + Primitive_Error ("~s: duplicate variable binding", b); + if (disc == 1 && !EQ(binding, False)) + Cdr (binding) = val; + else + frame = Add_Binding (frame, b, val); + } + Push_Frame (frame); + if (disc == 2) { + for (tail = Car (argl); !Nullp (tail); tail = Cdr (tail)) { + b = Car (tail); + val = Cdr (b); + if (Nullp (val)) + continue; + val = Car (val); + b = Lookup_Symbol (Car (b), 1); + val = Eval (val); + Cdr (b) = val; + SYMBOL(Car (b))->value = val; + } + } + TC_Enable; + ret = Begin (Cdr (argl)); + Pop_Frame (); + GC_Unlink; + return ret; +} + +Object Named_Let (argl) Object argl; { + Object b, val, tail, vlist, vtail, flist, ftail, cell; + GC_Node6; + TC_Prolog; + + tail = vlist = vtail = flist = ftail = Null; + GC_Link6 (argl, tail, vlist, vtail, flist, ftail); + TC_Disable; + for (tail = Car (Cdr (argl)); !Nullp (tail); tail = Cdr (tail)) { + Check_List (tail); + b = Car (tail); + if (Nullp (b)) + Primitive_Error ("bad binding form"); + val = P_Cdr (b); + Check_List (val); + if (Nullp (val) || !Nullp (Cdr (val))) + Primitive_Error ("bad binding form"); + Check_Type (Car (b), T_Symbol); + if (!Nullp (val)) + val = Car (val); + cell = Cons (val, Null); + if (Nullp (flist)) + flist = cell; + else + (void)P_Set_Cdr (ftail, cell); + ftail = cell; + cell = Cons (Car (Car (tail)), Null); + if (Nullp (vlist)) + vlist = cell; + else + (void)P_Set_Cdr (vtail, cell); + vtail = cell; + } + Push_Frame (Add_Binding (Null, Car (argl), Null)); + tail = Cons (vlist, Cdr (Cdr (argl))); + if (Nullp (Cdr (tail))) + Primitive_Error ("no subexpressions in named let"); + tail = P_Lambda (tail); + COMPOUND(tail)->name = Car (argl); + b = Lookup_Symbol (Car (argl), 1); + Cdr (b) = tail; + SYMBOL(Car (argl))->value = tail; + TC_Enable; + tail = Funcall (tail, flist, 1); + Pop_Frame (); + GC_Unlink; + return tail; +} + +Object P_Let (argl) Object argl; { + if (TYPE(Car (argl)) == T_Symbol) + return Named_Let (argl); + else + return General_Let (argl, 0); +} + +Object P_Letseq (argl) Object argl; { + return General_Let (argl, 1); +} + +Object P_Letrec (argl) Object argl; { + return General_Let (argl, 2); +} + +Object Internal_Fluid_Let (bindings, argl) Object bindings, argl; { + Object b, sym, val, vec, ret; + WIND w; + GC_Node5; + + if (Nullp (bindings)) + return Begin (Cdr (argl)); + b = sym = val = Null; + GC_Link5 (bindings, argl, b, sym, val); + Check_List (bindings); + b = Car (bindings); + if (Nullp (b)) + Primitive_Error ("bad binding form"); + sym = Car (b); + val = P_Cdr (b); + Check_List (val); + Check_Type (sym, T_Symbol); + if (!Nullp (val)) + val = Car (val); + if (!Nullp (val)) + val = Eval (val); + b = Lookup_Symbol (sym, 1); + vec = Make_Vector (3, Null); + VECTOR(vec)->data[0] = sym; + VECTOR(vec)->data[1] = The_Environment; + VECTOR(vec)->data[2] = Cdr (b); + Add_Wind (&w, vec, vec); + Cdr (b) = val; + SYMBOL(sym)->value = val; + ret = Internal_Fluid_Let (Cdr (bindings), argl); + Do_Wind (Car (w.inout)); + GC_Unlink; + return ret; +} + +Object P_Fluid_Let (argl) Object argl; { + Object ret; + WIND *first = First_Wind, *last = Last_Wind; + TC_Prolog; + + TC_Disable; + ret = Internal_Fluid_Let (Car (argl), argl); + if (Last_Wind = last) + last->next = 0; + First_Wind = first; + TC_Enable; + return ret; +} diff --git a/src/stab-bsd.c b/src/stab-bsd.c new file mode 100644 index 0000000..fbb672b --- /dev/null +++ b/src/stab-bsd.c @@ -0,0 +1,80 @@ +#include AOUT_H +#include +#include +#include + +extern int errno; + +#ifndef O_BINARY +# define O_BINARY 0 +#endif + +SYMTAB *Snarf_Symbols (f, ep) FILE *f; struct exec *ep; { + SYMTAB *tab; + register SYM *sp, **nextp; + int nsyms, strsiz; + struct nlist nl; + + tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); + tab->first = 0; + tab->strings = 0; + nextp = &tab->first; + (void)fseek (f, (long)N_SYMOFF(*ep), 0); + for (nsyms = ep->a_syms / sizeof (nl); nsyms > 0; nsyms--) { + if (fread ((char *)&nl, sizeof (nl), 1, f) != 1) { + Free_Symbols (tab); + (void)fclose (f); + Primitive_Error ("corrupt symbol table in object file"); + } + if (nl.n_un.n_strx == 0 || nl.n_type & N_STAB) + continue; +#ifndef ibm023 + if ((nl.n_type & N_TYPE) != N_TEXT) + continue; +#endif + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = (char *)nl.n_un.n_strx; + sp->value = nl.n_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; + } + if (fread ((char *)&strsiz, sizeof (strsiz), 1, f) != 1) { +strerr: + Free_Symbols (tab); + (void)fclose (f); + Primitive_Error ("corrupt string table in object file"); + } + if (strsiz <= 4) + goto strerr; + tab->strings = Safe_Malloc (strsiz); + strsiz -= 4; + if (fread (tab->strings+4, 1, strsiz, f) != strsiz) + goto strerr; + for (sp = tab->first; sp; sp = sp->next) + sp->name = tab->strings + (long)sp->name; + return tab; +} + +SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { + struct exec hdr; + int fd; + FILE *fp; + SYMTAB *tab; + + if ((fd = open (name, O_RDONLY|O_BINARY)) == -1) { + Saved_Errno = errno; + Primitive_Error ("can't open a.out file: ~E"); + } + if (read (fd, (char *)&hdr, sizeof hdr) != sizeof hdr) { + close (fd); + Primitive_Error ("can't read a.out header"); + } + if ((fp = fdopen (fd, O_BINARY ? "rb" : "r")) == NULL) { + close (fd); + Primitive_Error ("can't fdopen a.out file"); + } + tab = Snarf_Symbols (fp, &hdr); + (void)fclose (fp); + return tab; +} diff --git a/src/stab-coff.c b/src/stab-coff.c new file mode 100644 index 0000000..7707e6e --- /dev/null +++ b/src/stab-coff.c @@ -0,0 +1,53 @@ +#include +#include +#undef TYPE /* ldfnc.h defines a TYPE macro. */ +#include + +SYMTAB *Snarf_Symbols (lf, ep) LDFILE *lf; { + SYMTAB *tab; + register SYM *sp, **nextp; + SYMENT sym; + long inx; + char *p; + extern char *ldgetname(); + + if (ldtbseek (lf) == FAILURE) { + ldclose (lf); + Primitive_Error ("can't ldtbseek"); + } + tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); + tab->first = 0; + tab->strings = 0; + nextp = &tab->first; + while (1) { + inx = ldtbindex (lf); + if (ldtbread (lf, inx, &sym) == FAILURE) + break; + if (sym.n_scnum == N_UNDEF || sym.n_scnum == N_DEBUG + || sym.n_scnum > HEADER(lf).f_nscns || sym.n_sclass != C_EXT) + continue; + if ((p = ldgetname (lf, &sym)) == NULL) + continue; + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = Safe_Malloc (strlen (p) + 1); + strcpy (sp->name, p); + sp->value = sym.n_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; + } + return tab; +} + +#ifdef INIT_OBJECTS +SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { + LDFILE *f; + SYMTAB *tab; + + if ((f = ldopen (name, NULL)) == FAILURE) + Primitive_Error ("can't ldopen a.out file"); + tab = Snarf_Symbols (f); + ldclose (f); + return tab; +} +#endif /* INIT_OBJECTS */ diff --git a/src/stab-convex.c b/src/stab-convex.c new file mode 100644 index 0000000..54f7dee --- /dev/null +++ b/src/stab-convex.c @@ -0,0 +1,56 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#ifdef INIT_OBJECTS +SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { + int f, n, len = 0; + char *base; + struct filehdr *fhp; + struct opthdr *ohp; + struct nlist *np; + SYMTAB *tab; + SYM *sp, **nextp; + + if ((f = open (name, O_RDONLY)) == -1) { + Saved_Errno = errno; + Primitive_Error ("can't open a.out file: ~E"); + } + if ((base = mmap (0xc0000000, &len, PROT_READ, MAP_FILE, f, (off_t)0)) + == (char *)-1) { + Saved_Errno = errno; + Primitive_Error ("can't mmap a.out file: ~E"); + } + close (f); + fhp = (struct filehdr *)base; + + tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); + tab->first = 0; + tab->strings = Safe_Malloc ((unsigned int)fhp->h_strsiz); + bcopy (base + fhp->h_strptr, tab->strings, (unsigned int)fhp->h_strsiz); + nextp = &tab->first; + + ohp = (struct opthdr *)(base + sizeof *fhp); + np = (struct nlist *)(base + ohp->o_symptr); + for (n = 0; n < ohp->o_nsyms; n++, np++) { + if (np->n_un.n_strx == 0 || np->n_type & N_STAB) + continue; + if ((np->n_type & N_TYPE) != N_TEXT) + continue; + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = tab->strings + np->n_un.n_strx; + sp->value = np->n_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; + } + (void)munmap (base, len); + return tab; +} +#endif diff --git a/src/stab-ecoff.c b/src/stab-ecoff.c new file mode 100644 index 0000000..492427e --- /dev/null +++ b/src/stab-ecoff.c @@ -0,0 +1,104 @@ +/* On the SGI, includes a file that defines a variable named + * auxtemp. This causes the linker to complain about this variable + * being multiply defined, because was already included by + * load.vanilla.c. + */ +#define _auxtemp Auxtemp + +#include AOUT_H + +SYMTAB *Snarf_Symbols (fp) FILE *fp; { + long fdi; /* a counter for the file desc table */ + FDR *file_desc; /* pointer to the filedesc table */ + struct filehdr file_hdr; /* pointer to the file header */ + char *strbase; + HDRR sym_hdr; /* pointer to symbolic header */ + long symi; /* a counter for the local symbol table */ + SYMR *symbol; /* pointer to symbol table */ + + SYMTAB *tab; + char *p; + SYM *sp, **nextp; + + Alloca_Begin; + + /* Read file header and symbolic header + */ + (void)rewind (fp); + if (fread ((char *)&file_hdr, sizeof (file_hdr), 1, fp) == 0) { + fclose (fp); + Primitive_Error ("cannot read a.out file header"); + } + (void)fseek (fp, file_hdr.f_symptr, SEEK_SET); + if (fread ((char *)&sym_hdr, sizeof (sym_hdr), 1, fp) == 0) { + fclose (fp); + Primitive_Error ("cannot read a.out symbolic header"); + } + + tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); + tab->first = 0; + tab->strings = 0; + nextp = &tab->first; + + /* Read symbol table + */ + Alloca (symbol, SYMR*, sym_hdr.isymMax * sizeof (SYMR)); + (void)fseek (fp, sym_hdr.cbSymOffset, SEEK_SET); + if (fread ((char *)symbol, sizeof (SYMR), sym_hdr.isymMax, fp) == 0) { +symerr: + fclose (fp); + Free_Symbols (tab); + Primitive_Error ("cannot read symbol/string/fd table"); + } + + /* Read string table + */ + tab->strings = Safe_Malloc (sym_hdr.issMax); + (void)fseek (fp, sym_hdr.cbSsOffset, SEEK_SET); + if (fread (tab->strings, sym_hdr.issMax, 1, fp) == 0) + goto symerr; + + /* Read file descriptor table + */ + Alloca (file_desc, FDR*, sym_hdr.ifdMax * sizeof (FDR)); + (void)fseek (fp, sym_hdr.cbFdOffset, SEEK_SET); + if (fread ((char *)file_desc, sizeof (FDR), sym_hdr.ifdMax, fp) == 0) + goto symerr; + + /* For each file in the file descriptor table do: + */ + for (fdi = 0; fdi < sym_hdr.ifdMax; fdi++) { + strbase = tab->strings + file_desc[fdi].issBase; + for (symi = file_desc[fdi].isymBase; + symi < file_desc[fdi].csym + file_desc[fdi].isymBase; + symi++) { + if (symbol[symi].st == stProc && symbol[symi].sc == scText) { + p = symbol[symi].iss + strbase; + + /* Allocate and initialize node in the symbol table list; + * link node into list + */ + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = Safe_Malloc (strlen (p) + 1); + strcpy (sp->name, p); + sp->value = symbol[symi].value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; + } + } + } + Alloca_End; + return tab; +} + +SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { + FILE *fp; + SYMTAB *tab; + + if ((fp = fopen (name, "r")) == NULL) + Primitive_Error ("can't open a.out file"); + tab = Snarf_Symbols (fp); + (void)fclose (fp); + return tab; +} diff --git a/src/stab-elf.c b/src/stab-elf.c new file mode 100644 index 0000000..17e528e --- /dev/null +++ b/src/stab-elf.c @@ -0,0 +1,115 @@ +#include +#include +#include +#include + +SYMTAB * +Snarf_Symbols (lf) + int lf; +{ + SYMTAB *tab = NULL; + register SYM *sp, **nextp; + Elf *elf_ptr; + Elf_Scn *elf_scn_ptr = NULL, *symtab_scn_ptr = NULL; + Elf_Data *elf_data_ptr = NULL; + Elf32_Ehdr *elf_ehdr_ptr = NULL; + Elf32_Shdr *elf_shdr_ptr = NULL, + *symtab_ptr = NULL; + size_t elf_str_index, shstrndx; + char *symbol_name, *section_name; + + if (elf_version (EV_CURRENT) == EV_NONE) + Primitive_Error ("a.out file Elf version out of date"); + if ((elf_ptr = elf_begin (lf, ELF_C_READ, (Elf *)NULL)) == NULL) + Primitive_Error ("can't elf_begin() a.out file"); + + /* + * get the elf header, so we'll know where to look for the section + * names. + */ + if ((elf_ehdr_ptr = elf32_getehdr (elf_ptr)) == NULL) { + Primitive_Error ("no elf header in a.out file"); + } + shstrndx = elf_ehdr_ptr->e_shstrndx; + /* look for the symbol and string tables */ + while (elf_scn_ptr = elf_nextscn (elf_ptr, elf_scn_ptr)) { + if ((elf_shdr_ptr = elf32_getshdr (elf_scn_ptr)) == NULL) + Primitive_Error ("can't get section header in a.out file"); + if (elf_shdr_ptr->sh_type == SHT_STRTAB) { + /* + * save the index to the string table for later use by + * elf_strptr(). + */ + section_name = elf_strptr (elf_ptr, shstrndx, + (size_t)elf_shdr_ptr->sh_name); + if (strcmp (section_name, ".strtab") == 0 || + strcmp (section_name, ".dynstr") == 0) { + elf_str_index = elf_ndxscn (elf_scn_ptr); + } + } + else if (elf_shdr_ptr->sh_type == SHT_SYMTAB || + elf_shdr_ptr->sh_type == SHT_DYNSYM) { + symtab_ptr = elf_shdr_ptr; + symtab_scn_ptr = elf_scn_ptr; + } + } + if (!symtab_ptr) + Primitive_Error ("no symbol table in a.out file"); + if (!elf_str_index) + Primitive_Error ("no string table in a.out file"); + /* + * we've located the symbol table -- go through it and save the names + * of the interesting symbols. + */ + while (elf_data_ptr = elf_getdata (symtab_scn_ptr, elf_data_ptr)) { + char *name = NULL; + int symbol_count; + Elf32_Sym *symbol_ptr = elf_data_ptr->d_buf; + Elf32_Sym *current_symbol; + + tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); + tab->first = 0; + tab->strings = 0; + nextp = &tab->first; + for (symbol_count = 1; + /* < was <= in the version I received from the author, but + * the last entry is always undefined: + */ + symbol_count < symtab_ptr->sh_size / symtab_ptr->sh_entsize; + symbol_count++) { + current_symbol = symbol_ptr + symbol_count; + if (ELF32_ST_TYPE(current_symbol->st_info) != STT_FUNC || + ELF32_ST_BIND(current_symbol->st_info) != STB_GLOBAL) { + continue; + } + if ((name = elf_strptr (elf_ptr, elf_str_index, + (size_t)current_symbol->st_name)) == NULL) { + Free_Symbols (tab); + (void)close (lf); + Primitive_Error (elf_errmsg (elf_errno ())); + } + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = Safe_Malloc (strlen (name) + 1); + strcpy (sp->name, name); + sp->value = current_symbol->st_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; + } + } + return tab; +} + +SYMTAB * +Open_File_And_Snarf_Symbols (name) + char *name; +{ + int f; + SYMTAB *tab; + + if ((f = open (name, O_RDONLY)) == -1) + Primitive_Error ("can't open a.out file"); + tab = Snarf_Symbols (f); + (void)close (f); + return tab; +} diff --git a/src/stab-hp9k300.c b/src/stab-hp9k300.c new file mode 100644 index 0000000..1b489ee --- /dev/null +++ b/src/stab-hp9k300.c @@ -0,0 +1,97 @@ +#include AOUT_H +#include + +/* On the HP9000 an nlist entry contains a fixed length + * part consisting of the symbol information, plus a variable + * length part, the name without a '\0' terminator. + * We don't know how much space to allocate for the names + * until we have read them all. + * The solution here is to save all the names on the fly + * in a table that is grown in units of STRING_BLOCK bytes, + * using realloc to expand it on demand. + */ + +#define STRING_BLOCK 8192 + +SYMTAB *Snarf_Symbols (f, ep) FILE *f; struct exec *ep; { + SYMTAB *tab; + register SYM *sp; + register SYM **nextp; + int strsiz = 0; /* running total length of names read, */ + /* each '\0' terminated */ + int nread = 0; /* running total of bytes read from symbol table */ + int max = 0; /* current maximum size of name table */ + char *names = 0; /* the name table */ + struct nlist_ nl; + + tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); + tab->first = 0; + tab->strings = 0; + nextp = &tab->first; + + (void)fseek (f, (long)LESYM_OFFSET(*ep), 0); + + while (nread < ep->a_lesyms) { + if (fread ((char *)&nl, sizeof (nl), 1, f) != 1) { + Free_Symbols (tab); + (void)fclose (f); + Primitive_Error ("corrupt symbol table in object file"); + } + + nread += sizeof (nl); + + if (nl.n_length == 0) { + continue; + } + else if (nl.n_length + strsiz + 1 > max) { + max += STRING_BLOCK; + names = Safe_Realloc (names, max); + } + + if (fread (names + strsiz, 1, nl.n_length, f) != nl.n_length) { + Free_Symbols (tab); + (void)fclose (f); + Primitive_Error ("corrupt symbol table in object file"); + } + else { + nread += nl.n_length; + names[ strsiz + nl.n_length ] = '\0'; + } + if ((nl.n_type & N_TYPE) != N_TEXT) { + strsiz += nl.n_length +1; + continue; + } + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = (char *)strsiz; + strsiz += (nl.n_length + 1); + sp->value = nl.n_value; + *nextp = sp; + nextp = &sp->next; + *nextp = 0; + } + + tab->strings = names; + + for (sp = tab->first; sp; sp = sp->next) + sp->name += (unsigned)names; + + return tab; +} + +#ifdef INIT_OBJECTS +SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { + struct exec hdr; + FILE *f; + SYMTAB *tab; + + if ((f = fopen (name, "r")) == NULL) + Primitive_Error ("can't open a.out file"); + if (fread ((char *)&hdr, sizeof hdr, 1, f) != 1) { + (void)fclose (f); + Primitive_Error ("can't read a.out header"); + } + tab = Snarf_Symbols (f, &hdr); + (void)fclose (f); + return tab; +} +#endif /* INIT_OBJECTS */ diff --git a/src/stab-hp9k800.c b/src/stab-hp9k800.c new file mode 100644 index 0000000..23806e5 --- /dev/null +++ b/src/stab-hp9k800.c @@ -0,0 +1,55 @@ +#include AOUT_H +#include + +SYMTAB *Snarf_Symbols (f, hp) FILE *f; struct header *hp; { + SYMTAB *tab; + register SYM *sp, **nextp; + register n; + struct symbol_dictionary_record r; + + tab = (SYMTAB *)Safe_Malloc (sizeof (SYMTAB)); + tab->first = 0; + nextp = &tab->first; + tab->strings = Safe_Malloc (hp->symbol_strings_size); + (void)fseek (f, (long)hp->symbol_strings_location, SEEK_SET); + if (fread (tab->strings, hp->symbol_strings_size, 1, f) != 1) { + (void)fclose (f); + Free_Symbols (tab); + Primitive_Error ("corrupt string table in object file"); + } + (void)fseek (f, (long)hp->symbol_location, SEEK_SET); + for (n = hp->symbol_total; n > 0; n--) { + if (fread ((char *)&r, sizeof r, 1, f) != 1) { + (void)fclose (f); + Free_Symbols (tab); + Primitive_Error ("corrupt symbol table in object file"); + } + if (r.symbol_type != ST_CODE) + continue; + if (r.symbol_scope != SS_UNIVERSAL) + continue; + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = tab->strings + r.name.n_strx; + sp->value = r.symbol_value & ~3; /* mask out privilege level */ + *nextp = sp; + nextp = &sp->next; + *nextp = 0; + } + return tab; +} + +SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { + struct header hdr; + FILE *f; + SYMTAB *tab; + + if ((f = fopen (name, "r")) == NULL) + Primitive_Error ("can't open a.out file"); + if (fread ((char *)&hdr, sizeof hdr, 1, f) != 1) { + (void)fclose (f); + Primitive_Error ("can't read a.out header"); + } + tab = Snarf_Symbols (f, &hdr); + (void)fclose (f); + return tab; +} diff --git a/src/stab-macho.c b/src/stab-macho.c new file mode 100644 index 0000000..83bef00 --- /dev/null +++ b/src/stab-macho.c @@ -0,0 +1,78 @@ +#include +#include + +static SYMTAB *Grovel_Over_Nlist (symcmd, nl, strtab, text_sect) + struct symtab_command *symcmd; /* ptr to MACH-O symtab command */ + struct nlist nl[]; /* ptr to symbol table */ + char *strtab; /* ptr to string table */ + long text_sect; /* # of text section */ { + + SYMTAB *tab; + register SYM *sp, **nextp; + long i; + + tab = (SYMTAB *) Safe_Malloc (sizeof (SYMTAB)); + tab->first = 0; + tab->strings = 0; + nextp = &tab->first; + + /* Grovel over the file's nlist, extracting global symbols that + * have a section mumber equal to the number of the text section: + */ + for (i = 0; i < symcmd->nsyms; i++) { + if ((nl[i].n_type & (N_TYPE|N_EXT)) == (N_SECT|N_EXT) && + nl[i].n_sect == text_sect) { + sp = (SYM *)Safe_Malloc (sizeof (SYM)); + sp->name = strtab + nl[i].n_un.n_strx; + sp->value = nl[i].n_value; + sp->next = 0; + *nextp = sp; + nextp = &sp->next; + } + } + return tab; +} + +SYMTAB *Snarf_Symbols (mhdr) struct mach_header *mhdr; { + struct load_command *ld_cmd; + struct symtab_command *sym_cmd; + struct segment_command *seg_cmd; + struct section *sp; + struct nlist *symtab = 0; + char *cmdptr, *strtab; + long i, j, text_sect = 0; + + /* Loop through the load commands, find the symbol table and + * the segment command carrying the text section to determine + * the number of the text section: + */ + cmdptr = (char *)mhdr + sizeof (struct mach_header); + for (i = 0; i < mhdr->ncmds; i++) { + ld_cmd = (struct load_command *)cmdptr; + if (ld_cmd->cmd == LC_SYMTAB && !symtab) { + sym_cmd = (struct symtab_command *)ld_cmd; + symtab = (struct nlist *)((char *)mhdr + sym_cmd->symoff); + strtab = (char *)mhdr + sym_cmd->stroff; + } else if (ld_cmd->cmd == LC_SEGMENT && !text_sect) { + seg_cmd = (struct segment_command *)ld_cmd; + sp = (struct section *) + ((char *)ld_cmd + sizeof (struct segment_command)); + for (j = 1; j <= seg_cmd->nsects && !text_sect; j++, sp++) + if (strcmp (sp->sectname, SECT_TEXT) == 0) + text_sect = j; + } + cmdptr += ld_cmd->cmdsize; + } + if (!symtab) + Primitive_Error ("couldn't find symbol table in object file"); + if (!text_sect) + Primitive_Error ("couldn't find text section in object file"); + return Grovel_Over_Nlist (sym_cmd, symtab, strtab, text_sect); +} + +#ifdef INIT_OBJECTS +SYMTAB *Open_File_And_Snarf_Symbols (name) char *name; { + extern char *_mh_execute_header; + return Snarf_Symbols ((struct mach_header *)&_mh_execute_header); +} +#endif /* INIT_OBJECTS */ diff --git a/src/stab.c b/src/stab.c new file mode 100644 index 0000000..5e12d86 --- /dev/null +++ b/src/stab.c @@ -0,0 +1,152 @@ +/* Read and manage symbol tables from object modules. + */ + +#include "kernel.h" + +#if defined(CAN_LOAD_OBJ) || defined (INIT_OBJECTS) + +#ifdef MACH_O +# include "stab-macho.c" +#else +#ifdef ELF +# include "stab-elf.c" +#else +#if defined(COFF) || defined(XCOFF) +# include "stab-coff.c" +#else +#ifdef ECOFF +# include "stab-ecoff.c" +#else +#ifdef CONVEX_AOUT +# include "stab-convex.c" +#else +#if defined(hp9000s300) || defined(__hp9000s300) || defined(__hp9000s300__) +# include "stab-hp9k300.c" +#else +#if defined(hp9000s800) || defined(__hp9000s800) || defined(__hp9000s800__) +# include "stab-hp9k800.c" +#else +# include "stab-bsd.c" +#endif +#endif +#endif +#endif +#endif +#endif +#endif + +static SYMPREFIX Ignore_Prefixes[] = { + /* Currently none */ + 0, 0 +}; +static SYMPREFIX Init_Prefixes[] = { + INIT_PREFIX, PR_EXTENSION, + "_GLOBAL_.I.", PR_CONSTRUCTOR, /* SVR4.2/g++ */ + "__sti__", PR_CONSTRUCTOR, + "_STI", PR_CONSTRUCTOR, + "_GLOBAL_$I$", PR_CONSTRUCTOR, + 0, 0 +}; +static SYMPREFIX Finit_Prefixes[] = { + FINIT_PREFIX, PR_EXTENSION, + "_GLOBAL_.D.", PR_CONSTRUCTOR, + "__std__", PR_CONSTRUCTOR, + "_STD", PR_CONSTRUCTOR, + "_GLOBAL_$D$", PR_CONSTRUCTOR, + 0, 0 +}; + +static FUNCT *Finalizers; + +static void Call (l) unsigned long l; { +#ifdef XCOFF + unsigned long vec[3]; + extern main(); + + bcopy ((char *)main, (char *)vec, sizeof vec); + vec[0] = (l & ~0xF0000000) + (vec[0] & 0xF0000000); + ((void (*)())vec)(); +#else + ((void (*)())l)(); +#endif +} + +Call_Initializers (tab, addr, which) SYMTAB *tab; char *addr; { + SYM *sp; + char *p; + SYMPREFIX *pp; + FUNCT *fp, **fpp; + + /* Set pointer to end of list of finalizers; extension finalization + * functions and C++ static destructors will be appended to this list: + */ + for (fpp = &Finalizers; *fpp; fpp = &(*fpp)->next) + ; + + for (sp = tab->first; sp; sp = sp->next) { + if ((char *)sp->value < addr) + continue; + p = sp->name; +#ifdef SYMS_BEGIN_WITH + if (*p == SYMS_BEGIN_WITH) + p++; + else + continue; +#endif + for (pp = Ignore_Prefixes; pp->name; pp++) + if (strncmp (p, pp->name, strlen (pp->name)) == 0) + goto next; + for (pp = Init_Prefixes; pp->name; pp++) { + if (pp->type == which + && strncmp (p, pp->name, strlen (pp->name)) == 0) { + if (Verb_Init) + printf ("[calling %s]\n", p); + Call (sp->value); + } + } + /* Append to list of finalizers (to be invoked on exit): + */ + for (pp = Finit_Prefixes; pp->name; pp++) { + if (pp->type == which + && strncmp (p, pp->name, strlen (pp->name)) == 0) { + fp = (FUNCT *)Safe_Malloc (sizeof (FUNCT)); + fp->func = (void (*)())sp->value; + fp->name = Safe_Malloc (strlen (p) + 1); + strcpy (fp->name, p); + fp->next = 0; + *fpp = fp; + fpp = &fp->next; + } + } +next: ; + } +} + +/* Call the finialization functions and C++ static destructors. Make sure + * that calling exit() from a function doesn't cause endless recursion. + */ +Call_Finalizers () { + while (Finalizers) { + FUNCT *fp = Finalizers; + Finalizers = fp->next; + if (Verb_Init) + printf ("[calling %s]\n", fp->name); + Call ((unsigned long)fp->func); + } +} + +Free_Symbols (tab) SYMTAB *tab; { + register SYM *sp, *nextp; + + for (sp = tab->first; sp; sp = nextp) { + nextp = sp->next; +#if defined(COFF) || defined(ECOFF) + free (sp->name); +#endif + free ((char *)sp); + } + if (tab->strings) + free (tab->strings); + free ((char *)tab); +} +#endif /* CAN_LOAD_OBJ || INIT_OBJECTS */ diff --git a/src/stkmem.c b/src/stkmem.c new file mode 100644 index 0000000..7a0dffe --- /dev/null +++ b/src/stkmem.c @@ -0,0 +1,95 @@ +/* Alloca() simulation. + */ + +#include "kernel.h" + +#ifndef USE_ALLOCA + +extern char *malloc(); + +MEM_NODE *Mem_List; + +char *Mem_Alloc (size) unsigned size; { + char *ret; + + Disable_Interrupts; + if ((ret = malloc (size)) == 0) + Fatal_Error ("not enough memory to malloc %u bytes", size); + Enable_Interrupts; + return ret; +} + +Free_Mem_Nodes (first) MEM_NODE *first; { + MEM_NODE *p; + + Disable_Interrupts; + while (p = first) { + first = first->next; + if (--p->refcnt == 0) + free ((char *)p); + } + Enable_Interrupts; +} + +Save_Mem_Nodes (cont) Object cont; { + unsigned sum = 0; + char *s; + MEM_NODE *p; + Object str; + GC_Node; + + CONTROL(cont)->memlist = Mem_List; + for (p = Mem_List; p; p = p->next) + sum += p->len; + GC_Link (cont); + str = Make_String ((char *)0, sum); + CONTROL(cont)->memsave = str; + GC_Unlink; + for (p = Mem_List, s = STRING(str)->data; p; s += p->len, p = p->next) { + bcopy ((char *)(p+1), s, p->len); + p->refcnt++; + } +} + +Restore_Mem_Nodes (cont) Object cont; { + MEM_NODE *p; + char *s; + Object str; + + Free_Mem_Nodes (Mem_List); + Mem_List = CONTROL(cont)->memlist; + str = CONTROL(cont)->memsave; + for (p = Mem_List, s = STRING(str)->data; p; s += p->len, p = p->next) { + p->refcnt++; + bcopy (s, (char *)(p+1), p->len); + } +} + +Object Save_GC_Nodes () { + Object vec; + register unsigned sum = 0, i = 0, n; + register GCNODE *p; + + for (p = GC_List; p; p = p->next) + sum += p->gclen <= 0 ? 1 : p->gclen-1; + vec = Make_Vector (sum, Null); + for (p = GC_List; p; p = p->next, i += n) { + n = p->gclen <= 0 ? 1 : p->gclen-1; + bcopy ((char *)p->gcobj, (char *)&(VECTOR(vec)->data[i]), + n * sizeof (Object)); + } + return vec; +} + +Restore_GC_Nodes (vec) Object vec; { + register i = 0, n; + register GCNODE *p; + + for (p = GC_List; p; p = p->next, i += n) { + n = p->gclen <= 0 ? 1 : p->gclen-1; + bcopy ((char *)&(VECTOR(vec)->data[i]), (char *)p->gcobj, + n * sizeof (Object)); + } +} + +#endif diff --git a/src/string.c b/src/string.c new file mode 100644 index 0000000..a4fae03 --- /dev/null +++ b/src/string.c @@ -0,0 +1,301 @@ +#include + +#include "kernel.h" + +char Char_Map[256]; + +Init_String () { + register i; + + for (i = 0; i < 256; i++) + Char_Map[i] = i; + for (i = 'A'; i <= 'Z'; i++) + Char_Map[i] = tolower (i); +} + +Object General_Make_String (s, len, konst) const char *s; { + Object str; + + str = Alloc_Object (len + sizeof (struct S_String) - 1, T_String, konst); + STRING(str)->tag = Null; + STRING(str)->size = len; + if (s) + bcopy (s, STRING(str)->data, len); + return str; +} + +Object Make_String (s, len) const char *s; { + return General_Make_String (s, len, 0); +} + +Object Make_Const_String (s, len) const char *s; { + return General_Make_String (s, len, 1); +} + +Object P_Stringp (s) Object s; { + return TYPE(s) == T_String ? True : False; +} + +Object P_Make_String (argc, argv) Object *argv; { + register len, c = ' '; + Object str; + register char *p; + + if ((len = Get_Exact_Integer (argv[0])) < 0) + Range_Error (argv[0]); + if (argc == 2) { + Check_Type (argv[1], T_Character); + c = CHAR(argv[1]); + } + str = Make_String ((char *)0, len); + for (p = STRING(str)->data; len; len--) *p++ = c; + return str; +} + +Object P_String (argc, argv) Object *argv; { + Object str; + register i; + + str = Make_String ((char *)0, argc); + for (i = 0; i < argc; i++) { + Check_Type (argv[i], T_Character); + STRING(str)->data[i] = CHAR(argv[i]); + } + return str; +} + +Object P_String_To_Number (argc, argv) Object *argv; { + Object ret; + char *b; + register struct S_String *p; + int radix = 10; + Alloca_Begin; + + Check_Type (argv[0], T_String); + if (argc == 2) { + radix = Get_Exact_Integer (argv[1]); + switch (radix) { + case 2: case 8: case 10: case 16: + break; + default: + Primitive_Error ("invalid radix: ~s", argv[1]); + } + } + p = STRING(argv[0]); + Alloca (b, char*, p->size+1); + bcopy (p->data, b, p->size); + b[p->size] = '\0'; + ret = Parse_Number (Null, b, radix); + Alloca_End; + return Nullp (ret) ? False : ret; +} + +Object P_String_Length (s) Object s; { + Check_Type (s, T_String); + return Make_Integer (STRING(s)->size); +} + +Object P_String_Ref (s, n) Object s, n; { + Check_Type (s, T_String); + return Make_Char (STRING(s)->data[Get_Index (n, s)]); +} + +Object P_String_Set (s, n, new) Object s, n, new; { + register i, old; + + Check_Type (s, T_String); + Check_Mutable (s); + Check_Type (new, T_Character); + old = STRING(s)->data[i = Get_Index (n, s)]; + STRING(s)->data[i] = CHAR(new); + return Make_Char (old); +} + +Object P_Substring (s, a, b) Object s, a, b; { + register i, j; + + Check_Type (s, T_String); + if ((i = Get_Exact_Integer (a)) < 0 || i > STRING(s)->size) + Range_Error (a); + if ((j = Get_Exact_Integer (b)) < 0 || j > STRING(s)->size) + Range_Error (b); + if (i > j) + Primitive_Error ("`end' less than `start'"); + return Make_String (&STRING(s)->data[i], j-i); +} + +Object P_String_Copy (s) Object s; { + Check_Type (s, T_String); + return Make_String (STRING(s)->data, STRING(s)->size); +} + +Object P_String_Append (argc, argv) Object *argv; { + register i, len; + Object s, str; + + for (len = i = 0; i < argc; i++) { + Check_Type (argv[i], T_String); + len += STRING(argv[i])->size; + } + str = Make_String ((char *)0, len); + for (len = i = 0; i < argc; i++) { + s = argv[i]; + bcopy (STRING(s)->data, &STRING(str)->data[len], STRING(s)->size); + len += STRING(s)->size; + } + return str; +} + +Object P_List_To_String (list) Object list; { + Object str, len; + register i; + GC_Node; + + GC_Link (list); + len = P_Length (list); + str = Make_String ((char *)0, FIXNUM(len)); + for (i = 0; i < FIXNUM(len); i++, list = Cdr (list)) { + Check_Type (Car (list), T_Character); + STRING(str)->data[i] = CHAR(Car (list)); + } + GC_Unlink; + return str; +} + +Object P_String_To_List (s) Object s; { + register i; + Object list, tail, cell; + GC_Node3; + + Check_Type (s, T_String); + list = tail = Null; + GC_Link3 (s, list, tail); + for (i = 0; i < STRING(s)->size; i++, tail = cell) { + cell = Cons (Make_Char (STRING(s)->data[i]), Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + } + GC_Unlink; + return list; +} + +Object P_Substring_Fill (s, a, b, c) Object s, a, b, c; { + register i, j; + + Check_Type (s, T_String); + Check_Mutable (s); + Check_Type (c, T_Character); + i = Get_Index (a, s); + if ((j = Get_Exact_Integer (b)) < 0 || j > STRING(s)->size) + Range_Error (b); + if (i > j) + Primitive_Error ("`end' less than `start'"); + while (i < j) + STRING(s)->data[i++] = CHAR(c); + return s; +} + +Object P_String_Fill (s, c) Object s, c; { + Object ret; + GC_Node2; + + Check_Type (s, T_String); + Check_Mutable (s); + GC_Link2 (s, c); + ret = P_Substring_Fill (s, Make_Integer (0), + Make_Integer (STRING(s)->size), c); + GC_Unlink; + return ret; +} + +Object General_Substringp (s1, s2, ci) Object s1, s2; register ci; { + register n, l1, l2; + register char *p1, *p2, *p3, *map; + + Check_Type (s1, T_String); + Check_Type (s2, T_String); + l1 = STRING(s1)->size; + l2 = STRING(s2)->size; + map = Char_Map; + for (p2 = STRING(s2)->data; l2 >= l1; p2++, l2--) { + for (p1 = STRING(s1)->data, p3 = p2, n = l1; n; n--, p1++, p3++) { + if (ci) { + if (map[*p1] != map[*p3]) goto fail; + } else + if (*p1 != *p3) goto fail; + } + return Make_Integer (STRING(s2)->size - l2); +fail: ; + } + return False; +} + +Object P_Substringp (s1, s2) Object s1, s2; { + return General_Substringp (s1, s2, 0); +} + +Object P_CI_Substringp (s1, s2) Object s1, s2; { + return General_Substringp (s1, s2, 1); +} + +General_Strcmp (s1, s2, ci) Object s1, s2; register ci; { + register n, l1, l2; + register char *p1, *p2, *map; + + Check_Type (s1, T_String); + Check_Type (s2, T_String); + l1 = STRING(s1)->size; l2 = STRING(s2)->size; + n = l1 > l2 ? l2 : l1; + p1 = STRING(s1)->data; p2 = STRING(s2)->data; + for (map = Char_Map; --n >= 0; p1++, p2++) { + if (ci) { + if (map[*p1] != map[*p2]) break; + } else + if (*p1 != *p2) break; + } + if (n < 0) + return l1 - l2; + return ci ? map[*p1] - map[*p2] : *p1 - *p2; +} + +Object P_String_Eq (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 0) ? False : True; +} + +Object P_String_Less (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 0) < 0 ? True : False; +} + +Object P_String_Greater (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 0) > 0 ? True : False; +} + +Object P_String_Eq_Less (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 0) <= 0 ? True : False; +} + +Object P_String_Eq_Greater (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 0) >= 0 ? True : False; +} + +Object P_String_CI_Eq (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 1) ? False : True; +} + +Object P_String_CI_Less (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 1) < 0 ? True : False; +} + +Object P_String_CI_Greater (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 1) > 0 ? True : False; +} + +Object P_String_CI_Eq_Less (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 1) <= 0 ? True : False; +} + +Object P_String_CI_Eq_Greater (s1, s2) Object s1, s2; { + return General_Strcmp (s1, s2, 1) >= 0 ? True : False; +} diff --git a/src/symbol.c b/src/symbol.c new file mode 100644 index 0000000..402de40 --- /dev/null +++ b/src/symbol.c @@ -0,0 +1,311 @@ +#include + +#include "kernel.h" + +Object Obarray; + +Object Null, + True, + False, + False2, + Unbound, + Special, + Void, + Newline, + Eof, + Zero, + One; + +Init_Symbol () { + SET(Null, T_Null, 0); + SET(True, T_Boolean, 1); + SET(False, T_Boolean, 0); + False2 = False; + SET(Unbound, T_Unbound, 0); + SET(Special, T_Special, 0); + SET(Eof, T_End_Of_File, 0); + Newline = Make_Char ('\n'); + Zero = Make_Integer (0); + One = Make_Integer (1); + Obarray = Make_Vector (OBARRAY_SIZE, Null); + Global_GC_Link (Obarray); + Define_Symbol (&Void, ""); +} + +Object Make_Symbol (name) Object name; { + Object sym; + register struct S_Symbol *sp; + GC_Node; + + GC_Link (name); + sym = Alloc_Object (sizeof (struct S_Symbol), T_Symbol, 0); + sp = SYMBOL(sym); + sp->name = name; + sp->value = Unbound; + sp->plist = Null; + GC_Unlink; + return sym; +} + +Object P_Symbolp (x) Object x; { + return TYPE(x) == T_Symbol ? True : False; +} + +Object P_Symbol_To_String (x) Object x; { + Check_Type (x, T_Symbol); + return SYMBOL(x)->name; +} + +Object Obarray_Lookup (str, len) register char *str; register len; { + register h; + register struct S_String *s; + register struct S_Symbol *sym; + Object p; + + h = Hash (str, len) % OBARRAY_SIZE; + for (p = VECTOR(Obarray)->data[h]; !Nullp (p); p = sym->next) { + sym = SYMBOL(p); + s = STRING(sym->name); + if (s->size == len && bcmp (s->data, str, len) == 0) + return p; + } + return Make_Integer (h); +} + +Object CI_Intern (str) const char *str; { + Object s, *p, sym, ostr; + register len; + register const char *src; + char *dst; + char buf[128]; + Alloca_Begin; + + len = strlen (str); + if (len > sizeof (buf)) { + Alloca (dst, char*, len); + } else + dst = buf; + src = str; + str = dst; + for ( ; *src; src++, dst++) + *dst = isupper (*src) ? tolower (*src) : *src; + s = Obarray_Lookup (str, len); + if (TYPE(s) != T_Fixnum) { + Alloca_End; + return s; + } + ostr = Make_Const_String (str, len); + sym = Make_Symbol (ostr); + p = &VECTOR(Obarray)->data[FIXNUM(s)]; + SYMBOL(sym)->next = *p; + Alloca_End; + *p = sym; + return sym; +} + +Object Intern (str) const char *str; { + Object s, *p, sym, ostr; + register len; + + if (Case_Insensitive) + return CI_Intern (str); + len = strlen (str); + s = Obarray_Lookup (str, len); + if (TYPE(s) != T_Fixnum) + return s; + ostr = Make_Const_String (str, len); + sym = Make_Symbol (ostr); + p = &VECTOR(Obarray)->data[FIXNUM(s)]; + SYMBOL(sym)->next = *p; + *p = sym; + return sym; +} + +Object P_String_To_Symbol (str) Object str; { + Object s, *p, sym; + + Check_Type (str, T_String); + s = Obarray_Lookup (STRING(str)->data, STRING(str)->size); + if (TYPE(s) != T_Fixnum) + return s; + str = Make_String (STRING(str)->data, STRING(str)->size); + sym = Make_Symbol (str); + p = &VECTOR(Obarray)->data[FIXNUM(s)]; + SYMBOL(sym)->next = *p; + *p = sym; + return sym; +} + +Object P_Oblist () { + register i; + Object p, list, bucket; + GC_Node2; + + p = list = Null; + GC_Link2 (p, list); + for (i = 0; i < OBARRAY_SIZE; i++) { + bucket = Null; + for (p = VECTOR(Obarray)->data[i]; !Nullp (p); p = SYMBOL(p)->next) + bucket = Cons (p, bucket); + if (!Nullp (bucket)) + list = Cons (bucket, list); + } + GC_Unlink; + return list; +} + +Object P_Put (argc, argv) Object *argv; { + Object sym, key, last, tail, prop; + GC_Node3; + + sym = argv[0]; + key = argv[1]; + Check_Type (sym, T_Symbol); + Check_Type (key, T_Symbol); + last = Null; + for (tail = SYMBOL(sym)->plist; !Nullp (tail); tail = Cdr (tail)) { + prop = Car (tail); + if (EQ(Car (prop), key)) { + if (argc == 3) + Cdr (prop) = argv[2]; + else if (Nullp (last)) + SYMBOL(sym)->plist = Cdr (tail); + else + Cdr (last) = Cdr (tail); + return key; + } + last = tail; + } + if (argc == 2) + return False; + GC_Link3 (sym, last, key); + tail = Cons (key, argv[2]); + tail = Cons (tail, Null); + if (Nullp (last)) + SYMBOL(sym)->plist = tail; + else + Cdr (last) = tail; + GC_Unlink; + return key; +} + +Object P_Get (sym, key) Object sym, key; { + Object prop; + + Check_Type (sym, T_Symbol); + Check_Type (key, T_Symbol); + prop = Assq (key, SYMBOL(sym)->plist); + if (!Truep (prop)) + return False; + /* + * Do we want to signal an error or return #f? + * + * Primitive_Error ("~s has no such property: ~s", sym, key); + */ + return Cdr (prop); +} + +Object P_Symbol_Plist (sym) Object sym; { + Check_Type (sym, T_Symbol); + return Copy_List (SYMBOL(sym)->plist); +} + +Hash (str, len) char *str; { + register h; + register char *p, *ep; + + h = 5 * len; + if (len > 5) + len = 5; + for (p = str, ep = p+len; p < ep; ++p) + h = (h << 2) ^ *p; + return h & 017777777777; +} + +void Define_Symbol (sym, name) Object *sym; const char *name; { + *sym = Intern (name); + Func_Global_GC_Link (sym); +} + +void Define_Variable (var, name, init) Object *var, init; const char *name; { + Object frame, sym; + GC_Node; + + GC_Link (init); + sym = Intern (name); + SYMBOL(sym)->value = init; + frame = Add_Binding (Car (The_Environment), sym, init); + *var = Car (frame); + Car (The_Environment) = frame; + Func_Global_GC_Link (var); + GC_Unlink; +} + +Object Var_Get (var) Object var; { + return Cdr (var); +} + +void Var_Set (var, val) Object var, val; { + Cdr (var) = val; + SYMBOL (Car (var))->value = val; +} + +int Var_Is_True (var) Object var; { + var = Var_Get (var); + return Truep (var); +} + +unsigned long Symbols_To_Bits (x, mflag, stab) Object x; SYMDESCR *stab; { + register SYMDESCR *syms; + register unsigned long mask = 0; + Object l, s; + register char *p; + register n; + + if (!mflag) Check_Type (x, T_Symbol); + for (l = x; !Nullp (l); l = Cdr (l)) { + if (mflag) { + Check_Type (l, T_Pair); + x = Car (l); + } + Check_Type (x, T_Symbol); + s = SYMBOL(x)->name; + p = STRING(s)->data; + n = STRING(s)->size; + for (syms = stab; syms->name; syms++) + if (n && strncmp (syms->name, p, n) == 0) break; + if (syms->name == 0) + Primitive_Error ("invalid argument: ~s", x); + mask |= syms->val; + if (!mflag) break; + } + return mask; +} + +Object Bits_To_Symbols (x, mflag, stab) unsigned long x; SYMDESCR *stab; { + register SYMDESCR *syms; + Object list, tail, cell; + GC_Node2; + + if (mflag) { + GC_Link2 (list, tail); + for (list = tail = Null, syms = stab; syms->name; syms++) + if ((x & syms->val) && syms->val != ~0) { + Object z; + + z = Intern (syms->name); + cell = Cons (z, Null); + if (Nullp (list)) + list = cell; + else + P_Set_Cdr (tail, cell); + tail = cell; + } + GC_Unlink; + return list; + } + for (syms = stab; syms->name; syms++) + if (syms->val == x) + return Intern (syms->name); + return Null; +} diff --git a/src/terminate.c b/src/terminate.c new file mode 100644 index 0000000..61a4857 --- /dev/null +++ b/src/terminate.c @@ -0,0 +1,182 @@ +/* Termination functions, weak pointers. + */ + +#include + +#include "kernel.h" + +static WEAK_NODE *first; + +void Call_Terminators(); + +Init_Terminate () { + Register_After_GC (Call_Terminators); +} + +/* Register an object with the given group and termination function; + * object can be marked as LEADER. + */ +void Register_Object (obj, group, term, leader_flag) Object obj; GENERIC group; + PFO term; { + WEAK_NODE *p; + + p = (WEAK_NODE *)Safe_Malloc (sizeof (*p)); + p->obj = obj; + p->group = group; + p->term = term; + p->flags = leader_flag? WK_LEADER : 0; + p->next = first; + first = p; +} + +void Deregister_Object (obj) Object obj; { + WEAK_NODE *p, **pp; + + Disable_Interrupts; + for (pp = &first; (p = *pp); ) { + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + if (EQ(p->obj, obj)) { + *pp = p->next; + free ((char *)p); + } else pp = &p->next; + } + Enable_Interrupts; +} + +/* Search for an object of a given type (arg 1) and group (arg 2). + * Use the given match function (arg 3); it is called with an object + * and the remaining arguments of Find_Object() (a va_list). + * Null is returned when the object has not been found. + */ +/*VARARGS*/ +Object Find_Object (va_alist) va_dcl { + WEAK_NODE *p; + int type; + GENERIC group; + MATCHFUN match; + va_list args; + + va_start (args); + type = va_arg (args, int); + group = va_arg (args, GENERIC); + match = va_arg (args, MATCHFUN); + for (p = first; p; p = p->next) { + if (TYPE(p->obj) != type || p->group != group) + continue; + /* + * I believe updating the object is wrong here, as Find_Object() may + * be called from within GC (see Widget_Visit() in lib/xt/widget.c). + * If an object is updated here, it will no longer be regarded as + * alive in the call to Call_Terminators() later. + * + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + */ + if (match (p->obj, args)) { + va_end (args); + REVIVE_OBJ(p->obj); + return p->obj; + } + } + va_end (args); + return Null; +} + +/* Each of the following functions terminates the objects in two passes. + * First, they are removed from the global list and added to a temporary + * list. In a second pass, this list is scanned to call the terminator + * functions and actually free the objects. + * + * This is to avoid that calling a terminator functions causes the global + * list to be clobbered recursively resulting in an inconsistent data + * structure. + */ + +/* Terminate all objects belonging to the given group except leaders. + */ +void Terminate_Group (group) GENERIC group; { + WEAK_NODE *p, **pp, *q = 0; + + Disable_Interrupts; + for (pp = &first; (p = *pp); ) { + if (p->group == group && !(p->flags & WK_LEADER)) { + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + *pp = p->next; /* move object to temporary list */ + p->next = q; + q = p; + } else pp = &p->next; + } + while (q) { /* scan temporary list, call terminators and free objects */ + WEAK_NODE *tmp = q; + if (q->term) + (void)q->term (q->obj); + q = q->next; + free ((char *)tmp); + } + Enable_Interrupts; +} + +/* Terminate all objects of a given type. + */ +void Terminate_Type (type) int type; { + WEAK_NODE *p, **pp, *q = 0; + + Disable_Interrupts; + for (pp = &first; (p = *pp); ) { + if (TYPE(p->obj) == type) { + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + *pp = p->next; /* move object to temporary list */ + p->next = q; + q = p; + } else pp = &p->next; + } + while (q) { /* scan temporary list, call terminators and free objects */ + WEAK_NODE *tmp = q; + if (q->term) + (void)q->term (q->obj); + q = q->next; + free ((char *)tmp); + } + Enable_Interrupts; +} + +/* The after-GC function. + */ +void Call_Terminators () { + WEAK_NODE *p, **pp, *q = 0, **qq = &q; + + Disable_Interrupts; + for (pp = &first; (p = *pp); ) { + if (IS_ALIVE(p->obj)) { + if (WAS_FORWARDED(p->obj)) + UPDATE_OBJ(p->obj); + pp = &p->next; + } else { + *pp = p->next; + if (p->flags & WK_LEADER) { + *qq = p; /* move leader to end of temporary list */ + qq = &p->next; + *qq = 0; + } else { + p->next = q; /* move non-leader to front of list */ + if (qq == &q) qq = &p->next; + q = p; + } + } + } + /* Scan the temporary list, call terminators and free objects. + * As leaders have been appended to the list, they are now + * scanned after all non-leaders have been taken care of. + */ + while (q) { + WEAK_NODE *tmp = q; + if (q->term) + (void)q->term (q->obj); + q = q->next; + free ((char *)tmp); + } + Enable_Interrupts; +} diff --git a/src/type.c b/src/type.c new file mode 100644 index 0000000..56dccfe --- /dev/null +++ b/src/type.c @@ -0,0 +1,86 @@ +/* Built-in and user-defined Scheme types. + */ + +#include "kernel.h" + +#define TYPE_GROW 10 + +TYPEDESCR *Types; +int Num_Types, Max_Type; + +char *builtin_types[] = { + "0integer", "1integer" /* bignum */, "1real", "0null", "0boolean", + "0unbound", "0special", "0character", "1symbol", "1pair", + "1environment", "1string", "1vector", "1primitive", "1compound", + "1control-point", "1promise", "1port", "0end-of-file", "1autoload", + "1macro", "1!!broken-heart!!", +#ifdef GENERATIONAL_GC + "0align_8byte", "0freespace", +#endif + 0 +}; + +Wrong_Type (x, t) Object x; register t; { + Wrong_Type_Combination (x, Types[t].name); +} + +Wrong_Type_Combination (x, name) Object x; register const char *name; { + register t = TYPE(x); + char buf[100]; + + if (t < 0 || t >= Num_Types) + Panic ("bad type1"); + sprintf (buf, "wrong argument type %s (expected %s)", + Types[t].name, name); + Primitive_Error (buf); +} + +Object P_Type (x) Object x; { + register t = TYPE(x); + + if (t < 0 || t >= Num_Types) + Panic ("bad type2"); + return Intern (Types[t].name); +} + +Define_Type (t, name, size, const_size, eqv, equal, print, visit) register t; + const char *name; + int (*size)(), (*eqv)(), (*equal)(), (*print)(), (*visit)(); { + register TYPEDESCR *p; + + Set_Error_Tag ("define-type"); + if (t != 0) + Fatal_Error("first arg of Define_Type() must be 0"); + if (Num_Types == Max_Type) { + Max_Type += TYPE_GROW; + Types = (TYPEDESCR *)Safe_Realloc((char *)Types, + Max_Type * sizeof(TYPEDESCR)); + } + Disable_Interrupts; + p = &Types[Num_Types++]; + p->haspointer = 1; + p->name = name; + p->size = size; + p->const_size = const_size; + p->eqv = eqv; + p->equal = equal; + p->print = print; + p->visit = visit; + Enable_Interrupts; + return Num_Types-1; +} + +Init_Type() { + int i, bytes; + char *p; + + Num_Types = (sizeof(builtin_types) - 1) / sizeof(char *); + Max_Type = Num_Types + TYPE_GROW; + bytes = Max_Type * sizeof(TYPEDESCR); + Types = (TYPEDESCR *)Safe_Malloc(bytes); + bzero((char *)Types, bytes); + for (i = 0; p = builtin_types[i]; i++) { + Types[i].haspointer = *p != '0'; + Types[i].name = ++p; + } +} diff --git a/src/vector.c b/src/vector.c new file mode 100644 index 0000000..33db53f --- /dev/null +++ b/src/vector.c @@ -0,0 +1,134 @@ +#include "kernel.h" + +Object General_Make_Vector (len, fill, konst) Object fill; { + Object vec; + register Object *op; + GC_Node; + + GC_Link (fill); + vec = Alloc_Object ((len-1) * sizeof (Object) + sizeof (struct S_Vector), + T_Vector, konst); + VECTOR(vec)->tag = Null; + VECTOR(vec)->size = len; + for (op = VECTOR(vec)->data; len--; op++) + *op = fill; + GC_Unlink; + return vec; +} + +Object Make_Vector (len, fill) Object fill; { + return General_Make_Vector (len, fill, 0); +} + +Object Make_Const_Vector (len, fill) Object fill; { + return General_Make_Vector (len, fill, 1); +} + +Object P_Make_Vector (argc, argv) Object *argv; { + register len; + + if ((len = Get_Exact_Integer (argv[0])) < 0) + Range_Error (argv[0]); + return Make_Vector (len, argc == 1 ? Null : argv[1]); +} + +Object P_Vector (argc, argv) Object *argv; { + Object vec; + register i; + + vec = Make_Vector (argc, Null); + for (i = 0; i < argc; i++) + VECTOR(vec)->data[i] = *argv++; + return vec; +} + +Object P_Vectorp (x) Object x; { + return TYPE(x) == T_Vector ? True : False; +} + +Object P_Vector_Length (x) Object x; { + Check_Type (x, T_Vector); + return Make_Integer (VECTOR(x)->size); +} + +Object P_Vector_Ref (vec, n) Object vec, n; { + Check_Type (vec, T_Vector); + return VECTOR(vec)->data[Get_Index (n, vec)]; +} + +Object P_Vector_Set (vec, n, new) Object vec, n, new; { + Object old; + register i; + + Check_Type (vec, T_Vector); + Check_Mutable (vec); + old = VECTOR(vec)->data[i = Get_Index (n, vec)]; + VECTOR(vec)->data[i] = new; + return old; +} + +/* We cannot simply call P_List with vec->size and vec->data here, + * because the latter can change during GC. + */ +Object P_Vector_To_List (vec) Object vec; { + register i; + Object list, tail, cell; + GC_Node3; + + Check_Type (vec, T_Vector); + list = tail = Null; + GC_Link3 (vec, list, tail); + for (i = 0; i < VECTOR(vec)->size; i++, tail = cell) { + cell = Cons (VECTOR(vec)->data[i], Null); + if (Nullp (list)) + list = cell; + else + (void)P_Set_Cdr (tail, cell); + } + GC_Unlink; + return list; +} + +Object List_To_Vector (list, konst) Object list; { + Object vec, len; + register i; + GC_Node; + + GC_Link (list); + len = P_Length (list); + if (konst) + vec = Make_Const_Vector (FIXNUM(len), Null); + else + vec = Make_Vector (FIXNUM(len), Null); + for (i = 0; i < FIXNUM(len); i++, list = Cdr (list)) + VECTOR(vec)->data[i] = Car (list); + GC_Unlink; + return vec; +} + +Object P_List_To_Vector (list) Object list; { + return List_To_Vector (list, 0); +} + +Object P_Vector_Fill (vec, fill) Object vec, fill; { + register i; + + Check_Type (vec, T_Vector); + Check_Mutable (vec); + for (i = 0; i < VECTOR(vec)->size; i++) + VECTOR(vec)->data[i] = fill; + return vec; +} + +Object P_Vector_Copy (vec) Object vec; { + Object new; + GC_Node; + + Check_Type (vec, T_Vector); + GC_Link (vec); + new = Make_Vector (VECTOR(vec)->size, Null); + bcopy ((char *)POINTER(vec), (char *)POINTER(new), + (VECTOR(vec)->size-1) * sizeof (Object) + sizeof (struct S_Vector)); + GC_Unlink; + return new; +} diff --git a/util/README b/util/README new file mode 100644 index 0000000..8e42476 --- /dev/null +++ b/util/README @@ -0,0 +1,6 @@ +When porting Elk to a new architecture, you may want to compile and run +alloca.c to check if your system's alloca() function is usable for Elk. +See the leading comment in alloca.c. + +getversion is a trivial shell script to extract the Elk version number +from the file README. It is used by the build process. diff --git a/util/alloca.c b/util/alloca.c new file mode 100644 index 0000000..02899b8 --- /dev/null +++ b/util/alloca.c @@ -0,0 +1,31 @@ +/* Check if the system's alloca() function actually extends the stack. + * If it doesn't, it's not usable for Elk. + * + * The second value printed should be about 100 larger (or smaller, + * depending on the stack growing direction) than the first value. + * + * On some systems you may have to enable the #include and delete the line + * declaring alloca(). + */ + +/* #include */ + +extern char *alloca(); + +char *stkbase; + +prstk(s) char *s; { + char foo; + + printf("stack %s calling alloca(100): %lu\n", s, (long)(stkbase - &foo)); +} + +main(ac, av) char **av; { + char *foo; + + stkbase = (char *)&foo; + prstk("before"); + foo = alloca(100); + prstk(" after"); + return 0; +} diff --git a/util/getversion b/util/getversion new file mode 100755 index 0000000..9930f68 --- /dev/null +++ b/util/getversion @@ -0,0 +1,5 @@ +#!/bin/sh +if [ $# != 1 ]; then + echo Usage: $0 README; exit 1 +fi +exec grep "^This is release" $1 | awk '{print $4}'