diff options
| author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:24 -0800 |
|---|---|---|
| committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:24 -0800 |
| commit | 1edcb9b62a1a520eddae8403c19d841c9b18737f (patch) | |
| tree | bc0a43d9b3905726a76ed6f0528b54275f23d082 | |
| parent | 5ca6e8e6a4e5c022a6fb5d28f30219c22c99eda8 (diff) | |
| download | scm-upstream/5b3.tar.gz scm-upstream/5b3.zip | |
Import Upstream version 5b3upstream/5b3
| -rw-r--r-- | .gdbinit | 96 | ||||
| -rw-r--r-- | ANNOUNCE | 195 | ||||
| -rw-r--r-- | COPYING | 7 | ||||
| -rw-r--r-- | ChangeLog | 410 | ||||
| -rw-r--r-- | Init.scm | 184 | ||||
| -rw-r--r-- | Link.scm | 149 | ||||
| -rw-r--r-- | Macro.scm | 292 | ||||
| -rw-r--r-- | Makefile | 116 | ||||
| -rw-r--r-- | Makefile.in | 462 | ||||
| -rw-r--r-- | README | 47 | ||||
| -rw-r--r-- | README.unix | 182 | ||||
| -rw-r--r-- | Transcen.scm | 2 | ||||
| -rw-r--r-- | acconfig-1.5.h | 22 | ||||
| -rw-r--r-- | bench.scm | 42 | ||||
| -rwxr-xr-x | build.bat | 2 | ||||
| -rwxr-xr-x | build.scm | 702 | ||||
| -rwxr-xr-x | configure | 849 | ||||
| -rw-r--r-- | configure.in | 33 | ||||
| -rw-r--r-- | continue.c | 35 | ||||
| -rw-r--r-- | continue.h | 33 | ||||
| -rw-r--r-- | dynl.c | 35 | ||||
| -rw-r--r-- | ecrt0.c | 10 | ||||
| -rw-r--r-- | eval.c | 574 | ||||
| -rw-r--r-- | findexec.c | 32 | ||||
| -rw-r--r-- | gmalloc.c | 10 | ||||
| -rw-r--r-- | install-sh | 238 | ||||
| -rw-r--r-- | ioext.c | 10 | ||||
| -rw-r--r-- | mkimpcat.scm | 221 | ||||
| -rwxr-xr-x | mkinstalldirs | 35 | ||||
| -rw-r--r-- | patchlvl.h | 2 | ||||
| -rw-r--r-- | posix.c | 8 | ||||
| -rw-r--r-- | ramap.c | 2 | ||||
| -rw-r--r-- | record.c | 15 | ||||
| -rw-r--r-- | repl.c | 230 | ||||
| -rw-r--r-- | rgx.c | 54 | ||||
| -rw-r--r-- | rope.c | 31 | ||||
| -rw-r--r-- | sc2.c | 2 | ||||
| -rw-r--r-- | scl.c | 26 | ||||
| -rw-r--r-- | scm.c | 236 | ||||
| -rw-r--r-- | scm.h | 57 | ||||
| -rw-r--r-- | scm.texi | 2606 | ||||
| -rw-r--r-- | scm4e3.scmconfig.patch | 60 | ||||
| -rw-r--r-- | scmconfig.h.in | 69 | ||||
| -rw-r--r-- | scmfig.h | 44 | ||||
| -rw-r--r-- | script.c | 384 | ||||
| -rw-r--r-- | setjump.h | 34 | ||||
| -rw-r--r-- | socket.c | 8 | ||||
| -rw-r--r-- | subr.c | 24 | ||||
| -rw-r--r-- | sys.c | 70 | ||||
| -rw-r--r-- | time.c | 21 | ||||
| -rw-r--r-- | unexalpha.c | 495 | ||||
| -rw-r--r-- | unexhp9k800.c | 319 | ||||
| -rw-r--r-- | unexsunos4.c | 378 | ||||
| -rw-r--r-- | unif.c | 6 | ||||
| -rw-r--r-- | unix.c | 5 |
55 files changed, 6101 insertions, 4110 deletions
diff --git a/.gdbinit b/.gdbinit new file mode 100644 index 0000000..6d39779 --- /dev/null +++ b/.gdbinit @@ -0,0 +1,96 @@ +# Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this software; see the file COPYING. If not, write to +# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +# +# As a special exception, the Free Software Foundation gives permission +# for additional uses of the text contained in its release of GUILE. +# +# The exception is that, if you link the GUILE library with other files +# to produce an executable, this does not by itself cause the +# resulting executable to be covered by the GNU General Public License. +# Your use of that executable is in no way restricted on account of +# linking the GUILE library code into it. +# +# This exception does not however invalidate any other reasons why +# the executable file might be covered by the GNU General Public License. +# +# This exception applies only to the code released by the +# Free Software Foundation under the name GUILE. If you copy +# code from other Free Software Foundation releases into a copy of +# GUILE, as the General Public License permits, the exception does +# not apply to the code that you add in this way. To avoid misleading +# anyone as to the status of such modified files, you must delete +# this exception notice from them. +# +# If you write modifications of your own for GUILE, it is your choice +# whether to permit this exception to apply to your modifications. +# If you do not wish that, delete this exception notice. + +# ".gdbinit" GDB 4.16 initialization for SCM Scheme Interpreter +# Author: Aubrey Jaffer + +set output-radix 16. + +define runscm + break abrt + echo \nto return to gdb, type: (abort)\n\n + run +end + +define verbose + output (prolixity(((($arg0)<<1)<<1)+2L))>>2 + echo\n +end + +define errobj + call iprin1(*loc_errobj, sys_protects[2], 1),(void)0 + call newline(sys_protects[2]),(void)0 +end + +define scm + call iprin1($arg0, sys_protects[2], 1),(void)0 + call newline(sys_protects[2]),(void)0 +end + +define load + if (errjmp_bad) + echo sorry, errjmp_bad\n + else + call scm_ldfile($arg0),(void)0 + end +end + +define eval + if (errjmp_bad) + echo sorry, errjmp_bad\n + else + print scm_evstr($arg0) + scm $ + end +end + +define car + print ((cell*)(~1L & $))->car +end +document car +CAR of $ +end + +define cdr + print ((cell*)(~1L & $))->cdr +end +document cdr +CDR of $ +end @@ -1,98 +1,42 @@ -This message announces the availability of Scheme release scm4e6. - -New in scm4e6 are: - - * bench.scm (benchmark): added. computes and display statistics - on "pi.scm" benchmark. - * Makefile (benchlit bench): targets added. Append stats to file - "BenchLog". - * scm.texi (Socket): added examples of chat servers and clients. - (Internet Addresses and Socket Names): enlarged from "Internet - Addresses". - * socket.c (l_connect): BUF0 was missing from mode bits set in - returned port. - * build.scm (build-params): Added compiler-options and - linker-options; added --batch-dialect and --script-name as aliases - for -h and -w. - * scmfig.h (HAVE_SELECT): Now defined for linux. - * sys.c (igc): fixed off-by-1 error for sizeof save_regs_gc_mark. - (gc_mark): fixed off-by-1 error for sizeof(CONTINUATION). These - seem to fix a very obscure GC bug. - * Init.scm (exec-self): Added. - * repl.c (init_repl): DUMP sets RESTART to EXEC-SELF. - * repl.c (tryload): Made tail-recursive so that dump, quit, exit, - etc. will work as the last expression in a loading file. - (scm_execpath): Split out from scm_unexec. - * unexec.c: All Updated from emacs-19.34 -- no changes necessary. - * gmalloc.c: - * pre-crt0.c: - * ecrt0.c: - * unexelf.c: fixes Linux (ELF) dump bug. - * build.scm (platform): linux renamed linux-aout. linux-elf fixed - and renamed linux. - (C-libraries): X11R6 moved library files on RedHat Linux. Linux - graphics library now has entry (doesn't default). - (compile-dll-c-files linux): - (make-dll-archive linux): Now converts from ".o" objects to ELF - ".so" form and "links" the usual libraries. - * Link.scm (usr:lib x:lib): dynamic linking fixed for (linux ELF) - dlopen. Libraries other than ".so" object not needed; eliminated - by usr:lib and x:lib returning #f. - * dynl.c (l_dyn_unlink): prints result of dlerror() on errors. - * eval.c (nconc2last): If CAUTIOUS is defined, checks that - APPLY's arglist and last element of arglist are LIST?s. - * sys.c (igc): symhash GC can now be disabled with - #define NO_SYM_GC. - * Init.scm (boot-tail): Added FSF --help and --version options. - Added --no-init-file as a synonym for -no-init-file. - * scm.texi (File-System Habitat): improved wording and added - examples. - * scm.texi (Top): Renamed sections. - * sys.c (mark_syms mark_sym_values): Split up mark_symhash() to - immunize against accidental pointers. - * repl.c (gc_ports_collected): added to instrument symbol GC. - * scm.texi (Debugging Scheme Code): Added section. - * eval.c (definedp): Changed from a memoizing macro to a `syntax'. - - From maximum entropy <entropy@zippy.bernstein.com>: - - * ioext.c, scmfig.h: support for SGI (tested with SGI IRIX 5.2/gcc) - * ioext.c (file_set_position): If a port is bidirectional - (e.g. a socket) it may be necessary on some systems to perform a - file positioning operation when switching between reading and - writing. This is required by ANSI C (ISO/IEC 9899:1990 - 7.9.5.3). Therefore, a file-set-position on a bidirectional - port should not signal an error if fseek generates an - ESPIPE -- the fseek operation actually "succeeded" in that it - reset the I/O direction flag for the FILE. - * repl.c (input_waiting): R4RS requires that "char-ready?" - return "#t" at end-of-file. The semantics for "ioctl(..., - FIONREAD, ...)" are such that it gives 0 on a socket that is - closed (on the other side of the connection). If the - system has select(), use that instead to get the correct - behavior. - * socket.c (l_listen): Treat sockets that have been "listened" - as input-ports. This allows polling for new connections - (e.g. with "char-ready?") instead of blocking in - "socket:accept". - * socket.c (l_accept): Fix type checking to agree with - previous patch. - - From Radey Shouman <shouman@zianet.com> - - * eval.c (unmemocar): The code in unmemocar to deal with ILOCs was - never being executed. - * sys.c (intern): fixed (new) symhash GC bug. - * sys.c (igc): Added calls to mark_symhash() and sweep_symhash(). - These GC unused symbols with a top-level value of UNDEFINED. - (mark_symhash): added. - (sweep_symhash): added. - - From Eric Hanchrow <erich@MICROSOFT.com> - - * scm.c (l_sleep): Ported to Windows NT (_WIN32) - * ioext.c: Ported to Windows NT (_WIN32) - +This message announces the availability of Scheme release scm5b3. + +New in scm5b3 are: + + * mkimpcat.scm: 'hobbit, 'scmhob, and 'build added. + * Link.scm (compile-file link-named-scm): Fixed. Require of + strings removed. Tested with Hobbit 5x. + (scm:object-suffix): changed to ".o"; only used by link-named-scm. + * patchlvl.h (SCMVERSION): Bumped from 5b2 to 5b3. + * mkimpcat.scm: modified for new SLIB catalog arrangement. + * sys.c (gc_sweep): added `contin_bad' argument. When set, + gc_sweep will warn of any uncollected continuations of non-zero + length. This should make unexec problems less mysterious. + * Init.scm (home-vicinity): added. Used to find "ScmInit.scm". + * unexsunos4.c: added from emacs. + * unexhp9k800.c: added from emacs. Broken -- doesn't change the + segment sizes. + * unexalpha.c: added from emacs. + * build.scm (build C-libraries): changed horrible `supress-files' + field to `lib-support'. + (rebuild-catalog): added. Called by dll and dlls methods. + * scm.texi (Compiling and Linking Custom Files): Added to describe + how to use "build.scm" with custom files. + * Makefile (myscm4 myscm5): now delete slibcat and implcat to keep + them from getting stale. + * gmalloc.c: HP-UX B.10.10 A doesn't have getpagesize.h. + * sys.c (mark_syms): No longer mark the value cell because value + cells get returned by calls to intern(). This caused a rare GC + leak which showed up in large programs. + * scm.h (const): defined to comment for hpux native cc. + +Fri Oct 10 00:18:40 1997 Peter E. Davis <pete@media.mit.edu> + + * unexhp9k800.c: added HP-UX unexec support. + +Sun Sep 28 14:48:10 1997 Radey Shouman <shouman@zianet.com> + + * ramap.c (array_imap): Fixed for zero-rank arrays arguments. + -=-=- Scm conforms to Revised^4 Report on the Algorithmic Language Scheme @@ -104,55 +48,36 @@ Documentation is included explaining the many Scheme Language extensions in scm, the internal representations, and how to extend or include SCM in other programs. Documentation is online at: - http://ftp-swiss.ai.mit.edu/~jaffer/SCM.html + http://www-swiss.ai.mit.edu/~jaffer/SCM.html SCM can be obtained via FTP (detailed instructions follow) from: - ftp-swiss.ai.mit.edu:pub/scm/scm4e6.tar.gz - prep.ai.mit.edu:pub/gnu/jacal/scm4e6.tar.gz - ftp.maths.tcd.ie:pub/bosullvn/jacal/scm4e6.tar.gz - ftp.cs.indiana.edu:/pub/scheme-repository/imp/scm4e6.tar.gz + ftp-swiss.ai.mit.edu:pub/scm/scm5b3.tar.gz + prep.ai.mit.edu:pub/gnu/jacal/scm5b3.tar.gz + ftp.cs.indiana.edu:/pub/scheme-repository/imp/scm5b3.tar.gz SLIB is a portable Scheme library which SCM uses: - ftp-swiss.ai.mit.edu:pub/scm/slib2a6.tar.gz - prep.ai.mit.edu:pub/gnu/jacal/slib2a6.tar.gz - ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz - ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib2a6.tar.gz + ftp-swiss.ai.mit.edu:pub/scm/slib2c0.tar.gz + prep.ai.mit.edu:pub/gnu/jacal/slib2c0.tar.gz + ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib2c0.tar.gz JACAL is a symbolic math system written in Scheme: - ftp-swiss.ai.mit.edu:pub/scm/jacal1a5.tar.gz - prep.ai.mit.edu:pub/gnu/jacal/jacal1a5.tar.gz - ftp.maths.tcd.ie:pub/bosullvn/jacal/jacal1a5.tar.gz - ftp.cs.indiana.edu:/pub/scheme-repository/code/num/jacal1a5.tar.gz + ftp-swiss.ai.mit.edu:pub/scm/jacal1a7.tar.gz + prep.ai.mit.edu:pub/gnu/jacal/jacal1a7.tar.gz + ftp.cs.indiana.edu:/pub/scheme-repository/code/num/jacal1a7.tar.gz HOBBIT is a compiler for SCM code: ftp-swiss.ai.mit.edu:pub/scm/hobbit4d.tar.gz - ftp.maths.tcd.ie:pub/bosullvn/jacal/hobbit4d.tar.gz ftp.cs.indiana.edu:/pub/scheme-repository/imp/hobbit4d.tar.gz -SCMCONFIG contains additional files for the SCM distribution to build -SCM on Unix machines using GNU autoconf. - ftp-swiss.ai.mit.edu:pub/scm/scmconfig4e3.tar.gz - prep.ai.mit.edu:pub/gnu/jacal/scmconfig4e3.tar.gz - ftp.maths.tcd.ie:pub/bosullvn/jacal/scmconfig4e3.tar.gz - ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/scmconfig4e3.tar.gz - SLIB-PSD is a portable debugger for Scheme (requires emacs editor): ftp-swiss.ai.mit.edu:pub/scm/slib-psd1-3.tar.gz prep.ai.mit.edu:pub/gnu/jacal/slib-psd1-3.tar.gz - ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz -SLIB-SCHELOG is an embedding of Prolog in Scheme: - ftp-swiss.ai.mit.edu:pub/scm/slib-schelog.tar.gz - prep.ai.mit.edu:pub/gnu/jacal/slib-schelog.tar.gz - ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-schelog.tar.gz - ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-schelog.tar.gz - SMG-SCM is an SMG interface package which works with SCM on VMS. ftp-swiss.ai.mit.edu:pub/scm/smg-scm2a1.zip prep.ai.mit.edu:pub/gnu/jacal/smg-scm2a1.zip ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/smg-scm2a1.zip - ftp.maths.tcd.ie:pub/bosullvn/jacal/smg-scm2a1.zip A VMS version of Unzip is available by anonymous FTP from ftp.spc.edu:[ANONYMOUS.MACRO32]UNZIP.EXE. @@ -160,7 +85,6 @@ TURTLSCM is a turtle graphics package which works with SCM on MS-DOS or X11 machines: ftp-swiss.ai.mit.edu:pub/scm/turtlegr.tar.gz prep.ai.mit.edu:pub/gnu/jacal/turtlegr.tar.gz - ftp.maths.tcd.ie:pub/bosullvn/jacal/turtlegr.tar.gz ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/turtlegr.tar.gz XSCM is a X windows interface package which works with SCM: @@ -171,36 +95,37 @@ XSCM is a X windows interface package which works with SCM: MacSCM is a Macintosh applications building package which works with SCM (similar to XSCM). ftp-swiss.ai.mit.edu:pub/scm/macscm.tar.Z - ftp.maths.tcd.ie:pub/bosullvn/jacal/macscm.tar.Z ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/macscm.tar.gz WB is a disk based, sorted associative array (B-tree) library for SCM. Using WB, large databases can be created and managed from SCM. ftp-swiss.ai.mit.edu:pub/scm/wb1a2.tar.gz - ftp.maths.tcd.ie:pub/bosullvn/jacal/wb1a2.tar.gz ftp.cs.indiana.edu:/pub/scheme-repository/imp/SCM-support/wb1a2.tar.gz DLD is a C library package allowing SCM to dynamically load object files on Linux, VAX (Ultrix), Sun 3 (SunOS 3.4 and 4.0), SPARCstation (SunOS 4.0), Sequent Symmetry (Dynix), and Atari ST. - prep.ai.mit.edu:pub/gnu/dld-3.3.tar.gz + +#! implements "#!" (POSIX) shell-scripts for MS-DOS batch files. + ftp-swiss.ai.mit.edu:pub/scm/#!.zip + -=-=- ftp ftp-swiss.ai.mit.edu (anonymous) bin cd pub/scm - get scm4e6.tar.gz - get slib2a6.tar.gz + get scm5b3.tar.gz + get slib2c0.tar.gz or ftp prep.ai.mit.edu (anonymous) bin cd pub/gnu/jacal - get scm4e6.tar.gz - get slib2a6.tar.gz + get scm5b3.tar.gz + get slib2c0.tar.gz - `scm4e6.tar.gz' is a gzipped tar file of the C code distribution. - `slib2a6.tar.gz' is a gzipped tar file of a Scheme Library. + `scm5b3.tar.gz' is a gzipped tar file of the C code distribution. + `slib2c0.tar.gz' is a gzipped tar file of a Scheme Library. Files in these directories with the ".gz" suffix are compressed with patent-free gzip (no relation to zip). The program to uncompress them @@ -211,7 +136,7 @@ is available from Remember to use binary mode when transferring the files. Be sure to get and read the GNU General Public License (COPYING). -It is included in scm4e6.tar.gz. +It is included in scm5b3.tar.gz. I sell IBM PC floppy disk sets with the source files, documentation, and MS-DOS and i386 MS-DOS executables for $99.00. To order, send @@ -2,7 +2,7 @@ Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 675 Mass Ave, Cambridge, MA 02139, USA + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -279,7 +279,7 @@ POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS - Appendix: How to Apply These Terms to Your New Programs + How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it @@ -305,7 +305,8 @@ the "copyright" line and a pointer to where the full notice is found. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Also add information on how to contact you by electronic and paper mail. @@ -1,3 +1,365 @@ +Sun Nov 16 13:43:21 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * mkimpcat.scm: 'hobbit, 'scmhob, and 'build added. + + * Link.scm (compile-file link-named-scm): Fixed. Require of + strings removed. Tested with Hobbit 5x. + (scm:object-suffix): changed to ".o"; only used by link-named-scm. + +Sun Nov 2 23:15:57 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * patchlvl.h (SCMVERSION): Bumped from 5b2 to 5b3. + + * mkimpcat.scm: modified for new SLIB catalog arrangement. + +Sat Nov 1 14:19:24 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * sys.c (gc_sweep): added `contin_bad' argument. When set, + gc_sweep will warn of any uncollected continuations of non-zero + length. This should make unexec problems less mysterious. + +Tue Oct 28 16:54:00 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * Init.scm (home-vicinity): added. Used to find "ScmInit.scm". + +Sat Oct 25 23:05:43 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * unexsunos4.c: added from emacs. + + * unexhp9k800.c: added from emacs. Broken -- doesn't change the + segment sizes. + + * unexalpha.c: added from emacs. + +Sat Oct 18 11:50:34 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * build.scm (build C-libraries): changed horrible `supress-files' + field to `lib-support'. + (rebuild-catalog): added. Called by dll and dlls methods. + +Sat Oct 11 23:19:55 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * scm.texi (Compiling and Linking Custom Files): Added to describe + how to use "build.scm" with custom files. + +Fri Oct 10 00:31:08 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * Makefile (myscm4 myscm5): now delete slibcat and implcat to keep + them from getting stale. + + * gmalloc.c: HP-UX B.10.10 A doesn't have getpagesize.h. + +Fri Oct 10 00:18:40 1997 Peter E. Davis <pete@media.mit.edu> + + * unexhp9k800.c: added HP-UX unexec support. + +Mon Sep 29 15:18:37 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * sys.c (mark_syms): No longer mark the value cell because value + cells get returned by calls to intern(). This caused a rare GC + leak which showed up in large programs. + +Sun Sep 28 21:36:53 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * scm.h (const): defined to comment for hpux native cc. + +Sun Sep 28 14:48:10 1997 Radey Shouman <shouman@zianet.com> + + * ramap.c (array_imap): Fixed for zero-rank arrays arguments. + +Fri Sep 19 23:23:46 EDT 1997 Aubrey Jaffer <jaffer@aubrey.jaffer> + + * patchlvl.h (SCMVERSION): Bumped from 5b1 to 5b2. + +Fri Sep 19 23:17:48 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * build.scm (build:build): DEFAULT field-name changed to + DEFAULTER in concert with SLIB/dbutil.scm. + +Tue Aug 26 17:40:44 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * build.scm (build): Changed sun to sunos; This gives automatic + platform from uname. + +Wed Jul 2 14:25:52 1997 Anthony Green <green@cygnus.com> + + * scmfig.h (FENCE): macro added. DEFER_INTS/ALLOW_INTS doesn't + actually promise to keep the critical code within the boundries of + the DEFER/ALLOW_INTS instructions. It may very well schedule it + outside of the magic defined in those macros. GCC's volatile asm + feature forms a barrier over which code is never moved. + +Wed Jun 25 12:56:22 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * repl.c (tryload): Undid previous tail-recursive hack; it caused + errors and warning to issue from grossly wrong line numbers. + +Sun Jun 8 21:40:50 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * mkimpcat.scm: updated for shared-library wb. + +Mon May 19 18:12:33 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * dynl.c (l_dyn_main_call): added for SUN_DL. + +Sat May 17 23:21:05 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * repl.c (lreadparen): Now calls wta when EOF is encountered in + list. This must have broken when rewritten to use `UNDEFINED' as + magic-cookie. + +Sat May 10 21:54:47 EDT 1997 Aubrey Jaffer <jaffer@scm.bertronics.com> + + * patchlvl.h (SCMVERSION): Bumped from 5b0 to 5b1. + +Sat May 10 21:08:41 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * mkimpcat.scm: moved from Init.scm, macro feature now properly + listed. + +Thu Apr 17 15:16:56 1997 Denys Duchier <Denys.Duchier@ps.uni-sb.de> + + * build.scm (build): extended with the new platform + sun-svr4-gcc-sunld because my system runs solaris, uses gcc as its + compiler, but is configured to use sun's linker rather than gnu's. + + I tested the changes in so far as the resulting system compiles, + runs, passes the tests, and is able to dump an image which can be + successfully restarted. I used the following command to create my + building script: + + build.scm -p sun-svr4-gcc-sunld -o SCM+ -w redo \ + --compiler-options=-DHAVE_UNISTD_H -F bignums \ + arrays array-for-each inexact rev2-procedures \ + record compiled-closure generalized-c-arguments \ + i/o-extensions regex socket posix unix dump \ + cheap-continuations macro + + * scm.texi (Build Options): updated the documentation of `build + options': removed memoize-local-bindings, which is not supported + by build.scm, and added macro, which is. + + * ecrt0.c: modified the sparc's asm in ecrt0.c to call main + and _exit when __svr4__ is defined instead of _main + and __exit. It seems the prepending of an underscore + is a thing of the past. + +Tue May 6 12:34:43 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * Init.scm (print-args): syntax added. + +Mon Apr 28 20:24:47 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * mkimpcat.scm: created from "Link.scm"; mkimpcat.scm creates + "implcat" in implementation-vicinity, supporting slib2b0 + catalog abstraction. + + * repl.c (dump): dump (defined by init_repl) now sets *catalog* to + #f in order to trigger loading of "slibcat" and "implcat". + + * build.scm (build): make-nothing renamed to update-catalog. + update-catalog and make-dll-archive create fresh "implcat". + + * sys.c (open_file): ALLOW_INTS was misplaced, causing lots of + "ints already enabled" messages. + + * repl.c (ints_viol): written. + + * scmfig.h (DEFER_INTS ALLOW_INTS): rewritten using ints_viol() to + allow easy gdb breakpointing. + + * repl.c (lreadpr): renamed from lreadr(). New lreadr() created. + (flush_ws): fixed linum++ bug. + (lreadparen): rewrote to use UNDEFINED as close-parenthesis magic + cookie; #+foo <expression> can now appear at end of lists and files. + +Fri Apr 25 22:52:20 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * scl.c (istr2flo): supplied missing IMP test before INEXP test. + +Fri Mar 21 08:44:52 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * Transcen.scm (log10): defined to $log10. + + * scl.c: added $log10. + +Thu Mar 20 21:09:19 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * Init.scm (scm:load): test for script files skips hopeless calls + to link:link. + (file-readable?): added. Non-blocking reads first 2 characters of + file. + +Tue Mar 18 18:38:14 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * script.c (scm_cat_path scm_try_path scm_sep_init_try): + (scm_find_impl_file dld_find_executable): moved from scm.c + (script_find_executable script_P): added. + (script_read_arg script_meta_arg_P): added. + (script_process_argv script_count_argv): added. + These functions implement `script meta-args' ala SCSH for unix + and MS-DOS. + + * repl.c (scm_unexec): Now checks for execpath being set. + (final_repl): No longer tries to set execpath. + + * dynl.c (init_dynl): Instead of trying to set execpath, now gives + error message if NULL. + + * patchlvl.h (SCMVERSION): Bumped from 5a1 to 5b0. + +Sat Mar 15 17:04:07 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * scm.c (main): Assumes called as a script when first argument + (argv[1]) is "\\"; and finds execpath with + dld_find_script_executable() instead of dld_find_executable(). + + * findexec.c (dld_find_executable): Now prepends current working + directory to any path with a `/' in it. + (dld_find_script_executable): Added to resolve real executable + pathname when program is invoked as a script. + + * Init.scm (read:sharp): #! now a balanced comment when first line + ends with \ (backslash). This is to support SCSH scripts. + +Fri Mar 7 21:12:17 EST 1997 Aubrey Jaffer <jaffer@scm.bertronics.com> + + * patchlvl.h (SCMVERSION): Bumped from 5a0 to 5a1. + +Mon Mar 3 20:09:43 1997 Radey Shouman <shouman@zianet.com> + + * eval.c (renamed_ident): Renamed RENAME-IDENTIFIER to + RENAMED-IDENTIFIER. + + * eval.c (m_case): Avoid renaming data at the head of each + clause. + +Wed Feb 26 10:17:59 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * Macro.scm (macro:compile-syntax-rules): + * Init.scm (copy-tree): use of copy-tree changed to @copy-tree. + + * eval.c (copy-tree): renamed to @copy-tree. + + * sys.c (igc): test added for calls to igc within igc. + + * unif.c (raprin1): calls ipruk() instead of using cells if + called during gc. + + * scl.c (bigprint floprint): no longer try to allocate cells if + called during gc. + + * .gdbinit (runscm verbose errobj scm load eval): added for + debugging with GDB 4.16. + +Tue Feb 25 21:32:50 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * repl.c (iprin1): Now checks that a cell is actually in a heap + before trying to print it. + + * rope.c (scm_cell_p): added. Returns !0 if SCM argument is + cell-aligned and points into a valid heap segment. + +Sun Feb 23 21:21:21 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * continue.h: SCM source now uses jump_buf, setjump, and longjump + in lieu of jmp_buf, setjmp, and longjmp. This should prevent name + and declaration conflicts. + + * build.scm (include-spec): created to elide "-I" if scm-srcdir is + "". + +Sat Feb 22 20:45:58 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * repl.c (lreadr): uncommented line 640 to allow reading balanced + comments at end of files. + + * build.scm (scm-srcdir): now defaults to user-vicinity, rather + than implementation-vicinity. + + * Init.scm (warn): added. + + * repl.c (exitval): Now initialized. + (quit): fixed return value bug. + (abrt): Now returns failure exit code if errjmp_bad. + +Tue Feb 11 21:08:44 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * ugsetjmp.s: Created for Ultrix-VAX port. + +Mon Feb 3 08:55:43 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * repl.c (read_token): `#' no longer terminates tokens + (identifiers and numbers). + +Sun Feb 2 17:42:50 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * build.scm (build-whats): #define DLL if compiling for library. + + * record.c (MAKE_REC_INDS REC_IND_REF REC_IND_SET): now default to + regular vectors if compiling as DLL. + +Sat Feb 1 21:41:15 EST 1997 Aubrey Jaffer <jaffer@scm.bertronics.com> + + * patchlvl.h (SCMVERSION): Bumped from 4e6 to 5a0. + +Sat Jan 25 19:48:19 1997 Radey Shouman <shouman@zianet.com> + + * scm.h (IM_DELAY) (IM_QUASIQUOTE) (IM_UNQUOTE) (IM_UQ_SPLICING) + (IM_ELSE) (IM_ARROW): Added to support hygienic macros. + + * repl.c: isymnames modified. + + * eval.c (lookupcar): Added support for hygienic macros + (evalatomcar): Added. + (ident2sym) (id_denote) (unpaint) (prinid) (ident_eqp) + (rename_ident) (syn_quote) (m_atlet_syntax) (m_the_macro): added. + (m_quote) (m_cond) (m_case) (m_quasiquote): Modified to be + referentially transparent. + (m_iqq): added. + (m_delay): now memoizes to prevent speed hit from slower lookupcar. + + * scmfig.h: MACRO macro included. + + * Init.scm: Modified to avoid "keyword as variable" errors. + + * Macro.scm: SYNTAX-RULES, added. + + * syntest1.scm: syntest2.scm: SYNTAX-RULES tests, added. + + * scm.texi: Hygienic macro support documentation. + +Thu Dec 12 13:00:46 1996 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * subr.c (string make_string st_ref st_set st_equal st_append): + Corrected long-standing + (not (eqv? (integer->char 128) + (string-ref (make-string 1 (integer->char 128)) 0))) + bug found by John Kozak <jk@noontide.demon.co.uk>. + +Mon Dec 2 20:40:40 1996 Radey Shouman <shouman@zianet.com> + + * eval.c (farlookup): Added, to handle memoized lookups in local + environments with very wide or deep local environments. + These print as (#@farloc-car iframe . idist). + (lookupcar): Now inserts `farloc' forms instead of ilocs if + necessary. + (ceval): Modified to do the right thing with farlocs. + + * scm.h (MAKILOC): Added, now used in lookupcar. + (IM_FARLOC_CDR) (IM_FARLOC_CAR): ISYMS added. + +Sun Dec 1 00:41:07 1996 Aubrey Jaffer <jaffer@martigny.ai.mit.edu> + + * build.scm (build): Added scm-srcdir to support compilation of + SCM source while not cd'd to SCM directory. -I<scm-srcdir> added + to all builds (to pick up scm.h, etc.). + +Sat Nov 30 20:53:03 1996 Lorens Younes <d93-hyo@nada.kth.se> + + * findexec.c, scmfig.h, time.c: __amigados__ (gcc on amiga) + support added. + Mon Nov 18 22:56:11 1996 Aubrey Jaffer <jaffer@localhost.bertronics.com> * patchlvl.h (SCMVERSION): 4e6 released. @@ -43,12 +405,12 @@ Sat Nov 2 09:24:50 EST 1996 maximum entropy <entropy@zippy.bernstein.com> FIONREAD, ...)" are such that it gives 0 on a socket that is closed (on the other side of the connection). If the system has select(), use that instead to get the correct - behavior. + behavior. * socket.c (l_listen): Treat sockets that have been "listened" as input-ports. This allows polling for new connections (e.g. with "char-ready?") instead of blocking in - "socket:accept". + "socket:accept". * socket.c (l_accept): Fix type checking to agree with previous patch. @@ -68,13 +430,13 @@ Tue Oct 29 10:47:41 1996 Aubrey Jaffer <jaffer@localhost.bertronics.com> Mon Oct 28 11:39:30 1996 Aubrey Jaffer <jaffer@localhost.bertronics.com> * repl.c (tryload): Made tail-recursive so that dump, quit, exit, - etc. will work as the last expression in a loading file. + etc. will work as the last expression in a loading file. (scm_execpath): Split out from scm_unexec. Sun Oct 27 22:12:32 1996 Aubrey Jaffer <jaffer@localhost.bertronics.com> * unexec.c: All Updated from emacs-19.34 -- no changes necessary. - * gmalloc.c: + * gmalloc.c: * pre-crt0.c: * ecrt0.c: * unexelf.c: fixes Linux (ELF) dump bug. @@ -82,9 +444,9 @@ Sun Oct 27 22:12:32 1996 Aubrey Jaffer <jaffer@localhost.bertronics.com> Mon Oct 21 21:49:20 1996 Aubrey Jaffer <jaffer@martigny.bertronics> * build.scm (platform): linux renamed linux-aout. linux-elf fixed - and renamed linux. + and renamed linux. (C-libraries): X11R6 moved library files on RedHat Linux. Linux - graphics library now has entry (doesn't default). + graphics library now has entry (doesn't default). (compile-dll-c-files linux): (make-dll-archive linux): Now converts from ".o" objects to ELF ".so" form and "links" the usual libraries. @@ -193,17 +555,17 @@ Sun May 12 21:43:14 1996 Radey Shouman <shouman@zianet.com> wierdness if cases are added later. * ramap.c (ra_matchp): Fixed to allow any 1-d array of zero size - to match a uniform vector, and to require all non-zero length - dimensions of two arrays to match even after a zero length - dimension. Now promotes 0-d arrays as well as scalars to match - first array shape. + to match a uniform vector, and to require all non-zero length + dimensions of two arrays to match even after a zero length + dimension. Now promotes 0-d arrays as well as scalars to match + first array shape. (sc2array): Reshapes 0-d arrays as well as scalars. - Added check to make sure 2nd argument is really an array, + Added check to make sure 2nd argument is really an array, vector or uve. - (ramapc): Changed to allocate fewer array headers when arguments - are 1-d arrays. (Still allocates more than strictly necessary.) - (array_copy): Added check for scalar destination argument, since - ra_matchp() will now promote scalars to arrays. + (ramapc): Changed to allocate fewer array headers when arguments + are 1-d arrays. (Still allocates more than strictly necessary.) + (array_copy): Added check for scalar destination argument, since + ra_matchp() will now promote scalars to arrays. Sun May 12 00:52:51 1996 Aubrey Jaffer <jaffer@jacal.bertronics> @@ -223,7 +585,7 @@ Tue Apr 9 19:46:21 1996 Aubrey Jaffer <jaffer@jacal.bertronics> * sys.c (igc): stackbase argument added. Passing 0 disables stack marking (used by dump). - * build.scm (build link-c-program djgpp): + * build.scm (build link-c-program djgpp): (build compile-c-files djgpp): Uses new batch:apply-chop-to-fit to deal with MS-DOS line length restrictions. @@ -339,22 +701,22 @@ Sun Mar 10 17:23:39 1996 Radey Shouman <shouman@ccwf.cc.utexas.edu> ramap.c. (uve_read, uve_write): (Re)added (ura_read, ura_write): Moved to ramap.c, now call uve_[read write]. - (ra2l): uses cvref instead of aref, maybe faster and works for + (ra2l): uses cvref instead of aref, maybe faster and works for enclosed arrays. (init_unif): Added feature 'string-case, to prevent require from nuking STRING-UPCASE!, STRING-DOWNCASE! (encl_array): Added range check for dimension args. - + * rope.c (num2dbl): Added, analogous to num2dbl. * scmfig.h Eliminated redundant #ifdef * scl.c (makdbl) Rearranged so that it tests for out of range - double argument before assigning to float variable, this + double argument before assigning to float variable, this avoids causing SIGFPE on my Linux box. (equal): Fixed so that it doesn't need extern array_equal, allowing ramap.c to be dynamically linkable. - + * scm.c Added documented variable *scm-version* Thu Mar 21 00:14:29 1996 Aubrey Jaffer <jaffer@jacal.bertronics> @@ -521,9 +883,9 @@ Sat Jul 8 22:23:03 1995 Aubrey Jaffer (jaffer@jacal) Fri Jun 9 13:47:58 1995 Aubrey Jaffer (jaffer@jacal) * continue.c (stack_size): - (make_root_continuation): - (make_continuation): - (free_continuation): + (make_root_continuation): + (make_continuation): + (free_continuation): (throw_to_continuation): moved from sys.c to make possible library module. @@ -608,7 +970,7 @@ Sat Mar 25 20:37:48 1995 Aubrey Jaffer (jaffer@jacal) regex library is conditionalized with _GNU_SOURCE. From: Radey Shouman <shouman@ccwf.cc.utexas.edu> - * Iedline.scm ((make-edited-line-port)): + * Iedline.scm ((make-edited-line-port)): * edline.c (lreadline): Added Gnu `readline' input editing (get ftp.sys.toronto.edu:/pub/rc/editline.shar). @@ -42,7 +42,7 @@ ;;; Author: Aubrey Jaffer. (define (scheme-implementation-type) 'SCM) -(define (scheme-implementation-version) "4e6") +(define (scheme-implementation-version) "5b3") ;;; Temporary hack for compatability with older versions. (define software-type @@ -89,6 +89,15 @@ (if library-path (lambda () library-path) implementation-vicinity))) +(define home-vicinity + (let ((home (getenv "HOME"))) + (and home + (case (software-type) + ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + (if (not (char=? #\/ (string-ref home (+ -1 (string-length home))))) + (set! home (string-append home "/")))))) + (lambda () home))) + ;;; Here for backward compatability (define scheme-file-suffix (case (software-type) @@ -103,7 +112,6 @@ string-port source current-time) *features*)) -(define slib:exit quit) (define (exec-self) (require 'i/o-extensions) (execv (execpath) (program-arguments))) @@ -179,13 +187,20 @@ ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (read:array c port)) ((#\!) (if (= 1 (line-number)) - (let skip () (if (eq? #\newline (peek-char port)) - (if #f #f) - (begin (read-char port) (skip)))) + (let skip ((metarg? #f)) + (case (read-char port) + ((#\newline) (if metarg? (skip #t))) + ((#\\) (skip #t)) + ((#\!) (if (not (and (eqv? #\# (peek-char port)) + (read-char port))) + (skip metarg?))) + (else (skip metarg?)))) (barf))) (else (barf)))) (define type 'type) ;for /bin/sh hack. +(define : ':) +(define !#(if #f #f)) ;for scsh hack. ;;;; Here are some Revised^2 Scheme functions: (define 1+ @@ -202,15 +217,29 @@ (define >=? >=) (define t #t) (define nil #f) -(define sequence begin) - -(set! apply - (let ((apply:nconc-to-last apply:nconc-to-last) - (@apply @apply)) - (lambda (fun . args) (@apply fun (apply:nconc-to-last args))))) -(define call-with-current-continuation - (let ((@call-with-current-continuation @call-with-current-continuation)) - (lambda (proc) (@call-with-current-continuation proc)))) +(cond ((defined? the-macro) + (define sequence (the-macro begin)) + (set! apply + (let ((apply:nconc-to-last apply:nconc-to-last) + (@apply (the-macro @apply))) + (lambda (fun . args) (@apply fun (apply:nconc-to-last args))))) + (define call-with-current-continuation + (let ((@call-with-current-continuation + (the-macro @call-with-current-continuation))) + (lambda (proc) (@call-with-current-continuation proc))))) + (else + (define sequence begin) + (set! apply + (let ((apply:nconc-to-last apply:nconc-to-last) + (@apply @apply)) + (lambda (fun . args) (@apply fun (apply:nconc-to-last args))))) + (define call-with-current-continuation + (let ((@call-with-current-continuation + @call-with-current-continuation)) + (lambda (proc) (@call-with-current-continuation proc)))))) +(if (defined? copy-tree) + (define @copy-tree copy-tree) + (define copy-tree @copy-tree)) ;;; VMS does something strange when output is sent to both ;;; CURRENT-OUTPUT-PORT and CURRENT-ERROR-PORT. @@ -292,6 +321,18 @@ (if (not (defined? force-output)) (define (force-output . a) #f)) +(define (warn . args) + (define cep (current-error-port)) + (perror "WARN") + (errno 0) + (display "WARN: " cep) + (if (not (null? args)) + (begin (display (car args) cep) + (for-each (lambda (x) (display #\ cep) (write x cep)) + (cdr args)))) + (newline cep) + (force-output cep)) + (define (error . args) (define cep (current-error-port)) (perror "ERROR") @@ -306,12 +347,28 @@ (abort)) (define set-errno errno) +(define slib:exit quit) (define exit quit) +(define (print . args) + (define result #f) + (for-each (lambda (x) (set! result x) (write x) (display #\ )) args) + (newline) + result) + (define (file-exists? str) (let ((port (open-file str OPEN_READ))) - (if port (begin (close-port port) #t) - #f))) + (and port (close-port port) #t))) +(define (file-readable? str) + (let ((port (open-file str OPEN_READ))) + (and port + (char-ready? port) + (do ((c (read-char port) + (and (char-ready? port) (read-char port))) + (i 0 (+ 1 i)) + (l '() (cons c l))) + ((or (not c) (eof-object? c) (<= 2 i)) + (if (null? l) #f (list->string (reverse l)))))))) (define difftime -) (define offset-time +) @@ -341,6 +398,7 @@ (define (identity x) x) (define slib:error error) +(define slib:warn warn) (define slib:tab #\tab) (define slib:form-feed #\page) (define slib:eval eval) @@ -373,21 +431,21 @@ (define hss (has-suffix? file (scheme-file-suffix))) (load:pre file) (or (and (defined? link:link) (not hss) - (or (apply link:link file libs) + (or (let ((s2 (file-readable? file))) + (and s2 (not (equal? "#!" s2)) (apply link:link file libs))) (and link:able-suffix - (let ((fs (string-append file link:able-suffix))) - (cond ((not (file-exists? fs)) #f) - ((apply link:link fs libs) (set! filesuf fs) #t) - (else #f)))))) + (let* ((fs (string-append file link:able-suffix)) + (fs2 (file-readable? fs))) + (and fs2 (apply link:link fs libs) (set! filesuf fs) #t) + )))) (and (null? libs) (try-load file)) ;;HERE is where the suffix gets specified - (and (not hss) - (begin (errno 0) ; clean up error from TRY-LOAD above - (set! filesuf (string-append file (scheme-file-suffix))) - (try-load filesuf))) + (and (not hss) (errno 0) ; clean up error from TRY-LOAD above + (set! filesuf (string-append file (scheme-file-suffix))) + (try-load filesuf)) (and (procedure? could-not-open) (could-not-open) #f) - (let () (set! load:indent 0) - (error "LOAD couldn't find file " file))) + (begin (set! load:indent 0) + (error "LOAD couldn't find file " file))) (load:post filesuf)) (define load scm:load) (define slib:load load) @@ -453,7 +511,7 @@ (lambda (f) (procedure->memoizing-macro (lambda (exp env) - (copy-tree (apply f (cdr exp))))))) + (@copy-tree (apply f (cdr exp))))))) (define defmacro (let ((defmacro-transformer @@ -502,12 +560,6 @@ (evl o)) (set! *load-pathname* old-load-pathname))))) -(define (print . args) - (define result #f) - (for-each (lambda (x) (set! result x) (write x) (display #\ )) args) - (newline) - result) - ;;; Autoloads for SLIB procedures. (define (tracef . args) (require 'trace) (apply tracef args)) @@ -529,10 +581,31 @@ (defmacro defvar (var val) `(if (not (defined? ,var)) (define ,var ,val))) +(define print-args + (procedure->syntax + (lambda (sexp env) + (let ((frame (and (not (null? env)) (car env)))) + (cond ((not (null? (cdr sexp))) + (display "In") + (for-each (lambda (exp) (display #\ ) (display exp)) (cdr sexp)) + (display ": "))) + (do ((vars (car frame) (cdr vars)) + (vals (cdr frame) (cdr vals))) + ((not (pair? vars)) + (cond ((not (null? vars)) + (write vars) + (display " := ") + (write vals))) + (newline)) + (write (car vars)) + (display " = ") + (write (car vals)) + (display "; ")))))) + (cond ((defined? stack-trace) - #+breakpoint-error;; remove this line to enable breakpointing on errors + #+breakpoint-error;; remove line to enable breakpointing on calls to ERROR (define (error . args) (define cep (current-error-port)) (perror "ERROR") @@ -560,13 +633,11 @@ ;;; ABS and MAGNITUDE can be the same. (cond ((and (inexact? (string->number "0.0")) (not (defined? exp))) - (if (defined? usr:lib) - (if (usr:lib "m") - (load (in-vicinity (implementation-vicinity) "Transcen") - (usr:lib "m")) - (load (in-vicinity (implementation-vicinity) "Transcen"))) - (load (in-vicinity (implementation-vicinity) "Transcen" - (scheme-file-suffix)))) + (or (and (defined? usr:lib) + (usr:lib "m") + (load (in-vicinity (implementation-vicinity) "Transcen") + (usr:lib "m"))) + (load (in-vicinity (implementation-vicinity) "Transcen"))) (set! abs magnitude))) (if (defined? array?) @@ -606,23 +677,12 @@ ;;; This loads the user's initialization file, or files named in ;;; program arguments. -(or - (eq? (software-type) 'THINKC) - (member "-no-init-file" (program-arguments)) - (member "--no-init-file" (program-arguments)) - (try-load - (in-vicinity - (let ((home (getenv "HOME"))) - (if home - (case (software-type) - ((UNIX COHERENT) - (if (char=? #\/ (string-ref home (+ -1 (string-length home)))) - home ;V7 unix has a / on HOME - (string-append home "/"))) - (else home)) - (user-vicinity))) - "ScmInit.scm")) - (errno 0)) +(or (eq? (software-type) 'THINKC) + (member "-no-init-file" (program-arguments)) + (member "--no-init-file" (program-arguments)) + (try-load (in-vicinity (or (home-vicinity) (user-vicinity)) + (string-append "ScmInit") (scheme-file-suffix))) + (errno 0)) (if (not (defined? *R4RS-macro*)) (define *R4RS-macro* #f)) @@ -704,7 +764,7 @@ (cond ((zero? (modulo i 4)) (newline cep) (display indent cep)))) (cdr arg-opts)) (display " [-- | -s | -] [file] [args...]" cep) (newline cep) - (if success? (display success? cep) (exit #f))) + (if success? (display success? cep) (quit #f))) ;; -a int => ignore (handled by run_scm) ;; -c str => (eval str) @@ -838,7 +898,7 @@ There is no warranty, to the extent permitted by law. (set! *interactive* #t))))) (cond ((not *interactive*) (quit)) - (*R4RS-macro* + ((and *R4RS-macro* (not (provided? 'macro))) (require 'repl) (require 'macro) (let* ((oquit quit)) @@ -846,7 +906,7 @@ There is no warranty, to the extent permitted by law. (set! exit quit) (repl:top-level macro:eval) (oquit)))) - ;;otherwise, fall into non-macro SCM repl. + ;;otherwise, fall into natural SCM repl. ) (else (begin (errno 0) @@ -1,4 +1,4 @@ -;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -57,19 +57,18 @@ (define scm:object-suffix (case (software-type) ((MSDOS VMS) ".OBJ") - (else (if (provided? 'sun-dl) ".so" ".o")))) + (else ".o"))) ;;; This is an unusual autoload because it should load either the ;;; source or compiled version if present. (if (not (defined? hobbit)) ;Autoload for hobbit (define (hobbit . args) - (require (in-vicinity (implementation-vicinity) "hobbit")) - (provide 'hobbit) + (require 'hobbit) (apply hobbit args))) (define (compile-file file . args) (apply hobbit file args) - (require (in-vicinity (implementation-vicinity) "build")) + (require 'build) (build-from-whole-argv (list "build" "-tdll" (string-append "--compiler-options=-I" (implementation-vicinity)) @@ -80,7 +79,7 @@ ))) (define (link-named-scm name . modules) - (require (in-vicinity (implementation-vicinity) "build")) + (require 'build) (let* ((iv (implementation-vicinity)) (oss (string-append scm:object-suffix " ")) (command @@ -105,7 +104,7 @@ (cond ((defined? dyn:link) (define link:modules '()) - (define link:able-suffix + (define link:able-suffix (cond ((provided? 'shl) ".sl") ((provided? 'sun-dl) ".so") (else ".o"))) @@ -168,117 +167,25 @@ (else (loop (- i 1))))) (vms:dynamic-link-call dir fil (string-append "init_" fil))))) -(set! *catalog* - (acons 'scmhob (in-vicinity (implementation-vicinity) "scmhob") - *catalog*)) -(and (defined? *catalog*) (defined? link:link) - (cond ((provided? 'dld:dyncm) - (define (usr:lib lib) - (or (and (member lib '("c" "m")) - (let ((sa (string-append "/usr/lib/lib" lib ".sa"))) - (and (file-exists? sa) sa))) - (string-append "/usr/lib/lib" lib ".a"))) - (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa"))) - ((provided? 'sun-dl) - ;; These libraries are (deferred) linked in conversion to ".so" - (define (usr:lib lib) #f) - (define (x:lib lib) #f)) - ((provided? 'shl) - (define (usr:lib lib) - (if (member lib '("c" "m")) - (string-append "/lib/lib" lib link:able-suffix) - (string-append "/usr/lib/lib" lib link:able-suffix))) - (define (x:lib lib) (string-append "/usr/X11R5/lib/lib" - lib link:able-suffix))) - (else - (define (usr:lib lib) (string-append "/usr/lib/lib" lib ".a")) - (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa")))) - (begin - (define wb:vicinity (string-append (implementation-vicinity) "../wb/")) - (define (catalog:add-link feature ofile . libs) - (define fe (file-exists? ofile)) - (cond ((or (not (require:feature->path feature)) fe) - ;; remove #f from libs list - (set! libs (let rem ((l libs)) - (cond ((null? l) l) - ((car l) (cons (car l) (rem (cdr l)))) - (else (rem (cdr l)))))) - (set! *catalog* - (acons feature (cons 'compiled (cons ofile libs)) - *catalog*)) - fe) - (else #f))) - (set! *catalog* - (acons 'wb-table (in-vicinity wb:vicinity "wbtab") *catalog*)) - (catalog:add-link 'db - (in-vicinity wb:vicinity "db" link:able-suffix) - (in-vicinity wb:vicinity "handle" link:able-suffix) - (in-vicinity wb:vicinity "blink" link:able-suffix) - (in-vicinity wb:vicinity "prev" link:able-suffix) - (in-vicinity wb:vicinity "ent" link:able-suffix) - (in-vicinity wb:vicinity "sys" link:able-suffix) - (in-vicinity wb:vicinity "del" link:able-suffix) - (in-vicinity wb:vicinity "stats" link:able-suffix) - (in-vicinity wb:vicinity "blkio" link:able-suffix) - (in-vicinity wb:vicinity "scan" link:able-suffix) - (usr:lib "c")) - (set! *catalog* (cons '(wb . db) *catalog*)) - (catalog:add-link 'turtle-graphics - (in-vicinity (implementation-vicinity) "turtlegr" - link:able-suffix) - (x:lib "X11") - (usr:lib "m") - (usr:lib "c")) - (catalog:add-link 'curses - (in-vicinity (implementation-vicinity) "crs" - link:able-suffix) - (usr:lib "ncurses") - ;;(usr:lib "curses") - ;;(usr:lib "termcap") - (usr:lib "c")) - (catalog:add-link 'edit-line - (in-vicinity (implementation-vicinity) "edline" - link:able-suffix) - (usr:lib "edit") - (usr:lib "termcap") - (usr:lib "c")) - (catalog:add-link 'regex - (in-vicinity (implementation-vicinity) "rgx" - link:able-suffix) - (usr:lib "c")) - (catalog:add-link 'unix - (in-vicinity (implementation-vicinity) "unix" - link:able-suffix) - (in-vicinity (implementation-vicinity) "ioext" - link:able-suffix) - (usr:lib "c")) - (catalog:add-link 'posix - (in-vicinity (implementation-vicinity) "posix" - link:able-suffix) - (usr:lib "c")) - (catalog:add-link 'socket - (in-vicinity (implementation-vicinity) "socket" - link:able-suffix) - (usr:lib "c")) - (cond ((catalog:add-link 'i/o-extensions - (in-vicinity (implementation-vicinity) "ioext" - link:able-suffix) - (usr:lib "c")) - (set! *catalog* (append '((line-i/o . i/o-extensions) - (pipe . i/o-extensions)) - *catalog*)))) - (cond ((catalog:add-link 'rev2-procedures - (in-vicinity (implementation-vicinity) "sc2" - link:able-suffix)) - (set! *catalog* (cons '(rev3-procedures . rev2-procedures) - *catalog*)))) - (catalog:add-link 'record - (in-vicinity (implementation-vicinity) "record" - link:able-suffix)) - (catalog:add-link 'generalized-c-arguments - (in-vicinity (implementation-vicinity) "gsubr" - link:able-suffix)) - (catalog:add-link 'array-for-each - (in-vicinity (implementation-vicinity) "ramap" - link:able-suffix)) - )) +(cond + ((provided? 'sun-dl) + ;; These libraries are (deferred) linked in conversion to ".so" + (define (usr:lib lib) #f) + (define (x:lib lib) #f)) + ((provided? 'shl) + (define (usr:lib lib) + (if (member lib '("c" "m")) + (string-append "/lib/lib" lib link:able-suffix) + (string-append "/usr/lib/lib" lib link:able-suffix))) + (define (x:lib lib) (string-append "/usr/X11R5/lib/lib" + lib link:able-suffix))) + ((provided? 'dld:dyncm) + (define (usr:lib lib) + (or (and (member lib '("c" "m")) + (let ((sa (string-append "/usr/lib/lib" lib ".sa"))) + (and (file-exists? sa) sa))) + (string-append "/usr/lib/lib" lib ".a"))) + (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa"))) + ((provided? 'dld) + (define (usr:lib lib) (string-append "/usr/lib/lib" lib ".a")) + (define (x:lib lib) (string-append "/usr/X11/lib/lib" lib ".sa")))) diff --git a/Macro.scm b/Macro.scm new file mode 100644 index 0000000..f053b9c --- /dev/null +++ b/Macro.scm @@ -0,0 +1,292 @@ +;; Support for R4RS macros. +;; +;; As in SYNTAX-CASE, the identifier ... may be quoted in a +;; SYNTAX-RULES pattern or template as (... ...). +;; +;; THE-MACRO may be used to define macros, eg +;; (define-syntax foo (the-macro and)) +;; defines the syntactic keyword FOO to have the same transformer +;; as the macro AND. + +(require 'rev2-procedures) ;append! +(require 'record) + +(define macro:compile-syntax-rules + ;; We keep local copies of these standard special forms, otherwise, + ;; redefining them before they are memoized below can lead to + ;; infinite recursion. + (@let-syntax ((lambda (the-macro lambda)) + (let (the-macro let)) + (cond (the-macro cond)) + (if (the-macro if)) + (and (the-macro and)) + (or (the-macro or))) + (let ((var-rtd (make-record-type '? '(name rank))) + (e-pat-rtd (make-record-type '... '(pattern vars)))) + + (define pattern-variable (record-constructor var-rtd '(name rank))) + (define pattern-variable? (record-predicate var-rtd)) + (define pattern-variable->name + (let ((acc (record-accessor var-rtd 'name))) + (lambda (x) (identifier->symbol (acc x))))) + (define pattern-variable->rank (record-accessor var-rtd 'rank)) + + ;; An ellipsis-pattern is used both for ellipses in patterns and + ;; ellipses in templates. In a pattern, VARS is the list of variables + ;; bound by the ellipsis pattern. In a template, VARS is the list of + ;; variables opened by the ellipsis template. + + (define ellipsis-pattern (record-constructor e-pat-rtd '(pattern vars))) + (define ellipsis-pattern? (record-predicate e-pat-rtd)) + (define ellipsis-pattern->pattern (record-accessor e-pat-rtd 'pattern)) + (define ellipsis-pattern->vars (record-accessor e-pat-rtd 'vars)) + + (define (append2 x y) + (if (null? y) x + (append x y))) + + (define ellipsis? + (let (($... (renamed-identifier '... #f))) + (lambda (x env) + (and + (identifier? x) + (identifier-equal? x $... env))))) + + ;; Yeah, it's quadratically slow. + (define (duplicates? vars) + (if (null? vars) + #f + (if (memq (car vars) (cdr vars)) + (car vars) + (duplicates? (cdr vars))))) + + (define (compile-pattern literals rule env-def) + (let recur ((pat (cdar rule)) + (vars '()) + (rank 0) + (k (lambda (compiled vars) + (let ((dup (duplicates? (map car vars)))) + (if dup + (error + "syntax-rules: duplicate pattern variable:" + dup " in rule " rule))) + (cons compiled + (rewrite-template + (cadr rule) vars env-def))))) + (cond ((null? pat) + (k pat vars)) + ((identifier? pat) + (let ((lit (memq pat literals))) + (if lit + (k pat vars) + (let ((var (pattern-variable pat rank))) + (k var (cons (cons pat var) vars)))))) + ((pair? pat) + (if (and (pair? (cdr pat)) + (ellipsis? (cadr pat) env-def) + (or (null? (cddr pat)) + (error "bad ellipsis:" pat))) + (if (ellipsis? (car pat) env-def) + (recur (car pat) vars rank k) + (recur (car pat) '() (+ rank 1) + (lambda (comp1 vars1) + (k (list + (ellipsis-pattern comp1 (map cdr vars1))) + (append2 vars1 vars))))) + (recur (car pat) '() rank + (lambda (comp1 vars1) + (recur (cdr pat) vars rank + (lambda (comp2 vars2) + (k (cons comp1 comp2) + (append2 vars1 vars2))))))))))) + + (define (rewrite-template template vars env-def) + (let recur ((tmpl template) + (rank 0) + (inserted '()) + (k (lambda (compiled inserted opened) + (list inserted compiled)))) + (cond ((null? tmpl) + (k tmpl '() '())) + ((identifier? tmpl) + (let ((v (assq tmpl vars))) + (if v + (cond ((= rank (pattern-variable->rank (cdr v))) + (k (cdr v) '() (list (cdr v)))) + ((> rank (pattern-variable->rank (cdr v))) + (k (cdr v) '() '())) + (else + (error "pattern variable rank mismatch:" tmpl + " in " template))) + (k tmpl (list tmpl) '())))) + ((pair? tmpl) + (if (and (pair? (cdr tmpl)) + (ellipsis? (cadr tmpl) env-def)) + (if (and (ellipsis? (car tmpl) env-def) + (or (null? (cddr tmpl)) + (error "bad ellipsis:" tmpl))) + ;; (... ...) escape + (k (car tmpl) (list (car tmpl)) '()) + (recur (car tmpl) (+ rank 1) '() + (lambda (comp1 ins1 op1) + (if (null? op1) + (error "Bad ellipsis:" + tmpl " in template " template)) + (recur (cddr tmpl) rank inserted + (lambda (comp2 ins2 op2) + (k (cons + (ellipsis-pattern comp1 op1) + comp2) + (append2 ins1 ins2) + (append2 op1 op2))))))) + (recur (car tmpl) rank '() + (lambda (comp1 ins1 op1) + (recur (cdr tmpl) rank inserted + (lambda (comp2 ins2 op2) + (k (cons comp1 comp2) + (append2 ins1 ins2) + (append2 op1 op2)))))))) + (else + (k tmpl '() '()))))) + + +;;; Match EXP to RULE, returning alist of variable bindings or #f. + + (define (match literals rule exp env-def env-use) + (let recur ((r rule) + (x (cdr exp))) + (cond ((null? r) + (and (null? x) '())) + ((pair? r) + (if (ellipsis-pattern? (car r)) + (and + (list? x) + (let ((pat (ellipsis-pattern->pattern (car r)))) + (let match1 ((x x) + (vals '())) + (if (null? x) + (if (null? vals) + (map list (ellipsis-pattern->vars (car r))) + (let ((vars (map car (car vals)))) + (apply map list vars + (map (lambda (al) + (map cdr al)) + (reverse vals))))) + (let ((val (recur pat (car x)))) + (and val + (match1 (cdr x) (cons val vals)))))))) + (and + (pair? x) + (let ((v1 (recur (car r) (car x)))) + (and v1 + (let ((v2 (recur (cdr r) (cdr x)))) + (and v2 (append2 v1 v2)))))))) + ((identifier? r) ;literal + (and (identifier? x) + (identifier-equal? (cdr (assq r literals)) x env-use) + '())) + ((pattern-variable? r) + (list (cons r x))) + (else + (and (equal? r x) '()))))) + + (define (substitute-in-template inserted template vars env-def) + (let ((ins (map (lambda (id) + (cons id (renamed-identifier id env-def))) + inserted))) + (let recur ((tmpl template) + (vars vars)) + (cond ((null? tmpl) + tmpl) + ((pair? tmpl) + (if (ellipsis-pattern? (car tmpl)) + (let ((enames (ellipsis-pattern->vars (car tmpl))) + (etmpl (ellipsis-pattern->pattern (car tmpl)))) + (let ((evals (apply map list + (map (lambda (nam) + (cdr (assq nam vars))) + enames)))) + (append! + (map (lambda (eval) + (recur etmpl + (append! + (map cons enames eval) + vars))) + evals) + (recur (cdr tmpl) vars)))) + (cons (recur (car tmpl) vars) + (recur (cdr tmpl) vars)))) + ((identifier? tmpl) + (let ((a (assq tmpl ins))) + (if a (cdr a) tmpl))) + ((pattern-variable? tmpl) + (@copy-tree (cdr (assq tmpl vars)))) + (else + tmpl))))) + + ;; MACRO:COMPILE-SYNTAX-RULES + (lambda (x-def env-def) + (or (and (list? x-def) + (< 2 (length x-def)) + (list? (cadr x-def))) + (error "Malformed syntax-rules:" x-def)) + (let ((literals (cadr x-def))) + (for-each (lambda (x) + (or (identifier? x) + (error "Bad literals list:" x-def))) + literals) + + ;;Rules have the form: (<pattern> <inserted-identifiers> <template>). + (let ((rules + (map + (lambda (rule) + (or (and (list? rule) + (= 2 (length rule))) + (error "Bad rule:" rule)) + (compile-pattern literals rule env-def)) + (cddr x-def))) + (re-lits + (map (lambda (sym) + (cons sym (renamed-identifier sym env-def))) + literals))) + + (lambda (x-use env-use) + (let loop ((rules rules)) + (cond ((null? rules) + (error "macro use does not match definition:" + x-use)) + ((match re-lits (caar rules) x-use env-def env-use) + => (lambda (vars) + (let ((r (car rules))) + (substitute-in-template (cadr r) + (caddr r) + vars + env-def)))) + (else + (loop (cdr rules)))))))))))) + +(define syntax-rules + (procedure->syntax + (lambda (expr env-def) + (procedure->memoizing-macro + (macro:compile-syntax-rules expr env-def))))) + +(define define-syntax + (syntax-rules () + ((define-syntax ?name ?val) + (define ?name (the-macro ?val))))) + +(define-syntax let-syntax + (syntax-rules () ((let-syntax ((?name ?val) ...) . ?body) + (@let-syntax + ((?name (the-macro ?val)) ...) . ?body)))) + +(define-syntax letrec-syntax + (syntax-rules () ((letrec-syntax ((?name ?val) ...) . ?body) + (@letrec-syntax + ((?name (the-macro ?val)) ...) . ?body)))) + +;; MACRO:EXPAND would require substantial work. +(define macro:load load) +(define macro:eval eval) +(provide 'macro) @@ -1,4 +1,4 @@ -# Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +# Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -38,14 +38,14 @@ # whether to permit this exception to apply to your modifications. # If you do not wish that, delete this exception notice. -# "Makefile" for scm4e6 Scheme Interpreter +# "Makefile" for scm5b3 Scheme Interpreter # Author: Aubrey Jaffer SHELL = /bin/sh #CC = -CFLAGS = #-g +CFLAGS = -g #LIBS = -LD = $(CC) #-g +LD = $(CC) -g # directory where COPYING and Init.scm reside. #IMPLPATH = /usr/local/src/scm/ @@ -84,9 +84,14 @@ intro: @echo " If this reports no errors, use scmlit to build.scm" @echo " fancier versions of scm, with optional features." +cfiles = scm.c time.c repl.c ioext.c scl.c sys.c eval.c subr.c sc2.c \ + unif.c rgx.c crs.c dynl.c record.c posix.c socket.c unix.c \ + rope.c ramap.c gsubr.c edline.c Iedline.scm continue.c \ + findexec.c script.c ofiles = time.o repl.o scl.o sys.o eval.o subr.o unif.o rope.o \ - continue.o findexec.o + continue.o findexec.o script.o # ramap.o +ifiles = Init.scm Transcen.scm Link.scm Macro.scm all: scmlit scmlit: $(ofiles) scm.o @@ -95,9 +100,11 @@ scm.o: scm.c scm.h scmfig.h patchlvl.h scmflags.h $(CC) $(CFLAGS) -c $(DFLAG) scm.c scmflags.h: scmflags scmflags: - echo "#ifndef IMPLINIT" > scmflags.h - echo "#define IMPLINIT \"$(IMPLINIT)\"" >> scmflags.h - echo "#endif" >> scmflags.h + echo "#ifndef IMPLINIT" > newflags.h + echo "#define IMPLINIT \"$(IMPLINIT)\"" >> newflags.h + echo "#endif" >> newflags.h + -if (diff newflags.h scmflags.h) then rm newflags.h; \ + else mv newflags.h scmflags.h; fi .c.o: $(CC) -c $(CFLAGS) $< -o $@ @@ -110,17 +117,30 @@ sys.o: sys.c scm.h scmfig.h scmflags.h setjump.h time.o: time.c scm.h scmfig.h scmflags.h subr.o: subr.c scm.h scmfig.h scmflags.h rope.o: rope.c scm.h scmfig.h scmflags.h -continue.o: continue.c continue.h setjump.h +continue.o: continue.c continue.h setjump.h scmflags.h $(CC) $(CFLAGS) -c continue.c srcdir=$(HOME)/scm/ -udscm: - $(srcdir)build.scm -hsystem -Fcautious bignums arrays inexact \ - engineering-notation dump dynamic-linking -o udscm +udscm4: $(cfiles) build.scm + $(srcdir)build.scm -hsystem -o udscm4 -Fcautious \ + bignums arrays inexact engineering-notation dump dynamic-linking + +udscm5: $(cfiles) build.scm + $(srcdir)build.scm -hsystem -o udscm5 -Fcautious \ + bignums arrays inexact engineering-notation dump dynamic-linking \ + macro + +myscm4: udscm4 $(ifiles) + -rm slibcat implcat + -mv scm scm~ + ./udscm4 -o scm + +myscm: udscm5 $(ifiles) + -rm slibcat implcat + -mv scm scm~ + ./udscm5 -r5 -o scm -myscm: udscm $(ifiles) - ./udscm -o scm mylib: $(srcdir)build.scm -hsystem -Fcautious bignums arrays inexact \ engineering-notation dump dynamic-linking -tlib @@ -130,9 +150,10 @@ pgscm: --compiler-options=-pg --linker-options=-pg ./udscm -o pgscm mydebug: - $(srcdir)build.scm -hsystem -Fcautious bignums arrays inexact \ - engineering-notation dump dynamic-linking debug -ogdbscm \ - --compiler-options=-Wall --linker-options=-Wall + $(srcdir)build.scm -hsystem -ogdbscm -F cautious \ + bignums arrays inexact engineering-notation dump dynamic-linking \ + macro \ + debug --compiler-options=-Wall --linker-options=-Wall #-DTEST_FARLOC mydlls: $(srcdir)build.scm -h system -t dll -c sc2.c rgx.c crs.c edline.c \ record.c gsubr.c ioext.c posix.c unix.c socket.c \ @@ -140,12 +161,16 @@ mydlls: myturtle: $(srcdir)build.scm -h system -F turtlegr -t dll +implcat: *.so mkimpcat.scm + ./scmlit -lmkimpcat.scm + checklit: r4rstest.scm ./scmlit -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)(gc)' check: r4rstest.scm ./scm -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)(gc)' bench: - echo `whoami`@`hostname` testing scm >> BenchLog + echo `whoami`@`hostname` testing scm \ + `scm -e'(display *scm-version*)'` >> BenchLog echo on `date` >> BenchLog ls -l scm >> BenchLog size scm >> BenchLog @@ -156,7 +181,8 @@ bench: echo tail -20 BenchLog benchlit: - echo `whoami`@`hostname` testing scmlit >> BenchLog + echo `whoami`@`hostname` testing scmlit \ + `scmlit -e'(display *scm-version*)'` >> BenchLog echo on `date` >> BenchLog ls -l scmlit >> BenchLog size scmlit >> BenchLog @@ -166,6 +192,9 @@ benchlit: echo >> BenchLog echo tail -20 BenchLog +report: + scmlit -e"(slib:report #t)" + scm -e"(slib:report #t)" dvidir=../dvi/ dvi: $(dvidir)scm.dvi @@ -176,7 +205,7 @@ $(dvidir)scm.dvi: $(srcdir)scm.texi $(dvidir)scm.fn Makefile $(dvidir)scm.fn: cd $(dvidir);tex $(srcdir)scm.texi xdvi: $(dvidir)scm.dvi - xdvi -s 3 $(dvidir)scm.dvi + xdvi -s 6 $(dvidir)scm.dvi htmldir=../public_html/ html: $(htmldir)scm_toc.html $(htmldir)scm_toc.html: $(srcdir)scm.texi @@ -185,7 +214,7 @@ $(htmldir)scm_toc.html: $(srcdir)scm.texi ################ INSTALL DEFINITIONS ################ prefix = /usr/local/ -exec_prefix = $(prefix)/ +exec_prefix = $(prefix) # directory where `make install' will put executable. bindir = $(exec_prefix)bin/ libdir = $(exec_prefix)lib/ @@ -197,11 +226,11 @@ includedir = $(prefix)include/ info: $(infodir)/scm.info $(infodir)/scm.info: scm.texi makeinfo scm.texi -o $(infodir)/scm.info + -rm $(infodir)/scm.info*.gz infoz: $(infodir)/scm.info.gz $(infodir)/scm.info.gz: $(infodir)/scm.info - -rm $(infodir)/scm.info*.gz - gzip $(infodir)/scm.info* + gzip -f $(infodir)/scm.info* install: scm.1 test -d $(bindir) || mkdir $(bindir) @@ -229,7 +258,7 @@ uninstall: -rm $(includedir)scmfig.h -rm $(libdir)libscm.a # -rm $(IMPLPATH)Init.scm -# -cp $(IMPLPATH)Link.scm +# -rm $(IMPLPATH)Link.scm # -rm $(IMPLPATH)Transcen.scm # -rm $(IMPLPATH)COPYING @@ -238,23 +267,25 @@ scm.doc: scm.1 #### Stuff for maintaining SCM below #### -VERSION = 4e6 +VERSION = 5b3 ver = $(VERSION) RM_R = rm -rf -cfiles = scm.c time.c repl.c ioext.c scl.c sys.c eval.c subr.c sc2.c \ - unif.c rgx.c crs.c dynl.c record.c posix.c socket.c unix.c \ - rope.c ramap.c gsubr.c edline.c Iedline.scm continue.c \ - findexec.c -ufiles = pre-crt0.c ecrt0.c gmalloc.c unexec.c unexelf.c +ufiles = pre-crt0.c ecrt0.c gmalloc.c unexec.c unexelf.c unexhp9k800.c \ + unexsunos4.c unexalpha.c + +# cxux-crt0.s ecrt0.c gmalloc.c pre-crt0.c unexaix.c unexalpha.c \ +# unexapollo.c unexconvex.c unexec.c unexelf.c unexelf1.c \ +# unexencap.c unexenix.c unexfx2800.c unexhp9k800.c unexmips.c \ +# unexnext.c unexnt.c unexsgi.c unexsni.c unexsunos4.c + confiles = scmconfig.h.in mkinstalldirs acconfig-1.5.h install-sh \ configure configure.in Makefile.in COPYING README.unix hfiles = scm.h scmfig.h setjump.h patchlvl.h continue.h -ifiles = Init.scm Transcen.scm Link.scm tfiles = r4rstest.scm example.scm pi.scm pi.c split.scm bench.scm dfiles = ANNOUNCE README COPYING scm.1 scm.doc QUICKREF \ scm.texi ChangeLog -mfiles = Makefile build.scm build.bat +mfiles = Makefile build.scm build.bat .gdbinit mkimpcat.scm vfiles = setjump.mar setjump.s afiles = $(dfiles) $(cfiles) $(hfiles) $(ifiles) $(tfiles) $(mfiles) \ $(vfiles) $(ufiles) @@ -316,14 +347,20 @@ hobbit$(HOBBITVERSION).zip: hobtemp/scm $(makedev) TEMP=hobtemp/ name=hobbit$(HOBBITVERSION) PROD=scm zip new: + echo `date` \ Aubrey Jaffer \ \<`whoami`@`hostname`\>> change + echo>> change + echo \ \* patchlvl.h \(SCMVERSION\): Bumped from $(VERSION) to $(ver).>>change + echo>> change + cat ChangeLog >> change + mv -f change ChangeLog $(CHPAT) scm$(VERSION) scm$(ver) ANNOUNCE ../jacal/ANNOUNCE \ ../wb/README ../wb/ANNOUNCE \ ../public_html/README.html ../dist/README \ ../public_html/SLIB.html ../public_html/JACAL.html \ ../public_html/SCM.html ../public_html/Hobbit.html \ /c/scm/dist/install.bat /c/scm/dist/makefile \ - /c/scm/dist/mkdisk.bat - $(CHPAT) $(VERSION) $(ver) README scm.texi patchlvl.h \ + /c/scm/dist/mkdisk.bat README + $(CHPAT) $(VERSION) $(ver) scm.texi patchlvl.h \ Init.scm ../public_html/SCM.html Makefile configtemp/scm: $(confiles) @@ -354,8 +391,8 @@ SED_TO_STRIP_NM=sed -e '/.*\.o$$/d' -e 's/.* _//' -e 's/.* T //' #SED_TO_STRIP_NM=sed -e '/^[A-Za-z][A-za-z0-9_]*[ |].*|extern|!d' -e 's/|/ /g' name8: name8s -name8s: scm - nm scm |\ +name8s: scmlit + nm scmlit |\ $(SED_TO_STRIP_NM) |\ sort -u|\ awk '{ if (substr(l,1,8)==substr($$1,1,8)) {\ @@ -373,12 +410,13 @@ tags: $(hfiles) $(cfiles) $(ifiles) $(vfiles) $(ufiles)\ hobbit.scm scm.texi README build.scm # $(mfiles) ChangeLog mostlyclean: clean: - -rm -f *~ *.bak *.orig *.rej core a.out ramap.o $(ofiles) scm.o \ - lints tmp* \#* *\# + -rm -f core a.out ramap.o ramap.obj $(ofiles) scm.o lints -$(RM_R) *temp distclean: clean - -rm -f $(EXECFILES) *.o a.out TAGS + -rm -f $(EXECFILES) *.o *.obj a.out TAGS implcat slibcat gdbscm realclean: distclean -rm -f scm.doc realempty: temp/scm -rm -f $(afiles) +myclean: clean + -rm -f *~ *.bak *.orig *.rej tmp* \#* *\# diff --git a/Makefile.in b/Makefile.in deleted file mode 100644 index c2f69c5..0000000 --- a/Makefile.in +++ /dev/null @@ -1,462 +0,0 @@ -# Copyright (C) 1990, 1991, 1992, 1993 Aubrey Jaffer. -*- Makefile -*- -# This file is part of SCM. -# -# SCM is free software; you can redistribute it and/or modify it under -# the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# SCM is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -# License for more details. -# -# You should have received a copy of the GNU General Public License -# along with SCM; see the file COPYING. If not, write to the Free -# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -# -# Makefile for SCM -# - -# Ultrix 2.2 make doesn't expand the value of VPATH. -srcdir = @srcdir@ - -CC = @CC@ - -CFLAGS = @CFLAGS@ -I. -I$(srcdir) -LDFLAGS = @LDFLAGS@ - -# Define these for your system as follows: -# -DRTL To create a run-time library only (no -# interactive front end). -# -DRECKLESS To turn most SCM error schecking off. -# -DCAUTIOUS To always check the number of arguments to -# interpreted closures. -# -DIO_EXTENSIONS To get primitives such as chdir, delete-file, -# file-opisition, and pipes. -# -DPROMPT=\"..\" To change the default prompt. -# -DFLOATS To turn on support for inexact numbers. -# -DSINGLES To use single-precision floats (if a float is -# the same size as a long). -# -DSINGLESONLY To make all inexact real numbers to be single -# precision. Only useful if SINGLES is also -# defined. -# -DGC_FREE_SEGMENTS -# To have all segments of unused heap be freed -# up after garbage collection. Do not define if -# you never want the heap to shrink. -# -DTICKS If you want the ticks and ticks-interrupt -# functions defined. -# -DBRACKETS_AS_PARENS -# To have square brackets read as parentheses -# in forms. -# -DMEMOIZE_LOCALS To speed up most local variable references. -# You will need to remove this and recompile -# eval.c if you use very large or deep -# environments (more than 4095 bound variables -# in one procedure). -# -DENGNOT To use engineering notation instead of -# scientific notation. -# -DSICP To make SCM more compatible with the Scheme used -# in Abelson & Sussman's book. -# -DSTACK_LIMIT To limit the maximum growth of the stack (you -# almost certainly don't want this). -# See also `scmconfig.h' and `scmfig.h'. -defines = @DEFS@ \ - -DCAUTIOUS -DARRAYS -DBIGNUMS -DCCLO \ - -DFLOATS -DIO_EXTENSIONS -DMEMOIZE_LOCALS -DGC_FREE_SEGMENTS - -# If you are using user extension files, change INITS and FINALS -# below. INITS makes up the initialization calls for user extension -# files. FINALS defines the finalization calls for user extension -# files. - -# File INITS FINALS functions defined -# -# sc2.c init_sc2\(\) substring-move-left!, -# substring-move-right!, -# substring-fill!, append!, last-pair -# rgx.c init_rgx\(\) regcomp, regexec (POSIX) -# crs.c init_curses\(\) lendwin\(\) ... lots ... - -INITS = -DINITS=init_sc2\(\)\; -FINALS = -DFINALS=\; - -# If you are using rgx.c, set the next line to point to the include -# directory where your POSIX regexp include files live (if you are using -# GNU regex). -# RGXFLAGS = -I/archive/regex-0.11/ - -# If your system needs extra libraries loaded in, define them here. -# -lm For floating point math (needed). -# -lcurses For crs.c extensions. -# -lncurses For curses on Linux (curses has bugs). -# -lterm{cap,lib} May be required for curses support. -# -lregex For POSIX regexp support (rgx.c). -LOADLIBES = @LIBS@ -lm - -# Any extra object files your system needs. -extras = @LIBOBJS@ - -# Common prefix for machine-independent installed files. -prefix = /usr/local -# Common prefix for machine-dependent installed files. -exec_prefix = $(prefix) - -# Name under which to install SCM. -instname = scm -# Directory to install `scm' in. -bindir = $(exec_prefix)/bin -# Directory in which to install Init.scm, COPYING, and Transcen.scm. -libdir = $(exec_prefix)/lib/scm -# Directory to search by default for included makefiles. -includedir = $(prefix)/include -# Directory to install the Info files in. -infodir = $(prefix)/info -# Directory to install the man page in. -mandir = $(prefix)/man/man$(manext) -# Number to put on the man page filename. -manext = 1 -# Directory to perform pre-install tests in. -testdir = $(srcdir) - -# Program to install `scm'. -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -# Program to install the man page. -INSTALL_DATA = @INSTALL_DATA@ -# Generic install program. -INSTALL = @INSTALL@ - -# Program to format Texinfo source into Info files. -MAKEINFO = makeinfo -# Program to format Texinfo source into DVI files. -TEXI2DVI = texi2dvi - -# Programs to make tags files. -ETAGS = etags -CTAGS = ctags -tw - -# You should not need to change below this line. - -SHELL = /bin/sh -DFLAG = -DIMPLINIT=\"$(libdir)/Init.scm\" -TDFLAG = -DIMPLINIT=\"$(testdir)/Init.scm\" -# nunix = nonunix -nunix = $(srcdir) -# examples = examples -examples = $(srcdir) -ffiles = continue.o time.o repl.o fscl.o sys.o feval.o subr.o sc2.o \ -funif.o rope.o ramap.o findexec.o #rgx.o -fifiles = continue.o time.o repl.o iscm.o fscl.o sys.o feval.o subr.o \ -sc2.o funif.o rope.o ramap.o findexec.o #rgx.o -efiles = time.o repl.o escl.o sys.o eeval.o subr.o sc2.o eunif.o #rgx.o -cfiles = $(srcdir)/scm.c $(srcdir)/time.c $(srcdir)/repl.c \ - $(srcdir)/scl.c $(srcdir)/sys.c $(srcdir)/eval.c \ - $(srcdir)/subr.c $(srcdir)/sc2.c $(srcdir)/unif.c \ - $(srcdir)/rgx.c $(srcdir)/crs.c $(srcdir)/dynl.c $(srcdir)/findexec.c -hfiles = $(srcdir)/scm.h $(srcdir)/scmfig.h scmconfig.h \ - $(srcdir)/setjump.h $(srcdir)/patchlvl.h -ifiles = Init.scm Transcen.scm -tfiles = $(examples)/test.scm $(examples)/example.scm \ - $(examples)/pi.scm $(examples)/pi.c $(examples)/split.scm -dfiles = $(srcdir)/README $(srcdir)/COPYING $(srcdir)/scm.1 \ - $(srcdir)/QUICKREF $(srcdir)/MANUAL $(srcdir)/ChangeLog \ - $(srcdir)/code.doc $(srcdir)/ANNOUNCE -mfiles = Makefile $(nunix)/makefile.msc $(nunix)/makefile.bor \ - $(nunix)/makefile.tur $(nunix)/makefile.djg \ - $(nunix)/makefile.emx $(nunix)/makefile.qc \ - $(nunix)/compile.amiga $(nunix)/link.amiga \ - $(nunix)/makefile.aztec $(nunix)/makefile.ast \ - $(nunix)/makefile.prj $(nunix)/dmakefile \ - $(nunix)/makefile.wcc -vfiles = $(nunix)/setjump.mar $(nunix)/VMSBUILD.COM $(nunix)/VMSGCC.COM -afiles = $(dfiles) $(cfiles) $(hfiles) $(ifiles) $(tfiles) $(mfiles) $(vfiles) - -.SUFFIXES: -.SUFFIXES: .o .c .h .ps .dvi .info .texinfo .scm - -.PHONY: all -all: scm - -# -DINITS= the initialization calls for user extension files. -# -DFINALS= the finalialization calls for user extension files. -dbscm: escm.a sc2.o $(srcdir)/../wb/db.a $(srcdir)/scm.c $(srcdir)/scm.h \ - $(srcdir)/scmfig.h $(srcdir)/patchlvl.h Makefile - $(CC) -o dbscm $(CFLAGS) $(INITS)init_db\(\)\;init_rgx\(\) \ - $(FINALS)final_db\(\) $(defines) $(srcdir)/scm.c \ - escm.a $(srcdir)/../wb/db.a $(LOADLIBES) $(extras) - rm escm.a -curscm: escm.a crs.o - $(CC) -o curscm $(CFLAGS) $(INITS)init_curses\(\)\;init_rgx\(\) \ - $(FINALS)lendwin\(\) $(srcdir)/scm.c crs.o escm.a -lcurses \ - $(LOADLIBES) $(extras) - rm escm.a -dscm: dscm.a main.o - $(CC) -o dscm $(CFLAGS) main.o -ldld -dscm.a: $(efiles) Makefile dynl.o $(srcdir)/scm.c - $(CC) $(CFLAGS) -DRTL $(INITS)init_dynl\(\) -c $(srcdir)/scm.c - ar crvs dscm.a scm.o dynl.o $(efiles) $(LOADLIBES) -dynl.o: $(srcdir)/dynl.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - Makefile - $(CC) $(CFLAGS) -DDLD -DRTL -c $(srcdir)/dynl.c - -instscm: $(fifiles) - $(CC) -o instscm $(fifiles) $(LOADLIBES) $(extras) - -scm: $(ffiles) fscm.o - $(CC) -o scm $(ffiles) fscm.o $(LOADLIBES) $(extras) -fscm.o: $(srcdir)/scm.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h $(srcdir)/patchlvl.h - $(CC) $(CFLAGS) $(TDFLAG) $(defines) -c $(FFLAGS) $(INITS) \ - $(FINALS) $(srcdir)/scm.c - mv scm.o fscm.o - -iscm.o: $(srcdir)/scm.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h $(srcdir)/patchlvl.h - $(CC) $(CFLAGS) $(DFLAG) $(defines) -c $(FFLAGS) $(INITS) \ - $(FINALS) $(srcdir)/scm.c - mv scm.o iscm.o - -fscl.o: $(srcdir)/scl.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(FFLAGS) $(srcdir)/scl.c - mv scl.o fscl.o -feval.o: $(srcdir)/eval.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(FFLAGS) $(srcdir)/eval.c - mv eval.o feval.o -funif.o: $(srcdir)/unif.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(FFLAGS) $(srcdir)/unif.c - mv unif.o funif.o - -escm: $(efiles) escm.o - $(CC) -o escm $(efiles) escm.o $(LOADLIBES) $(extras) -escm.o: $(srcdir)/scm.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h $(srcdir)/patchlvl.h - $(CC) $(CFLAGS) $(defines) -c $(INITS) $(FINALS) $(srcdir)/scm.c - mv scm.o escm.o -escl.o: $(srcdir)/scl.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/scl.c - mv scl.o escl.o -eeval.o: $(srcdir)/eval.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/eval.c - mv eval.o eeval.o -eunif.o: $(srcdir)/unif.c $(srcdir)/scm.h scmconfig.h - $(CC) $(CFLAGS) $(defines) -c unif.c - mv unif.o eunif.o - -repl.o: $(srcdir)/repl.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - $(srcdir)/setjump.h scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(TDFLAG) $(srcdir)/repl.c -sys.o: $(srcdir)/sys.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - $(srcdir)/setjump.h scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/sys.c -continue.o: $(srcdir)/continue.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - $(srcdir)/setjump.h scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/continue.c -rope.o: $(srcdir)/rope.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - $(srcdir)/setjump.h scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/rope.c -ramap.o: $(srcdir)/ramap.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - $(srcdir)/setjump.h scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/ramap.c -time.o: $(srcdir)/time.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/time.c -subr.o: $(srcdir)/subr.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/subr.c -sc2.o: $(srcdir)/sc2.c $(srcdir)/scm.h scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/sc2.c -rgx.o: $(srcdir)/rgx.c $(srcdir)/scm.h Makefile scmconfig.h - $(CC) $(CFLAGS) $(defines) $(RGXFLAGS) -c rgx.c -crs.o: $(srcdir)/crs.c $(srcdir)/scm.h scmconfig.h - $(CC) $(CFLAGS) $(defines) -c crs.c -findexec.o: $(srcdir)/findexec.c - $(CC) $(CFLAGS) $(defines) -c $(srcdir)/findexec.c - -both: scm escm - -$(srcdir)/proto.h: $(cfiles) - rm -f $(srcdir)/proto.h - mkproto $(cfiles) > $(srcdir)/proto.h - -libscm.a: rtlscm.o $(ffiles) - rm -f libscm.a - ar rc libscm.a rtlscm.o $(ffiles) - $(RANLIB) libscm.a - -rtlscm.o: $(srcdir)/scm.c $(srcdir)/scm.h $(srcdir)/scmfig.h \ - $(srcdir)/patchlvl.h scmconfig.h - $(CC) $(CFLAGS) $(defines) -c $(FFLAGS) -DRTL $(INITS)init_user_scm\(\) \ - $(FINALS) $(srcdir)/scm.c - mv scm.o rtlscm.o - -.PHONY: install installdirs -install: installdirs \ - $(bindir)/$(instname) $(mandir)/$(instname).$(manext) \ - $(libdir)/Init.scm $(libdir)/Transcen.scm $(libdir)/COPYING - -installdirs: - $(SHELL) ${srcdir}/mkinstalldirs $(bindir) $(infodir) \ - $(mandir) $(libdir) - -$(bindir)/$(instname): instscm - $(INSTALL_PROGRAM) instscm $@.new -# Some systems can't deal with renaming onto a running binary. - -rm -f $@.old - -mv $@ $@.old - mv $@.new $@ - -$(mandir)/$(instname).$(manext): $(srcdir)/scm.1 - $(INSTALL_DATA) $(srcdir)/scm.1 $@ - -$(libdir)/Init.scm: $(srcdir)/Init.scm - $(INSTALL_DATA) $(srcdir)/Init.scm $@ - -$(libdir)/Transcen.scm: $(srcdir)/Transcen.scm - $(INSTALL_DATA) $(srcdir)/Transcen.scm $@ - -$(libdir)/COPYING: $(srcdir)/COPYING - $(INSTALL_DATA) $(srcdir)/COPYING $@ - -.PHONY: tar shar dclshar com zip pubzip -tar: scm.tar -shar: scm.shar -dclshar: scm.com -com: scm.com -zip: scm.zip -scm.tar: temp/scm - cd temp; tar chf ../scm.tar scm - chmod 664 scm.tar -scm.shar: temp/scm - cd temp; shar scm >../scm.shar - chmod 664 scm.shar -scm.com: temp/scm - cd temp; dclshar scm >../scm.com - chmod 664 scm.com -scm.zip: temp/scm - cd temp; zip -r ../scm.zip scm - chmod 664 scm.zip -pubzip: temp/scm - cd temp; zip -ru ../../pub/scm.zip scm - chmod 664 ../pub/scm.zip - -temp/scm: $(afiles) - -rm -rf temp - mkdir temp - mkdir temp/scm - ln $(afiles) temp/scm - -.PHONY: dist tar.Z tar.gz shar.Z -dist: tar.gz -tar.Z: scm.tar.Z -tar.gz: scm.tar.gz -shar.Z: scm.shar.Z -scm.tar.Z: scm.tar - -rm -f scm.tar.Z - compress scm.tar - chmod 664 scm.tar.Z -scm.tar.gz: scm.tar - -rm -f scm.tar.gz - gzip scm.tar - chmod 664 scm.tar.gz -scm.shar.Z: scm.shar - -rm -f scm.shar.Z - compress scm.shar - chmod 664 scm.shar.Z - -.PHONY: pubdiffs distdiffs -pubdiffs: temp/scm - mv temp/scm temp/nscm - cd temp;unzip ../../pub/scm.zip - -rm -f scm.diffs - -diff -c temp/scm temp/nscm > scm.diffs - -rm -rf temp - ls -l scm.diffs -distdiffs: temp/scm - mv temp/scm temp/nscm - cd temp;zcat ../../dist/scm*.tar.gz | tar xvf - - -rm -f scm.pat - -diff -c temp/scm temp/nscm > scm.pat - -rm -rf temp - ls -l scm.pat - -.PHONY: checks check echeck -checks: check echeck -check: ./scm test.scm - echo '(test-sc4)(test-cont)(test-inexact)(gc)(exit (length errs))' \ - | ./scm test.scm -echeck: ./escm test.scm - echo '(test-sc4)(test-cont)(gc)(exit (length errs))' \ - | ./escm test.scm - -.PHONY: lint -lint: lints -lints: $(cfiles) $(hfiles) - lint $(CFLAGS) $(cfiles) | tee lints -# lint $(CFLAGS) $(cfiles) | tee lintes - -# Seds to help find names not unique in first 8 characters (name8s). -# for BSD nm format -# SED_TO_STRIP_NM = sed -e '/.*\.o$$/d' -e 's/.* _//' -e 's/.* T //' -#old, bad for T [^_] on suns: SED_TO_STRIP_NM=sed -e '/.*\.o$$/d' -e 's/.* _//' -# For a System V nm where plain C identifiers have _ prepended: -#SED_TO_STRIP_NM = sed -e '/^_[A-Za-z][A-za-z0-9_]*[ |].*|extern|!d' -e 's/|/ /g' -e 's/^_//' -# For a System V nm where plain C identifiers have nothing prepended: -#SED_TO_STRIP_NM = sed -e '/^[A-Za-z][A-za-z0-9_]*[ |].*|extern|!d' -e 's/|/ /g' -SED_TO_STRIP_NM = : - -.PHONY: name8 -name8: name8s -name8s: scm - nm scm |\ - $(SED_TO_STRIP_NM) |\ - sort -u|\ - awk '{ if (substr(l,1,8)==substr($$1,1,8)) {\ - if (p) print l;\ - print $$1;p=0;stat=1\ - }else p=1;\ - l=$$1\ - }END{exit stat}' - |\ - tee name8s - -tagsrcs = $(hfiles) $(cfiles) $(ifiles) $(mfiles) $(vfiles) \ - MANUAL code.doc README -TAGS: $(tagsrcs) - $(ETAGS) $(tagsrcs) -tags: $(tagsrcs) - $(CTAGS) $(tagsrcs) - -.PHONY: clean cleanish realclean -clean: - -rm -f *~ \#* *.o *\# *.orig *.rej a.out core lints tmp* - -rm -rf temp hobtemp -cleanish: - -rm -f *~ \#* *\# *.orig *.rej a.out core lints tmp* - -rm -rf temp hobtemp -distclean: - -rm -f *~ \#* *.o *\# *.orig *.rej a.out core TAGS lints tmp* \ - scmconfig.h config.status - -rm -rf temp hobtemp - -Makefile: config.status $(srcdir)/Makefile.in - $(SHELL) config.status -scmconfig.h: stamp-config ; -stamp-config: config.status $(srcdir)/scmconfig.h.in - $(SHELL) config.status - touch stamp-config - -configure: configure.in - autoconf $(ACFLAGS) -scmconfig.h.in: configure.in - autoheader $(ACFLAGS) - -# This tells versions [3.59,3.63) of GNU make not to export all variables. -.NOEXPORT: - -# Automatically generated dependencies will be put at the end of the file. @@ -1,4 +1,4 @@ -This directory contains the distribution of scm4e6. Scm conforms to +This directory contains the distribution of scm5b3. Scm conforms to Revised^4 Report on the Algorithmic Language Scheme and the IEEE P1178 specification. Scm runs under VMS, MS-DOS, OS2, MacOS, Amiga, Atari-ST, NOS/VE, Unix and similar systems. @@ -38,9 +38,12 @@ The author can be reached at <jaffer@ai.mit.edu> `build.scm' creates a database and program for compiling and linking new SCM executables, libraries, and dlls. `build.bat' invokes build.scm on MS-DOS platforms. - `setjump.mar' provides setjmp and longjmp which do not use $unwind + `mkimpcat.scm' build SCM-specific catalog for SLIB. + `.gdbinit' provides commands for debugging SCM with GDB. + `setjump.mar' provides setjump and longjump which do not use $unwind utility on VMS. - `setjump.s' provides setjmp and longjmp for the Cray YMP. + `ugsetjump.s' provides setjump and longjump which work on Ultrix VAX. + `setjump.s' provides setjump and longjump for the Cray YMP. `Init.scm' is Scheme initialization code. `Transcen.scm' has Scheme code for inexact builtin procedures. @@ -91,12 +94,12 @@ SLIB is not *neccessary* to run SCM, I strongly suggest you obtain and install it. Bug reports about running SCM without SLIB have very low priority. SLIB is available from the same sites as SCM: - * ftp-swiss.ai.mit.edu:pub/scm/slib2a6.tar.gz - * prep.ai.mit.edu:pub/gnu/jacal/slib2a6.tar.gz - * ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz - * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2a6.tar.gz + * ftp-swiss.ai.mit.edu:pub/scm/slib2c0.tar.gz + * prep.ai.mit.edu:pub/gnu/jacal/slib2c0.tar.gz + * ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2c0.tar.gz + * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2c0.tar.gz -Unpack SLIB (`tar xzf slib2a6.tar.gz' or `unzip -ao slib2a6.zip') in an +Unpack SLIB (`tar xzf slib2c0.tar.gz' or `unzip -ao slib2c0.zip') in an appropriate directory for your system; both `tar' and `unzip' will create the directory `slib'. @@ -150,12 +153,16 @@ proceed: * Use scmconfig (From: bos@scrg.cs.tcd.ie): Build and install scripts using GNU "autoconf" are available from - `scmconfig4e6.tar.gz' in the distribution directories. See - `README.unix' in `scmconfig4e6.tar.gz' for further instructions. + `scmconfig4e3.tar.gz' in the distribution directories. See + `README.unix' in `scmconfig4e3.tar.gz' for further instructions. + + *Note:* The last release of scmconfig (4e3) was on March 20, 1996. + I am moving it to the OLD subdirectory until someone submits an + update. Making SCM with Think C 4.0 or 4.1 -Note: These instructions need to be uptdated for scm4e6. If Think C +Note: These instructions need to be uptdated for scm5b3. If Think C can be called using system(), then SCM can be built using build.scm. Edit Scmfig.H to set desired options and IMPLINIT. @@ -191,21 +198,13 @@ can be called using system(), then SCM can be built using build.scm. Gnu Emacs: Editing of Scheme code is supported by emacs. Buffers holding files ending in .scm are automatically put into scheme-mode. + EMACS for MS-DOS and MS-Windows systems is available (free) from: - If your Emacs can run a process in a buffer you can use the Emacs - command `M-x run-scheme' with SCM. However, the run-scheme - (`xscheme.el') which comes included with Gnu Emacs 18 will work - only with MIT Cscheme. If you are using Emacs 18, get the emacs - packages: - - * ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/cmuscheme.el + * http://simtel.coast.net/SimTel/gnu/demacs.html - * ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/comint.el - - These files are already standard in Emacs 19. - - If your Emacs can not run a process in a buffer, see "under other - systems" below. + If your Emacs can run a process in a buffer you can use the Emacs + command `M-x run-scheme' with SCM. Otherwise, use the emacs + command `M-x suspend-emacs'; or see "other systems" below. Epsilon (MS-DOS): There is lisp (and scheme) mode available by use of the package diff --git a/README.unix b/README.unix deleted file mode 100644 index 0f9094d..0000000 --- a/README.unix +++ /dev/null @@ -1,182 +0,0 @@ -This file contains the instructions for building scm4e under Unix -systems. Scm conforms to Revised^4 Report on the Algorithmic Language -Scheme and the IEEE P1178 specification. Scm runs under VMS, MS-DOS, -OS2, MacOS, Amiga, Atari-ST, NOS/VE, Unix and similar systems. - -The author of scm can be reached at <jaffer@ai.mit.edu> or -Aubrey Jaffer, 84 Pleasant St., Wakefield MA 01880. - -The Unix installation support included in this scmconfig distribution -has been written by myself, Bryan O'Sullivan <bosullvn@maths.tcd.ie>, -and is maintained by me. Please direct any problems you have with -either scm itself or this configuration software to <bug-scm@scrg.cs.tcd.ie>. - -NOTE: Before you get started, make sure that you have unpacked this - scmconfig distribution into the whatever directory you have - unpacked the same version of scm. - -Several chunks of this file have been lifted more or less verbatim -from the standard INSTALL file which comes with most GNU utilities -these days. - - MANIFEST - - `README.unix' is this file. It contains a MANIFEST, INSTALLATION - INSTRUCTIONS, TROUBLESHOOTING, and various other information. - `COPYING' details the LACK OF WARRANTY for scmconfig and scm and the - conditions for distributing scm and scmconfig. - `acconfig-1.5.h' is a temporary fix for a bug in version 1.5 of GNU - autoconf. This file should not concern you unless you are - familiar with autoconf (you don't need to be). - `configure' is an executable shell script which generates - `scmconfig.h' and `Makefile'. - `configure.in' is a template file used by with autoconf (autoconf is - not needed to build scm), which produces the `configure' - script. - `scmconfig.h.in' is an automatically-generated template file used by - configure, which produces `scmconfig.h'. - `Makefile.in' is a template file used by configure, which produces - `Makefile'. - - INSTALLATION INSTRUCTIONS - -To compile this package: - -1. In the directory that this file is in, type `./configure'. If - you're using `csh' on an old version of System V, you might need - to type `sh configure' instead to prevent `csh' from trying to - execute `configure' itself. - - You may wish to edit the generated `Makefile' file in order to - customise scm to your own preferences. The comments in there - should be adequate to let you decide what you want to do. - `Makefile' has a reasonable set of defaults for most Unix systems, - so you may not have to edit it at all. - -[You can skip the rest of this section (down to point 2 below) the - first time around.] - - The `configure' shell script attempts to guess correct values for - various system-dependent variables used during compilation, and - creates the Makefile. - - Running `configure' takes a minute or two. While it is running, - it prints some messages that tell what it is doing. If you don't - want to see the messages, run `configure' with its standard output - redirected to `/dev/null'; for example, `./configure >/dev/null'. - - To compile the package in a different directory from the one - containing the source code, you must use a version of `make' that - supports the VPATH variable, such as GNU `make'. `cd' to the - directory where you want the object files and executables to go - and run `configure'. `configure' automatically checks for the - source code in the directory that `configure' is in and in `..'. - If for some reason `configure' is not in the source code directory - that you are configuring, then it will report that it can't find - the source code. In that case, run `configure' with the option - `--srcdir=DIR', where DIR is the directory that contains the - source code. - - See the section titled `INSTALL' below on building scm with - different default search paths. By default, when you run `make', - scm looks in the source directory for `Init.scm'. The binary - which is built when you run `make install' looks in the correct - places for files. - - Another `configure' option is useful mainly in `Makefile' rules - for updating `config.status' and `Makefile'. The `--no-create' - option figures out the configuration for your system and records - it in `config.status', without actually configuring the package - (creating `Makefile's and perhaps a configuration header file). - Later, you can run `./config.status' to actually configure the - package. You can also give `config.status' the `--recheck' - option, which makes it re-run `configure' with the same arguments - you used before. This option is useful if you change `configure'. - - `configure' ignores any other arguments that you give it. - - If your system requires unusual options for compilation or linking - that `configure' doesn't know about, you can give `configure' - initial values for some variables by setting them in the - environment. In Bourne-compatible shells, you can do that on the - command line like this: - CC='gcc -traditional' DEFS=-D_POSIX_SOURCE ./configure - -2. Type `make' to compile the package. If you want, you can override - the `make' variables CFLAGS and LDFLAGS like this: - make CFLAGS=-O2 LDFLAGS=-s - -3. Test scm. This is done in the following way (user input comes - after the `bash$' and `>' prompts): - bash$ scm - SCM version xxx, Copyright (C) 1990, 1991, 1992, 1993 Aubrey Jaffer. - SCM comes with ABSOLUTELY NO WARRANTY; for details type `(terms)'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `(terms)' for details. - ;loading ".../Transcen.scm" - ;done loading ".../Transcen.scm" - ;Evaluation took 230 mSec (0 in gc) 8661 cons work - > (load "test.scm") - ... - > (test-sc4) - ... - > (test-cont) - ... - > (test-inexact) - -4. You can remove the program binaries and object files from the - source directory by typing `make clean'. To also remove the - Makefile(s), the header file containing system-dependent definitions - (if the package uses one), and `config.status' (all the files that - `configure' created), type `make distclean'. - -[You can skip this next bit unless you are editing the `configure.in' - file, which you should not do unless you are familiar with autoconf.] - - If you are using versions of autoconf before or including 1.5, you - should rename `acconfig-1.5.h' to `acconfig.h' before running - autoheader, since these distributions do not handle - `TIME_WITH_SYS_TIME' correctly. - - INSTALL - -Type `make install' to install programs, data files, and -documentation. - -By default, `make install' will install the package's files in -/usr/local/bin, /usr/local/lib, /usr/local/man, etc. You can specify -an installation prefix other than /usr/local by giving `configure' the -option `--prefix=PATH'. Alternately, you can do so by consistently -giving a value for the `prefix' variable when you run `make', e.g., - make prefix=/usr/gnu - make prefix=/usr/gnu install - -You can specify separate installation prefixes for -architecture-specific files and architecture-independent files. If -you give `configure' the option `--exec-prefix=PATH' or set the `make' -variable `exec_prefix' to PATH, the package will use PATH as the -prefix for installing programs and libraries. Data files and -documentation will still use the regular prefix. Normally, all files -are installed using the regular prefix. - - TROUBLESHOOTING - -If you encounter any problems while building scm, please send -electronic mail to <bug-scm@scrg.cs.tcd.ie> with a description of the -problem, and any solution to it you may have found. Some mention of -the version of Unix you are trying to build scm on, and the versions -of scm and scmconfig you are using, would be helpful in diagnosing the -problem. - -If you encounter any problems with system include files not being -found, or attempts being made to read the wrong files, please contact -<bug-scm@scrg.cs.tcd.ie> with a description of the include files that -are not being handled correctly; the problem probably lies in the -autoconf support, and can usually be quickly fixed by manually editing -`scmconfig.h'. - -If you find that scm does not link because it cannot find a -time-related function, please mail a description of the problem to -<bug-scm@scrg.cs.tcd.ie>, stating which function(s) can't be found. -In the mean time, editing the top of `time.c' should provide a fix for -the problem. diff --git a/Transcen.scm b/Transcen.scm index 896f77f..362420a 100644 --- a/Transcen.scm +++ b/Transcen.scm @@ -1,4 +1,4 @@ -;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1995, 1997 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/acconfig-1.5.h b/acconfig-1.5.h deleted file mode 100644 index 4f33b04..0000000 --- a/acconfig-1.5.h +++ /dev/null @@ -1,22 +0,0 @@ -/* acconfig.h - This file is in the public domain. - - Descriptive text for the C preprocessor macros that - the distributed Autoconf macros can define. - No software package will use all of them; autoheader copies the ones - your configure.in uses into your configuration header file templates. - - The entries are in sort -df order: alphabetical, case insensitive, - ignoring punctuation (such as underscores). - - Leave the following blank line there!! Autoheader needs it. */ - - -/* Define if <sys/time.h> and <time.h> do not clash with each other. */ -#undef TIME_WITH_SYS_TIME - - -/* Leave that blank line there!! Autoheader needs it. - If you're adding to this file, keep in mind: - The entries are in sort -df order: alphabetical, case insensitive, - ignoring punctuation (such as underscores). */ @@ -1,3 +1,45 @@ +;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this software; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;; As a special exception, the Free Software Foundation gives permission +;; for additional uses of the text contained in its release of GUILE. +;; +;; The exception is that, if you link the GUILE library with other files +;; to produce an executable, this does not by itself cause the +;; resulting executable to be covered by the GNU General Public License. +;; Your use of that executable is in no way restricted on account of +;; linking the GUILE library code into it. +;; +;; This exception does not however invalidate any other reasons why +;; the executable file might be covered by the GNU General Public License. +;; +;; This exception applies only to the code released by the +;; Free Software Foundation under the name GUILE. If you copy +;; code from other Free Software Foundation releases into a copy of +;; GUILE, as the General Public License permits, the exception does +;; not apply to the code that you add in this way. To avoid misleading +;; anyone as to the status of such modified files, you must delete +;; this exception notice from them. +;; +;; If you write modifications of your own for GUILE, it is your choice +;; whether to permit this exception to apply to your modifications. +;; If you do not wish that, delete this exception notice. + +;;;; "bench.scm", Scheme benchmark computing digits of pi. +;;; Author: Aubrey Jaffer. (require (in-vicinity (implementation-vicinity) "pi.scm")) (require 'transcript) @@ -1 +1 @@ -scm -f %0 -e(bi) build %1 %2 %3 %4 %5 %6 %7 %8 %9 +scmlit -f build.scm -e(bi) build %1 %2 %3 %4 %5 %6 %7 %8 %9 @@ -1,7 +1,7 @@ #!/bin/sh -type;exec scmlit -f $0 -e"(bi)" build $* -;;; "build.scm" Build database and program -*-scheme-*- -;;; Copyright (C) 1994, 1995, 1996 Aubrey Jaffer. +:;exec ./scmlit -f $0 -e"(bi)" build $* +;;; "build.scm" Build database and program +;;; Copyright (C) 1994, 1995, 1996, 1997 Aubrey Jaffer. ;;; See the file `COPYING' for terms applying to this program. (require 'getopt) @@ -13,6 +13,7 @@ type;exec scmlit -f $0 -e"(bi)" build $* (require 'batch) (batch:initialize! build) +(set! OPEN_WRITE "w") ; Because MS-DOS scripts need ^M (define-tables build @@ -24,6 +25,8 @@ type;exec scmlit -f $0 -e"(bi)" build $* (c-header) (scheme) (vax-asm) + (gnu-as) + (gdb-init) (cray-asm) (makefile) (MS-DOS-batch) @@ -33,12 +36,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* '(file-categories ((category symbol)) ((documentation string)) - ((documentation "Documentation file (or source for)") - (required "File required for building executable SCM") - (optional "File required for some feature") - (linkable "File whose object can be dynamically linked") - (test "File to test SCM") - (none "No files"))) + ((documentation "documentation") + (platform-specific "required for certain platforms") + (required "required for building executable SCM") + (optional "required for some feature") + (linkable "required and can be dynamically linked") + (test "test SCM") + (none "no files"))) '(build-whats ((name symbol)) @@ -51,16 +55,16 @@ type;exec scmlit -f $0 -e"(bi)" build $* "executable program") (lib required compile-c-files make-archive ((define "RTL")) "library module") - (dlls linkable compile-dll-c-files make-dll-archive ((define "RTL")) + (dlls linkable compile-dll-c-files make-dll-archive ((define "DLL")) "archived dynamically linked library object files") - (dll none compile-dll-c-files make-nothing #f + (dll none compile-dll-c-files update-catalog ((define "DLL")) "dynamically linked library object file"))) '(manifest - ((file string)) - ((format file-formats) - (category file-categories) - (documentation string)) + ((file string) + (format file-formats) + (category file-categories)) + ((documentation string)) (("README" plaintext documentation "contains a MANIFEST, INSTALLATION INSTRUCTIONS, hints for EDITING SCHEME CODE, and a TROUBLE SHOOTING GUIDE.") ("COPYING" plaintext documentation "details the LACK OF WARRANTY for SCM and the conditions for distributing SCM.") ("scm.1" nroff documentation "unix style man page.") @@ -75,12 +79,16 @@ type;exec scmlit -f $0 -e"(bi)" build $* ("bench.scm" Scheme test "computes and records performance statistics of pi.scm.") ("Makefile" Makefile required "builds SCMLIT using the `make' program.") ("build.scm" Scheme required "database for compiling and linking new SCM programs.") - ("build.bat" MS-DOS-batch optional "invokes build.scm for MS-DOS") - ("setjump.mar" Vax-asm optional "provides setjmp and longjmp which do not use $unwind utility on VMS.") - ("setjump.s" Cray-asm optional "provides setjmp and longjmp for the Cray YMP.") + ("build.bat" MS-DOS-batch platform-specific "invokes build.scm for MS-DOS") + ("mkimpcat.scm" Scheme required "build SCM-specific catalog for SLIB.") + (".gdbinit" gdb-init optional "provides commands for debugging SCM with GDB") + ("setjump.mar" Vax-asm platform-specific "provides setjump and longjump which do not use $unwind utility on VMS.") + ("ugsetjump.s" gnu-as platform-specific "provides setjump and longjump which work on Ultrix VAX.") + ("setjump.s" Cray-asm platform-specific "provides setjump and longjump for the Cray YMP.") ("Init.scm" Scheme required "Scheme initialization.") ("Transcen.scm" Scheme required "inexact builtin procedures.") ("Link.scm" Scheme required "compiles and dynamically links.") + ("Macro.scm" Scheme required "Supports R4RS Macros.") ("scmfig.h" c-header required "contains system dependent definitions.") ("patchlvl.h" c-header required "patchlevel of this release.") ("setjump.h" c-header required "continuations, stacks, and memory allocation.") @@ -89,6 +97,7 @@ type;exec scmlit -f $0 -e"(bi)" build $* ("scm.h" c-header required "data type and external definitions of SCM.") ("scm.c" c-source required "top level, interrupts, and non-IEEE utility functions.") ("findexec.c" c-source required "find the executable file function.") + ("script.c" c-source required "utilities for running as `#!' script.") ("time.c" c-source required "functions dealing with time.") ("repl.c" c-source required "error, read-eval-print loop, read, write and load.") ("scl.c" c-source required "inexact arithmetic") @@ -111,11 +120,14 @@ type;exec scmlit -f $0 -e"(bi)" build $* ("posix.c" c-source linkable "posix library interface.") ("unix.c" c-source linkable "non-posix system calls on unix systems.") ("socket.c" c-source linkable "BSD socket interface.") - ("pre-crt0.c" c-source optional "loaded before crt0.o on machines which do not remap part of the data space into text space in unexec.") - ("ecrt0.c" c-source optional "standard Vax 4.2 Unix crt0.c cannot be used because it makes `envron' an initialized variable.") - ("gmalloc.c" c-source optional "Gnu malloc().") - ("unexec.c" c-source optional "Convert a running program into an a.out file.") - ("unexelf.c" c-source optional "Convert a running ELF program into an a.out file.") + ("pre-crt0.c" c-source platform-specific "loaded before crt0.o on machines which do not remap part of the data space into text space in unexec.") + ("ecrt0.c" c-source platform-specific "discover the start of initialized data space dynamically at runtime.") + ("gmalloc.c" c-source platform-specific "Gnu malloc(); used for unexec.") + ("unexec.c" c-source platform-specific "Convert a running program into an executable file.") + ("unexhp9k800.c" c-source platform-specific "Convert a running HP-UX program into an executable file.") + ("unexelf.c" c-source platform-specific "Convert a running ELF program into an executable file.") + ("unexalpha.c" c-source platform-specific "Convert a running program into an Alpha executable file.") + ("unexsunos4.c" c-source platform-specific "Convert a running program into an executable file.") ))) (for-each (build 'add-domain) @@ -131,6 +143,7 @@ type;exec scmlit -f $0 -e"(bi)" build $* ((*unknown* #f) (8086 #f) (acorn #f) + (alpha #f) (cray #f) (hp-risc #f) (i386 8086) @@ -157,25 +170,31 @@ type;exec scmlit -f $0 -e"(bi)" build $* ((*unknown* *unknown* unix *unknown*) (acorn-unixlib acorn *unknown* *unknown*) (aix powerpc aix *unknown*) + (alpha alpha osf1 cc) + (alpha-elf alpha unix *unknown*) + (alpha-linux alpha linux gcc) (amiga-aztec m68000 amiga aztec) (amiga-dice-c m68000 amiga dice-c) + (amiga-gcc m68000 amiga gcc) (amiga-sas/c-5.10 m68000 amiga sas/c) (atari-st-gcc m68000 atari.st gcc) (atari-st-turbo-c m68000 atari.st turbo-c) (borland-c-3.1 8086 ms-dos borland-c) (djgpp i386 ms-dos gcc) + (freebsd i386 unix cc) (gcc *unknown* unix gcc) (highc.31 i386 ms-dos highc) (hp-ux hp-risc hp-ux *unknown*) - (linux-aout i386 linux gcc) (linux i386 linux gcc) + (linux-aout i386 linux gcc) (microsoft-c 8086 ms-dos microsoft-c) (microsoft-c-nt i386 ms-dos microsoft-c) (microsoft-quick-c 8086 ms-dos microsoft-quick-c) (ms-dos 8086 ms-dos *unknown*) (os/2-cset i386 os/2 C-Set++) (os/2-emx i386 os/2 gcc) - (sun sparc sun-os *unknown*) + (sun-svr4-gcc-sunld sparc sunos gcc) + (sunos sparc sunos *unknown*) (svr4 *unknown* unix *unknown*) (turbo-c-2 8086 ms-dos turbo-c) (unicos cray unicos *unknown*) @@ -191,17 +210,18 @@ type;exec scmlit -f $0 -e"(bi)" build $* ((compiler-flags string) (link-lib-flag string) (lib-path optstring) - (supress-files expression)) + (lib-support expression)) ((m *unknown* "" "-lm" "/usr/lib/libm.a" ()) (c *unknown* "" "-lc" "/usr/lib/libc.a" ()) - (regex *unknown* "" "-lrgx" "/usr/lib/librgx.a" ()) + (regex *unknown* "" "-lregex" "/usr/lib/libregex.a" ()) (curses *unknown* "" "-lcurses" "/usr/lib/libcurses.a" ()) (graphics *unknown* "-I/usr/X11/include -DX11" "-lX11" "/usr/X11/lib/libX11.sa" ()) - (editline *unknown* "" "-ledit" "/usr/lib/libedit.a" ()) + (editline *unknown* "" "-lreadline" "/usr/lib/libreadline.a" ()) (termcap *unknown* "" "-ltermcap" "/usr/lib/libtermcap.a" ()) (debug *unknown* "-g" "-g" #f ()) + (socket *unknown* "" "" #f ()) (m linux-aout "" "-lm" "/usr/lib/libm.sa" ()) (c linux-aout "" "-lc" "/usr/lib/libc.sa" ()) @@ -209,8 +229,8 @@ type;exec scmlit -f $0 -e"(bi)" build $* (regex linux-aout "" "" "" ()) (curses linux-aout "-I/usr/include/ncurses" "-lncurses" "/usr/lib/libncurses.a" ()) - (nostart linux-aout "" "-nostartfiles" #f ("ecrt0.c")) - (dump linux-aout "" "/usr/lib/crt0.o" #f ("unexelf.c")) + (nostart linux-aout "" "-nostartfiles" #f ("pre-crt0.c")) + (dump linux-aout "" "/usr/lib/crt0.o" #f ("unexec.c" "gmalloc.c")) (m linux "" "-lm" "/lib/libm.so" ()) (c linux "" "-lc" "/lib/libc.so" ()) @@ -218,11 +238,14 @@ type;exec scmlit -f $0 -e"(bi)" build $* (graphics linux "-I/usr/include/X11 -DX11" "-L/usr/X11R6/lib -lX11" "/usr/X11R6/lib/libX11.so" ()) (curses linux "" "-lcurses" "/lib/libncurses.so" ()) - (nostart linux "" "" #f ("pre-crt0.c" "ecrt0.c")) - (dump linux "" "" #f ("unexec.c")) + (nostart linux "" "" #f ()) + (dump linux "" "" #f ("unexelf.c" "gmalloc.c")) (m acorn-unixlib "" "" #f ()) + (nostart alpha "" "-non_shared" #f ("pre-crt0.c")) + (dump alpha "" "" #f ("unexalpha.c")) + (m amiga-dice-c "" "-lm" #f ()) (m amiga-SAS/C-5.10 "" "lcmieee.lib" #f ()) (c amiga-SAS/C-5.10 "" "lc.lib" #f ()) @@ -233,21 +256,37 @@ type;exec scmlit -f $0 -e"(bi)" build $* (m atari-st-gcc "" "-lpml" #f ()) (m atari-st-turbo-c "" "" #f ()) - (m sun "" "-lm" #f ()) - (dlll sun "-DSUN_DL" "-ldl" #f ()) - (nostart sun "" "-e __start -nostartfiles -static" #f ("pre-crt0.c")) - (dump sun "" "" #f ("unexec.c")) + (m sunos "" "-lm" #f ()) + (dlll sunos "-DSUN_DL" "-ldl" #f ()) + (nostart sunos "" "-e __start -nostartfiles -static" #f ("ecrt0.c")) + (dump sunos "" "" #f ("unexelf.c" "gmalloc.c")) + + (m sun-svr4-gcc-sunld "" "-lm" #f ()) + (dlll sun-svr4-gcc-sunld "-DSUN_DL" "-Wl,-ldl" #f ()) + (nostart sun-svr4-gcc-sunld "" "-e __start -nostartfiles" #f ("ecrt0.c")) + (dump sun-svr4-gcc-sunld "" "" #f ("unexelf.c" "gmalloc.c")) + (socket sun-svr4-gcc-sunld "" "-lsocket -lnsl" #f ()) + (regex sun-svr4-gcc-sunld "" "" #f ()) + + (nostart gcc "" "-e __start -nostartfiles" #f ("ecrt0.c")) + (dump gcc "" "" #f ("unexelf.c" "gmalloc.c")) (m hp-ux "" "-lm" #f ()) (dlll hp-ux "-DHAVE_DYNL" "-Wl,-E -ldld" #f ()) (graphics hp-ux "-DX11" "-lX" "/usr/lib/X11R5/libX11.sl" ()) + (nostart hp-ux "" "" #f ("ecrt0.c")) + (dump hp-ux "" "" #f ("unexhp9k800.c" "gmalloc.c")) (c djgpp "" "-lc" #f ("findexec.c")) (curses djgpp "-I/djgpp/contrib/pdcurses/include/" "-L/djgpp/contrib/pdcurses/lib/ -lcurses" "\\djgpp\\contrib\\pdcurses\\lib\\libcurse.a" ()) - (nostart djgpp "" "-nostartfiles" #f ("ecrt0.c")) - (dump djgpp "" "c:/djgpp/lib/crt0.o" #f ("unexelf.c")) + (nostart djgpp "" "-nostartfiles" #f ("pre-crt0.c")) + (dump djgpp "" "c:/djgpp/lib/crt0.o" #f ("unexec.c" "gmalloc.c")) +;;; (nostart djgpp "" "" #f ("ecrt0.c")) +;;; (dump djgpp "" "" #f ("unexelf.c" "gmalloc.c")) +;;; (nostart djgpp "" "-e __start -nostartfiles -static" #f ("ecrt0.c")) +;;; (dump djgpp "" "" #f ("unexelf.c" "gmalloc.c")) (c Microsoft-C "" "" #f ("findexec.c")) (m Microsoft-C "" "" #f ()) @@ -268,6 +307,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (c highc.31 "" "" #f ("findexec.c")) (m highc.31 "" "" #f ()) (windows highc.31 "-Hwin" "-Hwin" #f ()) + + (m freebsd "" "-lm" #f ()) + (regex freebsd "" "-lgnuregex" "" ()) + (editline freebsd "" "-lreadline" "" ()) + (dlll freebsd "-DSUN_DL" "" "" ()) + (nostart freebsd "" "-e start -dc -dp -Bstatic -lgnumalloc" #f ("pre-crt0.c")) + (dump freebsd "" "/usr/lib/crt0.o" "" ("unexsunos4.c")) )) '(compile-commands @@ -284,10 +330,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (if (member '(define "FLOATS" #t) (c-defines parms)) "" "-f-") + (include-spec "-I" parms) (c-includes parms) (c-flags parms) (string-append "@" rsp-name)) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + #\\))) (link-c-program Borland-C-3.1 (lambda (oname objects libs parms) (define lnk-name (string-append oname ".lnk")) @@ -305,13 +354,18 @@ type;exec scmlit -f $0 -e"(bi)" build $* (batch:system parms "tcc" "-c" "-d" "-O" "-Z" "-G" "-ml" "-c" "-Ic:\\turboc\\include" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + #\\))) (link-c-program Turbo-C-2 (lambda (oname objects libs parms) - (let ((exe (replace-suffix (car objects) ".obj" ".exe")) + (let ((exe (truncate-up-to + (replace-suffix (car objects) ".obj" ".exe") + #\\)) (oexe (string-append oname ".exe"))) (if (not (string-ci=? exe oexe)) (batch:delete-file parms oexe)) @@ -325,13 +379,18 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "cl" "-c" "Oxp" "-AH" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + #\\))) (link-c-program Microsoft-C (lambda (oname objects libs parms) - (let ((exe (replace-suffix (car objects) ".obj" ".exe")) + (let ((exe (truncate-up-to + (replace-suffix (car objects) ".obj" ".exe") + #\\)) (oexe (string-append oname ".exe"))) (if (not (string-ci=? exe oexe)) (batch:delete-file parms oexe)) @@ -348,26 +407,31 @@ type;exec scmlit -f $0 -e"(bi)" build $* (compile-c-files Microsoft-C-nt (lambda (files parms) (batch:system parms - "cl" "-c" + "cl" "-c" "-nologo" "-O2" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + #\\))) (link-c-program Microsoft-C-nt (lambda (oname objects libs parms) - (let ((exe (replace-suffix (car objects) ".obj" ".exe")) + (let ((exe (truncate-up-to + (replace-suffix (car objects) ".obj" ".exe") + #\\)) (oexe (string-append oname ".exe"))) - (if (not (string-ci=? exe oexe)) - (batch:delete-file parms oexe)) +; (if (not (string-ci=? exe oexe)) +; (batch:delete-file parms oexe)) (batch:system parms - "link" + "link" "/nologo" (string-append "/out:" oexe) (apply string-join " " (map (lambda (o) (replace-suffix o ".obj" "")) objects)) libs) - (if (not (string-ci=? exe oexe)) - (batch:rename-file parms exe oexe)) +; (if (not (string-ci=? exe oexe)) +; (batch:rename-file parms exe oexe)) oexe))) (compile-c-files Microsoft-Quick-C @@ -377,7 +441,9 @@ type;exec scmlit -f $0 -e"(bi)" build $* (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + #\\))) (link-c-program Microsoft-Quick-C (lambda (oname objects libs parms) (define crf-name (string-append oname ".crf")) @@ -403,11 +469,15 @@ type;exec scmlit -f $0 -e"(bi)" build $* (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + #\\))) (link-c-program Watcom-9.0 (lambda (oname objects libs parms) - (let ((exe (replace-suffix (car objects) - ".obj" ".exe")) + (let ((exe (truncate-up-to + (replace-suffix (car objects) + ".obj" ".exe") + #\\)) (oexe (string-append oname ".exe"))) (if (not (string-ci=? exe oexe)) (batch:delete-file parms oexe)) @@ -427,11 +497,14 @@ type;exec scmlit -f $0 -e"(bi)" build $* (define hcc-name "temp.hcc") (apply batch:lines->file parms hcc-name files) (batch:system parms - "\\hi_c\\hc386.31\\bin\\hc386" + "d:\\hi_c\\hc386.31\\bin\\hc386" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) "-c" (string-append "@" hcc-name)) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + #\\))) (link-c-program highc.31 (lambda (oname objects libs parms) (let ((oexe (string-append oname ".exe"))) @@ -439,10 +512,10 @@ type;exec scmlit -f $0 -e"(bi)" build $* (apply batch:lines->file parms lnk-name (append libs objects)) (batch:system parms - "\\hi_c\\hc386.31\\bin\\hc386" "-o" oname + "d:\\hi_c\\hc386.31\\bin\\hc386" "-o" oname (string-append "@" lnk-name)) (batch:system parms - "bind386" "/hi_c/pharlap.51/run386b.exe" oname + "bind386" "d:/hi_c/pharlap.51/run386b.exe" oname "-exe" oexe) oexe))) @@ -451,9 +524,12 @@ type;exec scmlit -f $0 -e"(bi)" build $* (batch:apply-chop-to-fit batch:try-system parms "gcc" "-Wall" "-O2" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + "\\/"))) (link-c-program djgpp (lambda (oname objects libs parms) (let ((exe (string-append oname ".exe"))) @@ -470,30 +546,32 @@ type;exec scmlit -f $0 -e"(bi)" build $* (batch:apply-chop-to-fit batch:try-system parms "ar" "r" arname objects) - (batch:system - parms "gcc" "-o" oname - (must-be-first - '("-nostartfiles" - "pre-crt0.o" "ecrt0.o" - "c:/djgpp/lib/crt0.o") - (cons arname libs)))) + (and + (batch:system + parms "gcc" "-o" oname + (must-be-first + '("-nostartfiles" + "pre-crt0.o" "ecrt0.o" "c:/djgpp/lib/crt0.o") + (cons arname libs))) + (batch:delete-file parms arname))) (slib:error 'build "couldn't build archive")) - (batch:system parms "strip" oname) - (batch:delete-file parms exe) - (batch:system parms - "coff2exe" "-s" - "c:\\djgpp\\bin\\go32.exe" - oname) + (batch:system parms "strip" exe) + (batch:delete-file parms oname) + ;;(batch:delete-file parms exe) + ;;(batch:system parms "coff2exe" "-s" "c:\\djgpp\\bin\\go32.exe" oname) exe))) (compile-c-files os/2-emx (lambda (files parms) (batch:system parms "gcc" "-O" "-m386" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\\))) (link-c-program os/2-emx (lambda (oname objects libs parms) (batch:system parms @@ -505,10 +583,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "icc.exe" "/Gd-" "/Ge+" "/Gm+" "/Q" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + #\\))) (link-c-program os/2-cset (lambda (oname objects libs parms) (batch:system parms @@ -520,10 +601,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "cc" "+O1" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (compile-dll-c-files HP-UX (lambda (files parms) (batch:system parms @@ -531,7 +615,7 @@ type;exec scmlit -f $0 -e"(bi)" build $* (c-includes parms) (c-flags parms) files) - (for-each + (map (lambda (fname) (batch:rename-file parms (string-append fname ".sl") @@ -539,32 +623,39 @@ type;exec scmlit -f $0 -e"(bi)" build $* (batch:system parms "ld" "-b" "-o" (string-append fname ".sl") - (string-append fname ".o"))) - (replace-suffix files ".c" "")) - (replace-suffix files ".c" ".sl"))) + (string-append fname ".o")) + (string-append fname ".sl")) + (truncate-up-to + (replace-suffix files ".c" "") + #\/)))) ; (make-dll-archive HP-UX ; (lambda (oname objects libs parms) ; (batch:system parms ; "ld" "-b" "-o" (string-append oname ".sl") ; objects) +; (rebuild-catalog) ; (string-append oname ".sl"))) - (make-dll-archive sun + (make-dll-archive sunos (lambda (oname objects libs parms) (batch:system parms "ld" "-assert" "pure-text" "-o" (string-append oname ".so.1.0") objects) + (rebuild-catalog) (string-append oname ".so.1.0"))) (compile-c-files linux-aout (lambda (files parms) (batch:system parms "gcc" "-Wall" "-O2" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (compile-dll-c-files linux-aout (lambda (files parms) (batch:system parms @@ -572,18 +663,24 @@ type;exec scmlit -f $0 -e"(bi)" build $* (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) ;;; (make-dll-archive linux-aout ;;; (lambda (oname objects libs parms) #t +;;; (rebuild-catalog) ;;; oname)) (compile-c-files linux (lambda (files parms) (batch:system parms "gcc" "-O2" "-c" (c-includes parms) + (include-spec "-I" parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (compile-dll-c-files linux (lambda (files parms) (batch:system parms @@ -596,15 +693,17 @@ type;exec scmlit -f $0 -e"(bi)" build $* (map (lambda (l) (build:lib-ld-flag l platform)) (parameter-list-ref parms 'c-lib)))) - (for-each + (map (lambda (fname) (batch:system parms "gcc" "-shared" "-o" (string-append fname ".so") (string-append fname ".o") - ld-opts)) - (replace-suffix files ".c" ""))) - (replace-suffix files ".c" ".so"))) + ld-opts) + (string-append fname ".so")) + (truncate-up-to + (replace-suffix files ".c" "") + #\/))))) (make-dll-archive linux (lambda (oname objects libs parms) (let ((platform (car (parameter-list-ref @@ -616,6 +715,7 @@ type;exec scmlit -f $0 -e"(bi)" build $* objects (map (lambda (l) (build:lib-ld-flag l platform)) (parameter-list-ref parms 'c-lib)))) + (rebuild-catalog) (string-append oname ".so"))) (link-c-program linux (lambda (oname objects libs parms) @@ -630,10 +730,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "cc" "-hvector2" "-hscalar2" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (link-c-program Unicos (lambda (oname objects libs parms) (batch:system parms @@ -644,11 +747,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "gcc" "-Wall" "-O2" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) - + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (link-c-program gcc (lambda (oname objects libs parms) (batch:rename-file parms @@ -662,23 +767,53 @@ type;exec scmlit -f $0 -e"(bi)" build $* (append objects libs))) oname)) + (compile-c-files sun-svr4-gcc-sunld + (lambda (files parms) + (batch:system parms + "gcc" "-Wall" "-O2" "-c" + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + files) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) + (link-c-program sun-svr4-gcc-sunld + (lambda (oname objects libs parms) + (batch:rename-file parms + oname (string-append oname "~")) + (batch:system parms + "gcc" "-o" oname + (must-be-first + '("-nostartfiles" + "pre-crt0.o" "ecrt0.o" + "/usr/lib/crt0.o") + (append objects libs))) + oname)) + (compile-c-files svr4 (lambda (files parms) (batch:system parms "cc" "-O" "-DSVR4" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (compile-c-files aix (lambda (files parms) (batch:system parms "cc" "-O" "-Dunix" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (link-c-program aix (lambda (oname objects libs parms) (batch:system parms @@ -689,10 +824,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "cc" "-dAMIGA" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (link-c-program amiga-aztec (lambda (oname objects libs parms) (batch:system parms @@ -703,11 +841,14 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "lc" "-d3" "-M" "-fi" "-O" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) (batch:system parms "blink with link.amiga NODEBUG") - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (link-c-program amiga-SAS/C-5.10 (lambda (oname objects libs parms) (define lnk-name "link.amiga") @@ -732,10 +873,15 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "dcc" "-r" "-gs" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) - files "-o" (replace-suffix files ".c" ".o")) - (replace-suffix files ".c" ".o"))) + files "-o" (truncate-up-to + (replace-suffix files ".c" ".o") + #\/)) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (link-c-program amiga-dice-c (lambda (oname objects libs parms) (batch:system parms @@ -746,10 +892,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "gcc" "-v" "-O" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (link-c-program atari-st-gcc (lambda (oname objects libs parms) (batch:system parms @@ -761,10 +910,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "tcc" "-P" "-W-" "-Datarist" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (link-c-program atari-st-turbo-c (lambda (oname objects libs parms) (batch:system parms @@ -778,10 +930,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (batch:system parms "cc" "-c" "-depend" "!Depend" "-IUnixLib:" "-pcc" "-Dunix" "-DSVR3" "-DARM_ULIB" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + #\/))) (link-c-program acorn-unixlib (lambda (oname objects libs parms) (batch:system parms @@ -798,11 +953,15 @@ type;exec scmlit -f $0 -e"(bi)" build $* (c-includes parms) (c-flags parms) (replace-suffix files ".c" "")) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + "/]"))) (link-c-program vms (lambda (oname objects libs parms) - (let ((exe (replace-suffix (car objects) - ".obj" ".exe")) + (let ((exe (truncate-up-to + (replace-suffix (car objects) + ".obj" ".exe") + "/]")) (oexe (string-append oname ".exe"))) (batch:system parms "macro" "setjump") @@ -824,14 +983,19 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "gcc" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) (replace-suffix files ".c" "")) - (replace-suffix files ".c" ".obj"))) + (truncate-up-to + (replace-suffix files ".c" ".obj") + "/]"))) (link-c-program vms-gcc (lambda (oname objects libs parms) - (let ((exe (replace-suffix (car objects) - ".obj" ".exe")) + (let ((exe (truncate-up-to + (replace-suffix (car objects) + ".obj" ".exe") + "/]")) (oexe (string-append oname ".exe"))) (batch:system parms "macro" "setjump") @@ -853,10 +1017,13 @@ type;exec scmlit -f $0 -e"(bi)" build $* (lambda (files parms) (batch:system parms "cc" "-O" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + "\\/]"))) (link-c-program *unknown* (lambda (oname objects libs parms) (batch:rename-file parms @@ -872,10 +1039,8 @@ type;exec scmlit -f $0 -e"(bi)" build $* (make-archive *unknown* (lambda (oname objects libs parms) (let ((aname (string-append oname ".a"))) - (batch:system parms - "ar rc" aname objects) - (batch:system parms - "ranlib" aname) + (batch:system parms "ar rc" aname objects) + (batch:system parms "ranlib" aname) aname))) (compile-dll-c-files *unknown* (lambda (files parms) @@ -884,7 +1049,9 @@ type;exec scmlit -f $0 -e"(bi)" build $* (c-includes parms) (c-flags parms) files) - (replace-suffix files ".c" ".o"))) + (truncate-up-to + (replace-suffix files ".c" ".o") + "\\/]"))) (make-dll-archive *unknown* (lambda (oname objects libs parms) (let ((aname (string-append oname ".a"))) @@ -892,11 +1059,59 @@ type;exec scmlit -f $0 -e"(bi)" build $* "ar rc" aname objects) (batch:system parms "ranlib" aname) + (rebuild-catalog) aname))) - (make-nothing *unknown* - (lambda (oname objects libs parms) - (if (= 1 (length objects)) (car objects) - objects))) + (update-catalog *unknown* + (lambda (oname objects libs parms) + (rebuild-catalog) + (if (= 1 (length objects)) (car objects) + objects))) + + (compile-c-files freebsd + (lambda (files parms) + (batch:system parms + "cc" "-O" "-Dfreebsd" "-c" + (c-includes parms) + (c-flags parms) + files) + (replace-suffix files ".c" ".o"))) + (link-c-program freebsd + (lambda (oname objects libs parms) + (batch:rename-file parms + oname (string-append oname "~")) + (batch:system parms + "cc" "-o" oname + (must-be-first + '("-nostartfiles" + "pre-crt0.o" "crt0.o" + "/usr/lib/crt0.o") + (append objects libs))) + oname)) + (compile-dll-c-files freebsd + (lambda (files parms) + (batch:system parms + "cc" "-O" "-fpic" "-c" + "-Dfreebsd" + (string-append "-I" (implementation-vicinity)) + (c-includes parms) + (c-flags parms) + files) + (let ((objs (replace-suffix files ".c" ".o"))) + (map (lambda (f) + (batch:system parms "ld" "-Bshareable" f) + (batch:system parms "mv" "a.out" f)) + objs) + objs))) + + (make-dll-archive freebsd + (lambda (oname objects libs parms) + (batch:system parms + "ld" "-Bshareable" "-o" + (string-append oname ".so") + objects) + (rebuild-catalog) + (string-append oname ".so"))) + )) '(features @@ -936,6 +1151,10 @@ value of STACK_LIMIT to be the size to which SCM should allow the stack to grow. STACK_LIMIT should be less than the maximum size the hardware can support, as not every routine checks the stack.") + (macro ((define "MACRO") (features rev2-procedures record)) + "\ +R4RS-macros") + (bignums ((define "BIGNUMS")) "\ Large precision integers.") @@ -978,7 +1197,7 @@ Define SICP if you want to run code from: These procedures were specified in the `Revised^2 Report on Scheme' but not in `R4RS'.") - (record ((c-file "record.c") (init "init_record")) + (record ((define "CCLO") (c-file "record.c") (init "init_record")) "\ The Record package provides a facility for user to define their own record data types. See SLIB for documentation.") @@ -1019,7 +1238,7 @@ interface to the editline or GNU readline library") "\ String regular expression matching.") - (socket ((c-file "socket.c") (init "init_socket")) + (socket ((c-lib socket) (c-file "socket.c") (init "init_socket")) "\ BSD socket interface.") @@ -1041,14 +1260,7 @@ Microsoft Windows executable.") "\ Load compiled files while running.") - (dump ((define "CAN_DUMP") - (c-lib dump) - (c-lib nostart) - (c-file "unexec.c") - (c-file "unexelf.c") - (c-file "gmalloc.c") - (c-file "ecrt0.c") - (c-file "pre-crt0.c")) + (dump ((define "CAN_DUMP") (c-lib dump) (c-lib nostart)) "\ Convert a running scheme program into an executable file.") @@ -1074,11 +1286,6 @@ unusual stacks need this. Also, if you incorporate new C code into scm which uses VMS system services or library routines (which need to unwind the stack in an ordrly manner) you may need to define CHEAP_CONTINUATIONS.") - - (memoize-local-bindings ((define "MEMOIZE_LOCALS")) - "\ -Saves the interpeter from having to look up local bindings for every -identifier reference") )) '(build-params *parameter-columns* @@ -1107,19 +1314,13 @@ identifier reference") (11 what single build-whats (lambda (pl) '(exe)) (lambda (rdb) - (define tab (((rdb 'open-table) 'build-whats #f) 'get 'class)) - (define manifest ((((rdb 'open-table) 'manifest #f) - 'row:retrieve*))) - (lambda (what) - (define catgry (tab what)) - `((c-file - ,@(map car - (remove-if-not - (lambda (row) (and (eq? 'c-source (cadr row)) - (eq? catgry (caddr row)))) - manifest))) - ,@(or ((((rdb 'open-table) 'build-whats #f) 'get 'spec) what) - '())))) + (let* ((bwt ((rdb 'open-table) 'build-whats #f)) + (getclass (bwt 'get 'class)) + (getspec (bwt 'get 'spec)) + (getfile (((rdb 'open-table) 'manifest #f) 'get* 'file))) + (lambda (what) + `((c-file ,@(getfile #f 'c-source (getclass what))) + ,@(or (getspec what) '()))))) "what to build") (12 batch-dialect single batch-dialect guess-how @@ -1134,6 +1335,12 @@ identifier reference") "port batch file will be written to.") (18 c-defines nary expression #f #f "#defines for C") (19 c-includes nary expression #f #f "library induced defines for C") + (20 scm-srcdir single filename + (lambda (pl) (list (user-vicinity))) #f + "directory path for files in the manifest") + (21 scm-libdir single filename + (lambda (pl) (list (implementation-vicinity))) #f + "directory path for files in the manifest") )) '(build-pnames ((name string)) @@ -1153,6 +1360,8 @@ identifier reference") ("w" 13) ("script name" 13) ("compiler options" 14) ("linker options" 15) + ("scm srcdir" 20) + ("scm libdir" 21) )) '(*commands* @@ -1179,7 +1388,7 @@ identifier reference") (define build:c-libraries #f) (define build:lib-cc-flag #f) (define build:lib-ld-flag #f) -(define build:c-supress #f) +(define build:c-lib-support #f) (define plan-command #f) ;;; Look up command on a platform, but default to '*unknown* if not @@ -1191,105 +1400,109 @@ identifier reference") (let ((ans (getter thing platform))) (cond (ans ans) ((eq? '*unknown* platform) - (build:error "Couldn't find: " thing)) + (build:error "Couldn't find: " plat thing)) (else (look '*unknown*))))) (look plat))) -(define system:success? zero?) - (require 'alist) (require 'common-list-functions) (require 'object->string) -(define build:build - (lambda (rdb) - (lambda (parms) - (let ((expanders - (map (lambda (e) (and e (lambda (s) (e s)))) - (map (lambda (f) (if f ((slib:eval f) rdb) f)) - ((((rdb 'open-table) 'build-params #f) - 'get* 'expander)))))) - (parameter-list-expand expanders parms) - (set! parms - (fill-empty-parameters - (map slib:eval - ((((rdb 'open-table) 'build-params #f) - 'get* 'default))) - parms)) - (parameter-list-expand expanders parms)) - (let* ((platform (car (parameter-list-ref parms 'platform))) - (init= (apply string-append - (map (lambda (c) - (string-append c "();")) - (parameter-list-ref parms 'init)))) - (compiled-init= - (apply string-append - (map (lambda (c) - (string-append c "();")) - (parameter-list-ref parms 'compiled-init)))) - (c-defines - `((define "IMPLINIT" - ,(car (parameter-list-ref parms 'implinit))) - ,@(if (string=? "" init=) '() - `((define "INITS" ,init=))) - ,@(if (string=? "" compiled-init=) '() - `((define "COMPILED_INITS" ,compiled-init=))) - ,@(map (lambda (d) (if (pair? d) - `(define ,@d) - `(define ,d #t))) - (parameter-list-ref parms 'define)))) - (c-includes - (map (lambda (l) (build:lib-cc-flag l platform)) - (parameter-list-ref parms 'c-lib))) - (batch-dialect (car (parameter-list-ref parms 'batch-dialect))) - (what (car (parameter-list-ref parms 'what))) - (c-proc (plan-command ((((rdb 'open-table) 'build-whats #f) - 'get 'c-proc) - what) - platform))) - (adjoin-parameters! +(define (build:build rdb) + (lambda (parms) + (let ((expanders + (map (lambda (e) (and e (lambda (s) (e s)))) + (map (lambda (f) (if f ((slib:eval f) rdb) f)) + ((((rdb 'open-table) 'build-params #f) + 'get* 'expander)))))) + (parameter-list-expand expanders parms) + (set! parms + (fill-empty-parameters + (map slib:eval + ((((rdb 'open-table) 'build-params #f) + 'get* 'defaulter))) + parms)) + (parameter-list-expand expanders parms)) + (let* ((platform (car (parameter-list-ref parms 'platform))) + (init= (apply string-append + (map (lambda (c) + (string-append c "();")) + (parameter-list-ref parms 'init)))) + (compiled-init= + (apply string-append + (map (lambda (c) + (string-append c "();")) + (parameter-list-ref parms 'compiled-init)))) + (c-defines + `((define "IMPLINIT" + ,(car (parameter-list-ref parms 'implinit))) + ,@(if (string=? "" init=) '() + `((define "INITS" ,init=))) + ,@(if (string=? "" compiled-init=) '() + `((define "COMPILED_INITS" ,compiled-init=))) + ,@(map (lambda (d) (if (pair? d) + `(define ,@d) + `(define ,d #t))) + (parameter-list-ref parms 'define)))) + (c-includes + (map (lambda (l) (build:lib-cc-flag l platform)) + (parameter-list-ref parms 'c-lib))) + (batch-dialect (car (parameter-list-ref parms 'batch-dialect))) + (what (car (parameter-list-ref parms 'what))) + (c-proc (plan-command ((((rdb 'open-table) 'build-whats #f) + 'get 'c-proc) + what) + platform))) + (adjoin-parameters! + parms + (cons 'c-defines c-defines) + (cons 'c-includes c-includes) + ) + + (let ((name (car (parameter-list-ref parms 'who)))) + (batch:call-with-output-script parms - (cons 'c-defines c-defines) - (cons 'c-includes c-includes) - ) - - (let ((name (car (parameter-list-ref parms 'who)))) - (batch:call-with-output-script - parms - name - (lambda (batch-port) - (define o-files '()) - (adjoin-parameters! - parms - (list 'batch-port batch-port)) - - ;; ================ Write file with C defines - (apply batch:lines->file parms - "scmflags.h" - (defines->c-defines c-defines)) - - ;; ================ Compile C source files - (set! o-files - (let ((supressors - (apply append - (map (lambda (l) (build:c-supress l platform)) - (parameter-list-ref parms 'c-lib))))) - (c-proc (remove-if (lambda (file) (member file supressors)) - (parameter-list-ref parms 'c-file)) - parms))) - - ;; ================ Link C object files - ((plan-command - ((((rdb 'open-table) 'build-whats #f) 'get 'o-proc) what) - platform) - (car (parameter-list-ref parms 'target-name)) - (append o-files (parameter-list-ref parms 'o-file)) - (append - (parameter-list-ref parms 'linker-options) - (map (lambda (l) (build:lib-ld-flag l platform)) - (parameter-list-ref parms 'c-lib))) - parms)))))))) - + name + (lambda (batch-port) + (define o-files '()) + (adjoin-parameters! + parms + (list 'batch-port batch-port)) + + ;; ================ Write file with C defines + (apply batch:lines->file parms + "scmflags.h" + (defines->c-defines c-defines)) + + ;; ================ Compile C source files + (set! o-files + (c-proc + (map (lambda (file) + (in-vicinity + (car (parameter-list-ref parms 'scm-srcdir)) + file)) + (apply append + (parameter-list-ref parms 'c-file) + (map + (lambda (l) (build:c-lib-support l platform)) + (parameter-list-ref parms 'c-lib)))) + parms)) + + ;; ================ Link C object files + ((plan-command + ((((rdb 'open-table) 'build-whats #f) 'get 'o-proc) what) + platform) + (car (parameter-list-ref parms 'target-name)) + (append o-files (parameter-list-ref parms 'o-file)) + (append + (parameter-list-ref parms 'linker-options) + (map (lambda (l) (build:lib-ld-flag l platform)) + (parameter-list-ref parms 'c-lib))) + parms))))))) + +(define (include-spec str parms) + (let ((path (car (parameter-list-ref parms 'scm-srcdir)))) + (if (eqv? "" path) () (list str path)))) (define (c-defines parms) (parameter-list-ref parms 'c-defines)) (define (c-includes parms) @@ -1332,9 +1545,9 @@ identifier reference") (set! build:lib-ld-flag (make-defaulting-platform-lookup (build:c-libraries 'get 'link-lib-flag))) - (set! build:c-supress + (set! build:c-lib-support (make-defaulting-platform-lookup - (build:c-libraries 'get 'supress-files))) + (build:c-libraries 'get 'lib-support))) (set! plan-command (let ((lookup (make-defaulting-platform-lookup (((rdb 'open-table) 'compile-commands #f) @@ -1343,6 +1556,11 @@ identifier reference") (slib:eval (lookup thing plat))))))) (build:initializer build) +(define (rebuild-catalog) + (delete-file (in-vicinity (implementation-vicinity) "slibcat")) + ;;(load (in-vicinity (implementation-vicinity) "mkimpcat")) + ) + (define (build-from-argv argv) (cond ((string? argv) (require 'read-command) @@ -1356,10 +1574,10 @@ identifier reference") ((make-command-server build '*commands*) command (lambda (comname comval options positions arities types - defaults checks aliases) + defaulters checks aliases) (let* ((params (getopt->parameter-list argc argv options arities types aliases)) - (fparams (fill-empty-parameters defaults params))) + (fparams (fill-empty-parameters defaulters params))) (cond ((not (list? params)) #f) ((not (check-parameters checks fparams)) #f) ((not (check-arities (map arity->arity-spec arities) fparams)) @@ -1391,3 +1609,7 @@ identifier reference") (cond (*interactive* (display "type (b \"build <command-line>\") to build") (newline) (display "type (b*) to enter build command loop") (newline))) + +;;; Local Variables: +;;; mode:scheme +;;; End: diff --git a/configure b/configure deleted file mode 100755 index 53d869e..0000000 --- a/configure +++ /dev/null @@ -1,849 +0,0 @@ -#!/bin/sh -# Guess values for system-dependent variables and create Makefiles. -# Generated automatically using autoconf. -# Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc. - -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -# Usage: configure [--srcdir=DIR] [--host=HOST] [--gas] [--nfp] -# [--prefix=PREFIX] [--exec-prefix=PREFIX] [--with-PACKAGE[=VALUE]] -# Ignores all args except --srcdir, --prefix, --exec-prefix, and -# --with-PACKAGE[=VALUE] unless this script has special code to handle it. - -for arg -do - # Handle --exec-prefix with a space before the argument. - if test x$next_exec_prefix = xyes; then exec_prefix=$arg; next_exec_prefix= - # Handle --host with a space before the argument. - elif test x$next_host = xyes; then next_host= - # Handle --prefix with a space before the argument. - elif test x$next_prefix = xyes; then prefix=$arg; next_prefix= - # Handle --srcdir with a space before the argument. - elif test x$next_srcdir = xyes; then srcdir=$arg; next_srcdir= - else - case $arg in - # For backward compatibility, recognize -exec-prefix and --exec_prefix. - -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* | --exec=* | --exe=* | --ex=* | --e=*) - exec_prefix=`echo $arg | sed 's/[-a-z_]*=//'` ;; - -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- | --exec | --exe | --ex | --e) - next_exec_prefix=yes ;; - - -gas | --gas | --ga | --g) ;; - - -host=* | --host=* | --hos=* | --ho=* | --h=*) ;; - -host | --host | --hos | --ho | --h) - next_host=yes ;; - - -nfp | --nfp | --nf) ;; - - -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) - prefix=`echo $arg | sed 's/[-a-z_]*=//'` ;; - -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) - next_prefix=yes ;; - - -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=* | --s=*) - srcdir=`echo $arg | sed 's/[-a-z_]*=//'` ;; - -srcdir | --srcdir | --srcdi | --srcd | --src | --sr | --s) - next_srcdir=yes ;; - - -with-* | --with-*) - package=`echo $arg|sed -e 's/-*with-//' -e 's/=.*//'` - # Reject names that aren't valid shell variable names. - if test -n "`echo $package| sed 's/[-a-zA-Z0-9_]//g'`"; then - echo "configure: $package: invalid package name" >&2; exit 1 - fi - package=`echo $package| sed 's/-/_/g'` - case "$arg" in - *=*) val="`echo $arg|sed 's/[^=]*=//'`" ;; - *) val=1 ;; - esac - eval "with_$package='$val'" ;; - - -v | -verbose | --verbose | --verbos | --verbo | --verb | --ver | --ve | --v) - verbose=yes ;; - - *) ;; - esac - fi -done - -trap 'rm -fr conftest* confdefs* core; exit 1' 1 3 15 -trap 'rm -f confdefs*' 0 - -# NLS nuisances. -# These must not be set unconditionally because not all systems understand -# e.g. LANG=C (notably SCO). -if test "${LC_ALL+set}" = 'set' ; then LC_ALL=C; export LC_ALL; fi -if test "${LANG+set}" = 'set' ; then LANG=C; export LANG; fi - -rm -f conftest* confdefs.h -# AIX cpp loses on an empty file, so make sure it contains at least a newline. -echo > confdefs.h -compile='${CC-cc} $CFLAGS conftest.c -o conftest $LIBS >/dev/null 2>&1' - -# A filename unique to this package, relative to the directory that -# configure is in, which we can look for to find out if srcdir is correct. -unique_file=scl.c - -# Find the source files, if location was not specified. -if test -z "$srcdir"; then - srcdirdefaulted=yes - # Try the directory containing this script, then `..'. - prog=$0 - confdir=`echo $prog|sed 's%/[^/][^/]*$%%'` - test "X$confdir" = "X$prog" && confdir=. - srcdir=$confdir - if test ! -r $srcdir/$unique_file; then - srcdir=.. - fi -fi -if test ! -r $srcdir/$unique_file; then - if test x$srcdirdefaulted = xyes; then - echo "configure: Can not find sources in \`${confdir}' or \`..'." 1>&2 - else - echo "configure: Can not find sources in \`${srcdir}'." 1>&2 - fi - exit 1 -fi -# Preserve a srcdir of `.' to avoid automounter screwups with pwd. -# But we can't avoid them for `..', to make subdirectories work. -case $srcdir in - .|/*|~*) ;; - *) srcdir=`cd $srcdir; pwd` ;; # Make relative path absolute. -esac - - -# Save the original args to write them into config.status later. -configure_args="$*" - - - -test -z "$CFLAGS" && CFLAGS=-g -test -z "$LDFLAGS" && LDFLAGS=-g - -if test -z "$CC"; then - # Extract the first word of `gcc', so it can be a program name with args. - set dummy gcc; word=$2 - echo checking for $word - IFS="${IFS= }"; saveifs="$IFS"; IFS="${IFS}:" - for dir in $PATH; do - test -z "$dir" && dir=. - if test -f $dir/$word; then - CC="gcc" - break - fi - done - IFS="$saveifs" -fi -test -z "$CC" && CC="cc" -test -n "$CC" && test -n "$verbose" && echo " setting CC to $CC" - -# Find out if we are using GNU C, under whatever name. -cat > conftest.c <<EOF -#ifdef __GNUC__ - yes -#endif -EOF -${CC-cc} -E conftest.c > conftest.out 2>&1 -if egrep yes conftest.out >/dev/null 2>&1; then - GCC=1 # For later tests. -fi -rm -f conftest* - -# Make sure to not get the incompatible SysV /etc/install and -# /usr/sbin/install, which might be in PATH before a BSD-like install, -# or the SunOS /usr/etc/install directory, or the AIX /bin/install, -# or the AFS install, which mishandles nonexistent args, or -# /usr/ucb/install on SVR4, which tries to use the nonexistent group -# `staff'. On most BSDish systems install is in /usr/bin, not /usr/ucb -# anyway. Sigh. -if test "z${INSTALL}" = "z" ; then - echo checking for install - IFS="${IFS= }"; saveifs="$IFS"; IFS="${IFS}:" - for dir in $PATH; do - test -z "$dir" && dir=. - case $dir in - /etc|/usr/sbin|/usr/etc|/usr/afsws/bin|/usr/ucb) ;; - *) - if test -f $dir/installbsd; then - INSTALL="$dir/installbsd -c" # OSF1 - INSTALL_PROGRAM='$(INSTALL)' - INSTALL_DATA='$(INSTALL) -m 644' - break - fi - if test -f $dir/install; then - if grep dspmsg $dir/install >/dev/null 2>&1; then - : # AIX - else - INSTALL="$dir/install -c" - INSTALL_PROGRAM='$(INSTALL)' - INSTALL_DATA='$(INSTALL) -m 644' - break - fi - fi - ;; - esac - done - IFS="$saveifs" -fi -INSTALL=${INSTALL-cp} -test -n "$verbose" && echo " setting INSTALL to $INSTALL" -INSTALL_PROGRAM=${INSTALL_PROGRAM-'$(INSTALL)'} -test -n "$verbose" && echo " setting INSTALL_PROGRAM to $INSTALL_PROGRAM" -INSTALL_DATA=${INSTALL_DATA-'$(INSTALL)'} -test -n "$verbose" && echo " setting INSTALL_DATA to $INSTALL_DATA" - -echo checking how to run the C preprocessor -if test -z "$CPP"; then - # This must be in double quotes, not single quotes, because CPP may get - # substituted into the Makefile and ``${CC-cc}'' will simply confuse - # make. It must be expanded now. - CPP="${CC-cc} -E" - cat > conftest.c <<EOF -#include "confdefs.h" -#include <stdio.h> -Syntax Error -EOF -err=`eval "($CPP conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - : -else - rm -rf conftest* - CPP=/lib/cpp -fi -rm -f conftest* -fi -test ".${verbose}" != "." && echo " setting CPP to $CPP" - -if test -z "$RANLIB"; then - # Extract the first word of `ranlib', so it can be a program name with args. - set dummy ranlib; word=$2 - echo checking for $word - IFS="${IFS= }"; saveifs="$IFS"; IFS="${IFS}:" - for dir in $PATH; do - test -z "$dir" && dir=. - if test -f $dir/$word; then - RANLIB="ranlib" - break - fi - done - IFS="$saveifs" -fi -test -z "$RANLIB" && RANLIB=":" -test -n "$RANLIB" && test -n "$verbose" && echo " setting RANLIB to $RANLIB" - -echo checking for AIX -cat > conftest.c <<EOF -#include "confdefs.h" -#ifdef _AIX - yes -#endif - -EOF -eval "$CPP conftest.c > conftest.out 2>&1" -if egrep "yes" conftest.out >/dev/null 2>&1; then - rm -rf conftest* - -{ -test -n "$verbose" && \ -echo " defining _ALL_SOURCE" -echo "#define" _ALL_SOURCE 1 >> confdefs.h -DEFS="$DEFS -D_ALL_SOURCE=1" -SEDDEFS="${SEDDEFS}\${SEDdA}_ALL_SOURCE\${SEDdB}_ALL_SOURCE\${SEDdC}1\${SEDdD} -\${SEDuA}_ALL_SOURCE\${SEDuB}_ALL_SOURCE\${SEDuC}1\${SEDuD} -\${SEDeA}_ALL_SOURCE\${SEDeB}_ALL_SOURCE\${SEDeC}1\${SEDeD} -" -} - - -fi -rm -f conftest* - - -echo checking for POSIXized ISC -if test -d /etc/conf/kconfig.d && - grep _POSIX_VERSION /usr/include/sys/unistd.h >/dev/null 2>&1 -then - ISC=1 # If later tests want to check for ISC. - -{ -test -n "$verbose" && \ -echo " defining _POSIX_SOURCE" -echo "#define" _POSIX_SOURCE 1 >> confdefs.h -DEFS="$DEFS -D_POSIX_SOURCE=1" -SEDDEFS="${SEDDEFS}\${SEDdA}_POSIX_SOURCE\${SEDdB}_POSIX_SOURCE\${SEDdC}1\${SEDdD} -\${SEDuA}_POSIX_SOURCE\${SEDuB}_POSIX_SOURCE\${SEDuC}1\${SEDuD} -\${SEDeA}_POSIX_SOURCE\${SEDeB}_POSIX_SOURCE\${SEDeC}1\${SEDeD} -" -} - - if test -n "$GCC"; then - CC="$CC -posix" - else - CC="$CC -Xp" - fi -fi - -echo checking for minix/config.h -cat > conftest.c <<EOF -#include "confdefs.h" -#include <minix/config.h> -EOF -err=`eval "($CPP conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - rm -rf conftest* - MINIX=1 - -fi -rm -f conftest* - -# The Minix shell can't assign to the same variable on the same line! -if test -n "$MINIX"; then - -{ -test -n "$verbose" && \ -echo " defining _POSIX_SOURCE" -echo "#define" _POSIX_SOURCE 1 >> confdefs.h -DEFS="$DEFS -D_POSIX_SOURCE=1" -SEDDEFS="${SEDDEFS}\${SEDdA}_POSIX_SOURCE\${SEDdB}_POSIX_SOURCE\${SEDdC}1\${SEDdD} -\${SEDuA}_POSIX_SOURCE\${SEDuB}_POSIX_SOURCE\${SEDuC}1\${SEDuD} -\${SEDeA}_POSIX_SOURCE\${SEDeB}_POSIX_SOURCE\${SEDeC}1\${SEDeD} -" -} - - -{ -test -n "$verbose" && \ -echo " defining" _POSIX_1_SOURCE to be 2 -echo "#define" _POSIX_1_SOURCE 2 >> confdefs.h -DEFS="$DEFS -D_POSIX_1_SOURCE=2" -SEDDEFS="${SEDDEFS}\${SEDdA}_POSIX_1_SOURCE\${SEDdB}_POSIX_1_SOURCE\${SEDdC}2\${SEDdD} -\${SEDuA}_POSIX_1_SOURCE\${SEDuB}_POSIX_1_SOURCE\${SEDuC}2\${SEDuD} -\${SEDeA}_POSIX_1_SOURCE\${SEDeB}_POSIX_1_SOURCE\${SEDeC}2\${SEDeD} -" -} - - -{ -test -n "$verbose" && \ -echo " defining _MINIX" -echo "#define" _MINIX 1 >> confdefs.h -DEFS="$DEFS -D_MINIX=1" -SEDDEFS="${SEDDEFS}\${SEDdA}_MINIX\${SEDdB}_MINIX\${SEDdC}1\${SEDdD} -\${SEDuA}_MINIX\${SEDuB}_MINIX\${SEDuC}1\${SEDuD} -\${SEDeA}_MINIX\${SEDeB}_MINIX\${SEDeC}1\${SEDeD} -" -} - -fi - -echo checking for ANSI C header files -cat > conftest.c <<EOF -#include "confdefs.h" -#include <stdlib.h> -#include <stdarg.h> -#include <string.h> -#include <float.h> -EOF -err=`eval "($CPP conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - rm -rf conftest* - # SunOS 4.x string.h does not declare mem*, contrary to ANSI. -echo '#include "confdefs.h" -#include <string.h>' > conftest.c -eval "$CPP conftest.c > conftest.out 2>&1" -if egrep "memchr" conftest.out >/dev/null 2>&1; then - rm -rf conftest* - # SGI's /bin/cc from Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. -cat > conftest.c <<EOF -#include "confdefs.h" -#include <ctype.h> -#define ISLOWER(c) ('a' <= (c) && (c) <= 'z') -#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) -#define XOR(e,f) (((e) && !(f)) || (!(e) && (f))) -int main () { int i; for (i = 0; i < 256; i++) -if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); -exit (0); } - -EOF -eval $compile -if test -s conftest && (./conftest; exit) 2>/dev/null; then - -{ -test -n "$verbose" && \ -echo " defining STDC_HEADERS" -echo "#define" STDC_HEADERS 1 >> confdefs.h -DEFS="$DEFS -DSTDC_HEADERS=1" -SEDDEFS="${SEDDEFS}\${SEDdA}STDC_HEADERS\${SEDdB}STDC_HEADERS\${SEDdC}1\${SEDdD} -\${SEDuA}STDC_HEADERS\${SEDuB}STDC_HEADERS\${SEDuC}1\${SEDuD} -\${SEDeA}STDC_HEADERS\${SEDeB}STDC_HEADERS\${SEDeC}1\${SEDeD} -" -} - - -fi -rm -fr conftest* - -fi -rm -f conftest* - - -fi -rm -f conftest* - -for hdr in unistd.h string.h memory.h limits.h time.h sys/types.h sys/time.h sys/timeb.h sys/times.h -do -trhdr=HAVE_`echo $hdr | tr '[a-z]./' '[A-Z]__'` -echo checking for ${hdr} -cat > conftest.c <<EOF -#include "confdefs.h" -#include <${hdr}> -EOF -err=`eval "($CPP conftest.c >/dev/null) 2>&1"` -if test -z "$err"; then - rm -rf conftest* - -{ -test -n "$verbose" && \ -echo " defining ${trhdr}" -echo "#define" ${trhdr} 1 >> confdefs.h -DEFS="$DEFS -D${trhdr}=1" -SEDDEFS="${SEDDEFS}\${SEDdA}${trhdr}\${SEDdB}${trhdr}\${SEDdC}1\${SEDdD} -\${SEDuA}${trhdr}\${SEDuB}${trhdr}\${SEDuC}1\${SEDuD} -\${SEDeA}${trhdr}\${SEDeB}${trhdr}\${SEDeC}1\${SEDeD} -" -} - - -fi -rm -f conftest* -done - -echo checking for whether time.h and sys/time.h may both be included -cat > conftest.c <<EOF -#include "confdefs.h" -#include <sys/types.h> -#include <sys/time.h> -#include <time.h> -int main() { exit(0); } -int t() { struct tm *tp; } -EOF -if eval $compile; then - rm -rf conftest* - -{ -test -n "$verbose" && \ -echo " defining TIME_WITH_SYS_TIME" -echo "#define" TIME_WITH_SYS_TIME 1 >> confdefs.h -DEFS="$DEFS -DTIME_WITH_SYS_TIME=1" -SEDDEFS="${SEDDEFS}\${SEDdA}TIME_WITH_SYS_TIME\${SEDdB}TIME_WITH_SYS_TIME\${SEDdC}1\${SEDdD} -\${SEDuA}TIME_WITH_SYS_TIME\${SEDuB}TIME_WITH_SYS_TIME\${SEDuC}1\${SEDuD} -\${SEDeA}TIME_WITH_SYS_TIME\${SEDeB}TIME_WITH_SYS_TIME\${SEDeC}1\${SEDeD} -" -} - - -fi -rm -f conftest* - -for func in ftime times -do -trfunc=HAVE_`echo $func | tr '[a-z]' '[A-Z]'` -echo checking for ${func} -cat > conftest.c <<EOF -#include "confdefs.h" -#include <ctype.h> -int main() { exit(0); } -int t() { -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_${func}) || defined (__stub___${func}) -choke me -#else -/* Override any gcc2 internal prototype to avoid an error. */ -extern char ${func}(); ${func}(); -#endif - } -EOF -if eval $compile; then - rm -rf conftest* - { -test -n "$verbose" && \ -echo " defining ${trfunc}" -echo "#define" ${trfunc} 1 >> confdefs.h -DEFS="$DEFS -D${trfunc}=1" -SEDDEFS="${SEDDEFS}\${SEDdA}${trfunc}\${SEDdB}${trfunc}\${SEDdC}1\${SEDdD} -\${SEDuA}${trfunc}\${SEDuB}${trfunc}\${SEDuC}1\${SEDuD} -\${SEDeA}${trfunc}\${SEDeB}${trfunc}\${SEDeC}1\${SEDeD} -" -} - - -fi -rm -f conftest* -done - -echo checking for return type of signal handlers -cat > conftest.c <<EOF -#include "confdefs.h" -#include <sys/types.h> -#include <signal.h> -#ifdef signal -#undef signal -#endif -extern void (*signal ()) (); -int main() { exit(0); } -int t() { int i; } -EOF -if eval $compile; then - rm -rf conftest* - -{ -test -n "$verbose" && \ -echo " defining" RETSIGTYPE to be void -echo "#define" RETSIGTYPE void >> confdefs.h -DEFS="$DEFS -DRETSIGTYPE=void" -SEDDEFS="${SEDDEFS}\${SEDdA}RETSIGTYPE\${SEDdB}RETSIGTYPE\${SEDdC}void\${SEDdD} -\${SEDuA}RETSIGTYPE\${SEDuB}RETSIGTYPE\${SEDuC}void\${SEDuD} -\${SEDeA}RETSIGTYPE\${SEDeB}RETSIGTYPE\${SEDeC}void\${SEDeD} -" -} - - -else - rm -rf conftest* - -{ -test -n "$verbose" && \ -echo " defining" RETSIGTYPE to be int -echo "#define" RETSIGTYPE int >> confdefs.h -DEFS="$DEFS -DRETSIGTYPE=int" -SEDDEFS="${SEDDEFS}\${SEDdA}RETSIGTYPE\${SEDdB}RETSIGTYPE\${SEDdC}int\${SEDdD} -\${SEDuA}RETSIGTYPE\${SEDuB}RETSIGTYPE\${SEDuC}int\${SEDuD} -\${SEDeA}RETSIGTYPE\${SEDeB}RETSIGTYPE\${SEDeC}int\${SEDeD} -" -} - -fi -rm -f conftest* - - -prog='/* Ultrix mips cc rejects this. */ -typedef int charset[2]; const charset x; -/* SunOS 4.1.1 cc rejects this. */ -char const *const *ccp; -char **p; -/* AIX XL C 1.02.0.0 rejects this. - It does not let you subtract one const X* pointer from another in an arm - of an if-expression whose if-part is not a constant expression */ -const char *g = "string"; -ccp = &g + (g ? g-g : 0); -/* HPUX 7.0 cc rejects these. */ -++ccp; -p = (char**) ccp; -ccp = (char const *const *) p; -{ /* SCO 3.2v4 cc rejects this. */ - char *t; - char const *s = 0 ? (char *) 0 : (char const *) 0; - - *t++ = 0; -} -{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */ - int x[] = {25,17}; - const int *foo = &x[0]; - ++foo; -} -{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */ - typedef const int *iptr; - iptr p = 0; - ++p; -} -{ /* AIX XL C 1.02.0.0 rejects this saying - "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ - struct s { int j; const int *ap[3]; }; - struct s *b; b->j = 5; -} -{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ - const int foo = 10; -}' -echo checking for lack of working const -cat > conftest.c <<EOF -#include "confdefs.h" - -int main() { exit(0); } -int t() { $prog } -EOF -if eval $compile; then - : -else - rm -rf conftest* - -{ -test -n "$verbose" && \ -echo " defining" const to be empty -echo "#define" const >> confdefs.h -DEFS="$DEFS -Dconst=" -SEDDEFS="${SEDDEFS}\${SEDdA}const\${SEDdB}const\${SEDdC}\${SEDdD} -\${SEDuA}const\${SEDuB}const\${SEDuC}\${SEDuD} -\${SEDeA}const\${SEDeB}const\${SEDeC}\${SEDeD} -" -} - -fi -rm -f conftest* - -echo checking whether $CC and cc understand -c and -o together -echo 'foo(){}' > conftest.c -# Make sure it works both with $CC and with simple cc. -# We do the test twice because some compilers refuse to overwrite an -# existing .o file with -o, though they will create one. -if ${CC-cc} -c conftest.c -o conftest.o >/dev/null 2>&1 \ - && test -f conftest.o && ${CC-cc} -c conftest.c -o conftest.o >/dev/null 2>&1 -then - # Test first that cc exists at all. - if cc -c conftest.c >/dev/null 2>&1 - then - if cc -c conftest.c -o conftest2.o >/dev/null 2>&1 && \ - test -f conftest2.o && cc -c conftest.c -o conftest2.o >/dev/null 2>&1 - then - : - else - -{ -test -n "$verbose" && \ -echo " defining NO_MINUS_C_MINUS_O" -echo "#define" NO_MINUS_C_MINUS_O 1 >> confdefs.h -DEFS="$DEFS -DNO_MINUS_C_MINUS_O=1" -SEDDEFS="${SEDDEFS}\${SEDdA}NO_MINUS_C_MINUS_O\${SEDdB}NO_MINUS_C_MINUS_O\${SEDdC}1\${SEDdD} -\${SEDuA}NO_MINUS_C_MINUS_O\${SEDuB}NO_MINUS_C_MINUS_O\${SEDuC}1\${SEDuD} -\${SEDeA}NO_MINUS_C_MINUS_O\${SEDeB}NO_MINUS_C_MINUS_O\${SEDeC}1\${SEDeD} -" -} - - fi - fi -else - -{ -test -n "$verbose" && \ -echo " defining NO_MINUS_C_MINUS_O" -echo "#define" NO_MINUS_C_MINUS_O 1 >> confdefs.h -DEFS="$DEFS -DNO_MINUS_C_MINUS_O=1" -SEDDEFS="${SEDDEFS}\${SEDdA}NO_MINUS_C_MINUS_O\${SEDdB}NO_MINUS_C_MINUS_O\${SEDdC}1\${SEDdD} -\${SEDuA}NO_MINUS_C_MINUS_O\${SEDuB}NO_MINUS_C_MINUS_O\${SEDuC}1\${SEDuD} -\${SEDeA}NO_MINUS_C_MINUS_O\${SEDeB}NO_MINUS_C_MINUS_O\${SEDeC}1\${SEDeD} -" -} - -fi -rm -f conftest* - - - - -# Set default prefixes. -if test -n "$prefix"; then - test -z "$exec_prefix" && exec_prefix='${prefix}' - prsub="s%^prefix\\([ ]*\\)=\\([ ]*\\).*$%prefix\\1=\\2$prefix%" -fi -if test -n "$exec_prefix"; then - prsub="$prsub -s%^exec_prefix\\([ ]*\\)=\\([ ]*\\).*$%exec_prefix\\1=\\2$exec_prefix%" -fi -# Quote sed substitution magic chars in DEFS. -cat >conftest.def <<EOF -$DEFS -EOF -escape_ampersand_and_backslash='s%[&\\]%\\&%g' -DEFS=`sed "$escape_ampersand_and_backslash" <conftest.def` -rm -f conftest.def -# Substitute for predefined variables. - -trap 'rm -f config.status; exit 1' 1 3 15 -echo creating config.status -rm -f config.status -cat > config.status <<EOF -#!/bin/sh -# Generated automatically by configure. -# Run this file to recreate the current configuration. -# This directory was configured as follows, -# on host `(hostname || uname -n) 2>/dev/null | sed 1q`: -# -# $0 $configure_args - -for arg -do - case "\$arg" in - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - echo running \${CONFIG_SHELL-/bin/sh} $0 $configure_args - exec \${CONFIG_SHELL-/bin/sh} $0 $configure_args ;; - *) echo "Usage: config.status --recheck" 2>&1; exit 1 ;; - esac -done - -trap 'rm -fr Makefile scmconfig.h conftest*; exit 1' 1 3 15 -CFLAGS='$CFLAGS' -LDFLAGS='$LDFLAGS' -CC='$CC' -INSTALL='$INSTALL' -INSTALL_PROGRAM='$INSTALL_PROGRAM' -INSTALL_DATA='$INSTALL_DATA' -CPP='$CPP' -RANLIB='$RANLIB' -LIBOBJS='$LIBOBJS' -LIBS='$LIBS' -srcdir='$srcdir' -prefix='$prefix' -exec_prefix='$exec_prefix' -prsub='$prsub' -extrasub='$extrasub' -EOF -cat >> config.status <<\EOF - -top_srcdir=$srcdir - -CONFIG_FILES=${CONFIG_FILES-"Makefile"} -for file in .. ${CONFIG_FILES}; do if test "x$file" != x..; then - srcdir=$top_srcdir - # Remove last slash and all that follows it. Not all systems have dirname. - dir=`echo $file|sed 's%/[^/][^/]*$%%'` - if test "$dir" != "$file"; then - test "$top_srcdir" != . && srcdir=$top_srcdir/$dir - test ! -d $dir && mkdir $dir - fi - echo creating $file - rm -f $file - echo "# Generated automatically from `echo $file|sed 's|.*/||'`.in by configure." > $file - sed -e " -$prsub -$extrasub -s%@CFLAGS@%$CFLAGS%g -s%@LDFLAGS@%$LDFLAGS%g -s%@CC@%$CC%g -s%@INSTALL@%$INSTALL%g -s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g -s%@INSTALL_DATA@%$INSTALL_DATA%g -s%@CPP@%$CPP%g -s%@RANLIB@%$RANLIB%g -s%@LIBOBJS@%$LIBOBJS%g -s%@LIBS@%$LIBS%g -s%@srcdir@%$srcdir%g -s%@DEFS@%-DHAVE_CONFIG_H%" $top_srcdir/${file}.in >> $file -fi; done - -CONFIG_HEADERS=${CONFIG_HEADERS-"scmconfig.h"} -for file in .. ${CONFIG_HEADERS}; do if test "x$file" != x..; then -echo creating $file - -# These sed commands are put into SEDDEFS when defining a macro. -# They are broken into pieces to make the sed script easier to manage. -# They are passed to sed as "A NAME B NAME C VALUE D", where NAME -# is the cpp macro being defined and VALUE is the value it is being given. -# Each defining turns into a single global substitution command. -# -# SEDd sets the value in "#define NAME VALUE" lines. -SEDdA='s@^\([ ]*\)#\([ ]*define[ ][ ]*\)' -SEDdB='\([ ][ ]*\)[^ ]*@\1#\2' -SEDdC='\3' -SEDdD='@g' -# SEDu turns "#undef NAME" with trailing blanks into "#define NAME VALUE". -SEDuA='s@^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' -SEDuB='\([ ]\)@\1#\2define\3' -SEDuC=' ' -SEDuD='\4@g' -# SEDe turns "#undef NAME" without trailing blanks into "#define NAME VALUE". -SEDeA='s@^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' -SEDeB='$@\1#\2define\3' -SEDeC=' ' -SEDeD='@g' -rm -f conftest.sed -EOF -# Turn off quoting long enough to insert the sed commands. -rm -f conftest.sh -cat > conftest.sh <<EOF -$SEDDEFS -EOF - -# Break up $SEDDEFS (now in conftest.sh) because some shells have a limit -# on the size of here documents. - -# Maximum number of lines to put in a single here document. -maxshlines=9 - -while : -do - # wc gives bogus results for an empty file on some systems. - lines=`grep -c . conftest.sh` - if test -z "$lines" || test "$lines" -eq 0; then break; fi - rm -f conftest.s1 conftest.s2 - sed ${maxshlines}q conftest.sh > conftest.s1 # Like head -20. - sed 1,${maxshlines}d conftest.sh > conftest.s2 # Like tail +21. - # Write a limited-size here document to append to conftest.sed. - echo 'cat >> conftest.sed <<CONFEOF' >> config.status - cat conftest.s1 >> config.status - echo 'CONFEOF' >> config.status - rm -f conftest.s1 conftest.sh - mv conftest.s2 conftest.sh -done -rm -f conftest.sh - -# Now back to your regularly scheduled config.status. -cat >> config.status <<\EOF -# This sed command replaces #undef's with comments. This is necessary, for -# example, in the case of _POSIX_SOURCE, which is predefined and required -# on some systems where configure will not decide to define it in -# scmconfig.h. -cat >> conftest.sed <<\CONFEOF -s,^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */, -CONFEOF -rm -f conftest.h -# Break up the sed commands because old seds have small limits. -maxsedlines=20 -cp $top_srcdir/$file.in conftest.h1 -while : -do - lines=`grep -c . conftest.sed` - if test -z "$lines" || test "$lines" -eq 0; then break; fi - rm -f conftest.s1 conftest.s2 conftest.h2 - sed ${maxsedlines}q conftest.sed > conftest.s1 # Like head -20. - sed 1,${maxsedlines}d conftest.sed > conftest.s2 # Like tail +21. - sed -f conftest.s1 < conftest.h1 > conftest.h2 - rm -f conftest.s1 conftest.h1 conftest.sed - mv conftest.h2 conftest.h1 - mv conftest.s2 conftest.sed -done -rm -f conftest.sed conftest.h -echo "/* $file. Generated automatically by configure. */" > conftest.h -cat conftest.h1 >> conftest.h -rm -f conftest.h1 -if cmp -s $file conftest.h 2>/dev/null; then - # The file exists and we would not be changing it. - echo "$file is unchanged" - rm -f conftest.h -else - rm -f $file - mv conftest.h $file -fi -fi; done - - - -exit 0 -EOF -chmod +x config.status -${CONFIG_SHELL-/bin/sh} config.status - - diff --git a/configure.in b/configure.in deleted file mode 100644 index 76c60ad..0000000 --- a/configure.in +++ /dev/null @@ -1,33 +0,0 @@ -dnl Process this file with autoconf to produce a configure script. -AC_INIT(scl.c) -AC_CONFIG_HEADER(scmconfig.h) - -test -z "$CFLAGS" && CFLAGS=-g AC_SUBST(CFLAGS) -test -z "$LDFLAGS" && LDFLAGS=-g AC_SUBST(LDFLAGS) - -AC_PROG_CC -AC_PROG_INSTALL -AC_PROG_CPP -AC_PROG_RANLIB -AC_AIX -AC_ISC_POSIX -AC_MINIX -AC_STDC_HEADERS -AC_HAVE_HEADERS(unistd.h string.h memory.h limits.h time.h sys/types.h sys/time.h sys/timeb.h sys/times.h) -AC_TIME_WITH_SYS_TIME -AC_HAVE_FUNCS(ftime times getcwd) -AC_RETSIGTYPE -AC_CONST -AC_MINUS_C_MINUS_O -dnl AC_PREFIX(scm) - -AC_SUBST(LIBOBJS) - -AC_OUTPUT(Makefile) - -dnl Local Variables: -dnl comment-start: "dnl " -dnl comment-end: "" -dnl comment-start-skip: "\\bdnl\\b\\s *" -dnl compile-command: "make configure scmconfig.h.in" -dnl End: @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -54,7 +54,7 @@ #endif /* For platforms with short integers, we use thrown_value instead of - the value returned from setjmp so that any (long) value can be + the value returned from setjump so that any (long) value can be returned. */ #ifdef SHORT_INT @@ -81,7 +81,7 @@ long stack_size(start) CONTINUATION near the current extent of stack. This newly allocated CONTINUATION is returned if successful, 0 if not. After make_root_continuation() returns, the calling routine still needs - to `setjmp(new_continuation->jmpbuf)' in order to complete the + to `setjump(new_continuation->jmpbuf)' in order to complete the capture of this continuation. */ CONTINUATION *make_root_continuation(stack_base) @@ -101,7 +101,7 @@ CONTINUATION *make_root_continuation(stack_base) to the current top of stack. The newly allocated CONTINUATION is returned if successful, 0 if not. After make_continuation() returns, the calling routine still needs to - `setjmp(new_continuation->jmpbuf)' in order to complete the capture + `setjump(new_continuation->jmpbuf)' in order to complete the capture of this continuation. */ /* Note: allocating local (stack) storage for the CONTINUATION would @@ -150,7 +150,7 @@ void free_continuation(cont) /* Final routine involved in throw()ing to a continuation. After ensuring that there is sufficient room on the stack for the saved continuation, dynthrow() copies the continuation onto the stack and - longjmp()s into it. The routine does not return. */ + longjump()s into it. The routine does not return. */ /* If you use conservative GC and your Sparc(SUN-4) heap is growing out of control: @@ -174,6 +174,9 @@ void free_continuation(cont) Let me know if you try it. */ +/* SCM_GROWTH is how many `long's to grow the stack by when we need room. */ +#define SCM_GROWTH 100 + void dynthrow(a) long *a; { @@ -183,13 +186,13 @@ void dynthrow(a) register long j; register STACKITEM *src, *dst = cont->stkbse; # ifdef STACK_GROWS_UP - if (a[2] && (a - ((long *)a[3]) < 100)) - puts("grow_throw: check if long growth[100]; being optimized out"); + if (a[2] && (a - ((long *)a[3]) < SCM_GROWTH)) + puts("grow_throw: check if long growth[]; being optimized out"); /* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */ if PTR_GE(dst + (cont->length), (STACKITEM *)&a) grow_throw(a); # else - if (a[2] && (((long *)a[3]) - a < 100)) - puts("grow_throw: check if long growth[100]; being optimized out"); + if (a[2] && (((long *)a[3]) - a < SCM_GROWTH)) + puts("grow_throw: check if long growth[]; being optimized out"); /* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */ dst -= cont->length; if PTR_LE(dst, (STACKITEM *)&a) grow_throw(a); @@ -200,15 +203,15 @@ void dynthrow(a) #endif /* ndef CHEAP_CONTINUATIONS */ #ifdef SHORT_INT thrown_value = val; - longjmp(cont->jmpbuf, 1); + longjump(cont->jmpbuf, 1); #else - longjmp(cont->jmpbuf, val); + longjump(cont->jmpbuf, val); #endif } -/* grow_throw() grows the stack by 100 long words. If the "sizeof - growth" assignment is not sufficient to restrain your overly - optimistic compiler, the stack will grow by much less and +/* grow_throw() grows the stack by SCM_GROWTH long words. If the + "sizeof growth" assignment is not sufficient to restrain your + overly optimistic compiler, the stack will grow by much less and grow_throw() and dynthrow() will waste time calling each other. To fix this you will have to compile grow_throw() in a separate file so the compiler won't be able to guess that the growth array isn't @@ -218,12 +221,12 @@ void dynthrow(a) void grow_throw(a) /* Grow the stack so that there is room */ long *a; /* to copy in the continuation. Then */ { /* retry the throw. */ - long growth[100]; + long growth[SCM_GROWTH]; growth[0] = a[0]; growth[1] = a[1]; growth[2] = a[2] + 1; growth[3] = (long) a; - growth[99] = sizeof growth; + growth[SCM_GROWTH-1] = sizeof growth; dynthrow(growth); } #endif /* ndef CHEAP_CONTINUATIONS */ @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -42,30 +42,33 @@ /* "continue.h" Scheme Continuations for C. Author: Aubrey Jaffer. */ -#ifdef vms +#ifdef vax # ifndef CHEAP_CONTINUATIONS - typedef int jmp_buf[17]; - extern int setjump(jmp_buf env); - extern int longjump(jmp_buf env, int ret); + typedef int jump_buf[17]; + extern int setjump(jump_buf env); + extern int longjump(jump_buf env, int ret); -# define setjmp setjump -# define longjmp longjump # else # include <setjmp.h> +# define jump_buf jmp_buf +# define setjump setjmp +# define longjump longjmp # endif -#else /* ndef vms */ +#else /* ndef vax */ # ifdef _CRAY1 - typedef int jmp_buf[112]; - extern int setjump(jmp_buf env); - extern int longjump(jmp_buf env, int ret); -# define setjmp setjump -# define longjmp longjump + typedef int jump_buf[112]; + extern int setjump(jump_buf env); + extern int longjump(jump_buf env, int ret); + # else /* ndef _CRAY1 */ # include <setjmp.h> +# define jump_buf jmp_buf +# define setjump setjmp +# define longjump longjmp # endif /* ndef _CRAY1 */ -#endif /* ndef vms */ +#endif /* ndef vax */ /* `other' is a CONTINUATION slot for miscellaneous data of type CONTINUATION_OTHER. */ @@ -93,7 +96,7 @@ typedef short STACKITEM; typedef long STACKITEM; #endif -struct Continuation {jmp_buf jmpbuf; +struct Continuation {jump_buf jmpbuf; long thrwval; long length; STACKITEM *stkbse; @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -156,8 +156,7 @@ static iproc subr1s[] = { void init_dynl() { # ifndef RTL - if (!execpath) execpath = dld_find_executable(CHARS(CAR(progargs))); - if (dld_init(execpath)) { + if ((!execpath) || dld_init(execpath)) { dld_perror("DLD:"); /* wta(CAR(progargs), "couldn't init", "dld"); */ return; @@ -420,6 +419,35 @@ SCM l_dyn_call(symb, shl) /* *loc_loadpath = oloadpath; */ return BOOL_T; } +static char s_main_call[] = "dyn:main-call"; +SCM l_dyn_main_call(symb, shl, args) + SCM symb, shl, args; +{ + int i; + int (*func)P((int argc, char **argv)) = 0; + char **argv; +/* SCM oloadpath = *loc_loadpath; */ + ASSERT(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); + ASSERT(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); + DEFER_INTS; + func = dlsym(SHL(shl), CHARS(symb)); + if (!func) { + const char *dlr = dlerror(); + ALLOW_INTS; + if (dlr) puts(dlr); + return BOOL_F; + } + argv = makargvfrmstrs(args, s_main_call); + ALLOW_INTS; +/* *loc_loadpath = linkpath; */ + i = (*func) ((int)ilength(args), argv); +/* *loc_loadpath = oloadpath; */ + DEFER_INTS; + must_free_argv(argv); + ALLOW_INTS; + return MAKINUM(0L+i); +} + static char s_unlink[] = "dyn:unlink"; SCM l_dyn_unlink(shl) SCM shl; @@ -443,6 +471,7 @@ void init_dynl() tc16_shl = newsmob(&shlsmob); init_iprocs(subr1s, tc7_subr_1); make_subr(s_call, tc7_subr_2, l_dyn_call); + make_subr(s_main_call, tc7_lsubr_2, l_dyn_main_call); add_feature("sun-dl"); } #endif /* SUN_DL */ @@ -596,9 +596,19 @@ asm (" add %o1, %o2, %o2"); asm (" sethi %hi(_environ), %o3"); asm (" st %o2, [%o3+%lo(_environ)]"); asm (" andn %sp, 7, %sp"); +/* added by Denys Duchier */ +#ifdef __svr4__ +asm (" call main"); +#else asm (" call _main"); +#endif asm (" sub %sp, 24, %sp"); +/* added by Denys Duchier */ +#ifdef __svr4__ +asm (" call _exit"); +#else asm (" call __exit"); +#endif asm (" nop"); #endif /* sparc */ @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -47,17 +47,36 @@ #define I_SYM(x) (CAR((x)-1L)) #define I_VAL(x) (CDR((x)-1L)) -#define EVALCELLCAR(x, env) SYMBOLP(CAR(x))?*lookupcar(x, env):ceval(CAR(x), env) -#ifdef MEMOIZE_LOCALS -# define EVALIMP(x, env) (ILOCP(x)?*ilookup((x), env):x) +#ifdef MACRO +# define ATOMP(x) (5==(5 & (int)CAR(x))) +# define EVALCELLCAR(x,env) (ATOMP(CAR(x))?evalatomcar(x,env):ceval(CAR(x),env)) #else -# define EVALIMP(x, env) x +# define EVALCELLCAR(x, env) SYMBOLP(CAR(x))?*lookupcar(x, env):ceval(CAR(x), env) #endif + +#define EVALIMP(x, env) (ILOCP(x)?*ilookup((x), env):x) #define EVALCAR(x, env) (NCELLP(CAR(x))?(IMP(CAR(x))?EVALIMP(CAR(x), env):\ I_VAL(CAR(x))):EVALCELLCAR(x, env)) #define EXTEND_ENV acons -#ifdef MEMOIZE_LOCALS +long tc16_macro; /* Type code for macros */ +#define MACROP(x) (tc16_macro==TYP16(x)) + +#ifdef MACRO +long tc16_ident; /* synthetic macro identifier */ +SCM i_mark; +static char s_escaped[] = "escaped synthetic identifier"; +# define M_IDENTP(x) (tc16_ident==TYP16(x)) +# define M_IDENT_LEXP(x) ((tc16_ident | (1L<<16))==CAR(x)) +# define IDENTP(x) (SYMBOLP(x) || M_IDENTP(x)) +# define IDENT_LEXP (1L<<16) +# define IDENT_PARENT(x) (M_IDENT_LEXP(x) ? CAR(CDR(x)) : CDR(x)) +# define IDENT_MARK(x) (M_IDENT_LEXP(x) ? CDR(CDR(x)) : BOOL_F) +# define ENV_MARK BOOL_T +#else +# define IDENTP SYMBOLP +#endif + SCM *ilookup(iloc, env) SCM iloc, env; { @@ -69,56 +88,89 @@ SCM *ilookup(iloc, env) if ICDRP(iloc) return &CDR(er); return &CAR(CDR(er)); } -#endif + +SCM *farlookup(farloc, env) + SCM farloc, env; +{ + register int ir; + register SCM er = env; + SCM x = CDR(farloc); + for (ir = INUM(CAR(x)); 0 != ir; --ir) er = CDR(er); + er = CAR(er); + for (ir = INUM(CDR(x)); 0 != ir; --ir) er = CDR(er); + if (IM_FARLOC_CDR==CAR(farloc)) return &CDR(er); + return &CAR(CDR(er)); +} + SCM *lookupcar(vloc, genv) SCM vloc, genv; { SCM env = genv; register SCM *al, fl, var = CAR(vloc); -#ifdef MEMOIZE_LOCALS - register SCM iloc = ILOC00; + register unsigned int idist, iframe = 0; +#ifdef MACRO + SCM mark = IDENT_MARK(var); #endif - for(;NIMP(env);env = CDR(env)) { + for(; NIMP(env); env = CDR(env)) { + idist = 0; al = &CAR(env); for(fl = CAR(*al);NIMP(fl);fl = CDR(fl)) { +#ifdef MACRO + if (fl==mark) { + var = IDENT_PARENT(var); + mark = IDENT_MARK(var); + } +#endif if NCONSP(fl) if (fl==var) { -#ifdef MEMOIZE_LOCALS - CAR(vloc) = iloc + ICDR; +#ifndef TEST_FARLOC + if (iframe < 4096 && idist < (1L<<(LONG_BIT-20))) + CAR(vloc) = MAKILOC(iframe, idist) + ICDR; + else #endif + CAR(vloc) = cons2(IM_FARLOC_CDR, MAKINUM(iframe), MAKINUM(idist)); return &CDR(*al); } else break; al = &CDR(*al); if (CAR(fl)==var) { -#ifdef MEMOIZE_LOCALS -# ifndef RECKLESS /* letrec inits to UNDEFINED */ +#ifndef RECKLESS /* letrec inits to UNDEFINED */ if UNBNDP(CAR(*al)) {env = EOL; goto errout;} -# endif - CAR(vloc) = iloc; #endif +#ifndef TEST_FARLOC + if (iframe < 4096 && idist < (1L<<(LONG_BIT-20))) + CAR(vloc) = MAKILOC(iframe, idist); + else +#endif + CAR(vloc) = cons2(IM_FARLOC_CAR, MAKINUM(iframe), MAKINUM(idist)); return &CAR(*al); } -#ifdef MEMOIZE_LOCALS - iloc += IDINC; -#endif + idist++; } -#ifdef MEMOIZE_LOCALS - iloc = (~IDSTMSK) & (iloc + IFRINC); -#endif + iframe++; + } +#ifdef MACRO + while M_IDENTP(var) { + ASRTGO(IMP(IDENT_MARK(var)), errout); + var = IDENT_PARENT(var); } +#endif var = sym2vcell(var); #ifndef RECKLESS if (NNULLP(env) || UNBNDP(CDR(var))) { var = CAR(var); errout: everr(vloc, genv, var, - NULLP(env)?"unbound variable: ":"damaged environment", ""); +# ifdef MACRO + M_IDENTP(var) ? s_escaped : +# endif + (NULLP(env) ? "unbound variable: " : "damaged environment"), ""); } #endif CAR(vloc) = var + 1; return &CDR(var); } + static SCM unmemocar(form, env) SCM form, env; { @@ -126,17 +178,48 @@ static SCM unmemocar(form, env) if IMP(form) return form; if (1==TYP3(form)) CAR(form) = I_SYM(CAR(form)); -#ifdef MEMOIZE_LOCALS else if ILOCP(CAR(form)) { for(ir = IFRAME(CAR(form)); ir != 0; --ir) env = CDR(env); env = CAR(CAR(env)); for(ir = IDIST(CAR(form));ir != 0;--ir) env = CDR(env); CAR(form) = ICDRP(CAR(form)) ? env : CAR(env); } -#endif return form; } +#ifdef MACRO +/* CAR(x) is known to be a cell but not a cons */ +static char s_badkey[] = "Use of keyword as variable"; +static SCM evalatomcar(x, env) + SCM x, env; +{ + SCM r; + switch TYP7(CAR(x)) { + default: + everr(x, env, CAR(x), "Cannot evaluate: ", ""); + case tcs_symbols: + lookup: + r = *lookupcar(x, env); +# ifndef RECKLESS + if (NIMP(r) && MACROP(r)) { + x = cons(CAR(x), CDR(x)); + unmemocar(x, env); + everr(x, env, CAR(x), s_badkey, ""); + } +# endif + return r; + case tc7_vector: + case tc7_string: + case tc7_bvect: case tc7_ivect: case tc7_uvect: + case tc7_fvect: case tc7_dvect: case tc7_cvect: + return CAR(x); + case tc7_smob: + if M_IDENTP(CAR(x)) goto lookup; + return CAR(x); + } +} +#endif /* def MACRO */ + SCM eval_args(l, env) SCM l, env; { @@ -163,10 +246,65 @@ static char s_formals[] = "bad formals"; SCM i_dot, i_quote, i_quasiquote, i_lambda, i_let, i_arrow, i_else, i_unquote, i_uq_splicing, i_apply; -static char s_quasiquote[] = "quasiquote"; -static char s_delay[] = "delay"; #define ASRTSYNTAX(cond_, msg_) if(!(cond_))wta(xorig, (msg_), what); +#ifdef MACRO +SCM rename_ident P((SCM id, SCM env)); +# define TOPDENOTE_EQ(sym, x, env) ((sym)==ident2sym(x) && TOPLEVELP(x,env)) +# define TOPLEVELP(x,env) (0==id_denote(x,env)) +# define TOPRENAME(v) (renamed_ident(v, BOOL_F)) + +static SCM ident2sym(id) + SCM id; +{ + if NIMP(id) + while M_IDENTP(id) + id = IDENT_PARENT(id); + return id; +} + +static SCM *id_denote(var, env) + SCM var, env; +{ + register SCM *al, fl; + SCM mark = IDENT_MARK(var); + for(;NIMP(env); env = CDR(env)) { + al = &CAR(env); + for(fl = CAR(*al);NIMP(fl);fl = CDR(fl)) { + if (fl==mark) { + var = IDENT_PARENT(var); + mark = IDENT_MARK(var); + } + if NCONSP(fl) + if (fl==var) return &CDR(*al); + else break; + al = &CDR(*al); + if (CAR(fl)==var) return &CAR(*al); + } + } + return (SCM *)0; +} + +static void unpaint(p) + SCM *p; +{ + SCM x; + while NIMP((x = *p)) { + if CONSP(x) { + if NIMP(CAR(x)) unpaint(&CAR(x)); + p = &CDR(*p); + } + else { + while M_IDENTP(x) *p = x = IDENT_PARENT(x); + return; + } + } +} +#else /* def MACRO */ +# define TOPDENOTE_EQ(sym, x, env) ((sym)==(x)) +# define TOPLEVELP(x,env) (!0) +# define TOPRENAME(v) (v) +#endif static void bodycheck(xorig, bodyloc, what) SCM xorig, *bodyloc; @@ -179,6 +317,11 @@ SCM m_quote(xorig, env) SCM xorig, env; { ASSYNT(ilength(CDR(xorig))==1, xorig, s_expression, s_quote); +#ifdef MACRO + DEFER_INTS; + unpaint(&CAR(CDR(xorig))); + ALLOW_INTS; +#endif return cons(IM_QUOTE, CDR(xorig)); } @@ -202,7 +345,7 @@ SCM m_set(xorig, env) { SCM x = CDR(xorig); ASSYNT(2==ilength(x), xorig, s_expression, s_set); - ASSYNT(NIMP(CAR(x)) && SYMBOLP(CAR(x)), + ASSYNT(NIMP(CAR(x)) && IDENTP(CAR(x)), xorig, s_variable, s_set); return cons(IM_SET, x); } @@ -233,8 +376,16 @@ SCM m_case(xorig, env) while(NIMP(x = CDR(x))) { proc = CAR(x); ASSYNT(ilength(proc) >= 2, xorig, s_clauses, s_case); - ASSYNT(ilength(CAR(proc)) >= 0 || i_else==CAR(proc), - xorig, s_clauses, s_case); + if TOPDENOTE_EQ(i_else, CAR(proc), env) + CAR(proc) = IM_ELSE; + else { + ASSYNT(ilength(CAR(proc)) >= 0, xorig, s_clauses, s_case); +#ifdef MACRO + DEFER_INTS; + unpaint(&CAR(proc)); + ALLOW_INTS; +#endif + } } return cons(IM_CASE, CDR(xorig)); } @@ -249,13 +400,15 @@ SCM m_cond(xorig, env) arg1 = CAR(x); len = ilength(arg1); ASSYNT(len >= 1, xorig, s_clauses, s_cond); - if (i_else==CAR(arg1)) { + if TOPDENOTE_EQ(i_else, CAR(arg1), env) { ASSYNT(NULLP(CDR(x)) && len >= 2, xorig, "bad ELSE clause", s_cond); CAR(arg1) = BOOL_T; } - if (len >= 2 && i_arrow==CAR(CDR(arg1))) - ASSYNT(3==len && NIMP(CAR(CDR(CDR(arg1)))), - xorig, "bad recipient", s_cond); + arg1 = CDR(arg1); + if (len >= 2 && TOPDENOTE_EQ(i_arrow, CAR(arg1), env)) { + ASSYNT(3==len && NIMP(CAR(CDR(arg1))), xorig, "bad recipient", s_cond); + CAR(arg1) = IM_ARROW; + } x = CDR(x); } return cons(IM_COND, CDR(xorig)); @@ -269,13 +422,13 @@ SCM m_lambda(xorig, env) proc = CAR(x); if NULLP(proc) goto memlambda; if IMP(proc) goto badforms; - if SYMBOLP(proc) goto memlambda; + if IDENTP(proc) goto memlambda; if NCONSP(proc) goto badforms; while NIMP(proc) { if NCONSP(proc) - if (!SYMBOLP(proc)) goto badforms; + if (!IDENTP(proc)) goto badforms; else goto memlambda; - if (!(NIMP(CAR(proc)) && SYMBOLP(CAR(proc)))) goto badforms; + if (!(NIMP(CAR(proc)) && IDENTP(CAR(proc)))) goto badforms; proc = CDR(proc); } if NNULLP(proc) @@ -295,7 +448,7 @@ SCM m_letstar(xorig, env) while NIMP(proc) { arg1 = CAR(proc); ASSYNT(2==ilength(arg1), xorig, s_bindings, s_letstar); - ASSYNT(NIMP(CAR(arg1)) && SYMBOLP(CAR(arg1)), xorig, s_variable, s_letstar); + ASSYNT(NIMP(CAR(arg1)) && IDENTP(CAR(arg1)), xorig, s_variable, s_letstar); *varloc = cons2(CAR(arg1), CAR(CDR(arg1)), EOL); varloc = &CDR(CDR(*varloc)); proc = CDR(proc); @@ -332,7 +485,7 @@ SCM m_do(xorig, env) arg1 = CAR(proc); len = ilength(arg1); ASSYNT(2==len || 3==len, xorig, s_bindings, s_do); - ASSYNT(NIMP(CAR(arg1)) && SYMBOLP(CAR(arg1)), xorig, s_variable, s_do); + ASSYNT(NIMP(CAR(arg1)) && IDENTP(CAR(arg1)), xorig, s_variable, s_do); /* vars reversed here, inits and steps reversed at evaluation */ vars = cons(CAR(arg1), vars); /* variable */ arg1 = CDR(arg1); @@ -358,59 +511,109 @@ static SCM evalcar(x, env) return EVALCAR(x, env); } -static SCM iqq(form, env, depth) +/* Here are acros which return values rather than code. */ + +static SCM iqq(form, env) SCM form, env; - int depth; { SCM tmp; - int edepth = depth; if IMP(form) return form; if VECTORP(form) { long i = LENGTH(form); SCM *data = VELTS(form); tmp = EOL; for(;--i >= 0;) tmp = cons(data[i], tmp); - return vector(iqq(tmp, env, depth)); + return vector(iqq(tmp, env)); } if NCONSP(form) return form; tmp = CAR(form); - if (i_quasiquote==tmp) { - depth++; - goto label; + if (IM_UNQUOTE==tmp) + return evalcar(CDR(form), env); + if (NIMP(tmp) && IM_UQ_SPLICING==CAR(tmp)) + return append(cons2(evalcar(CDR(tmp),env), iqq(CDR(form),env), EOL)); + return cons(iqq(CAR(form),env), iqq(CDR(form),env)); +} + +static SCM m_iqq(form, depth, env) + SCM form, env; + int depth; +{ + SCM tmp; + int edepth = depth; + if IMP(form) return form; + if VECTORP(form) { + long i = LENGTH(form); + SCM *data = VELTS(form); + tmp = EOL; + ALLOW_INTS; + for(;--i >= 0;) tmp = cons(data[i], tmp); + DEFER_INTS; + tmp = m_iqq(tmp, depth, env); + for(i = 0; i < LENGTH(form); i++) { + data[i] = CAR(tmp); + tmp = CDR(tmp); + } + return form; } - if (i_unquote==tmp) { - --depth; - label: - form = CDR(form); - ASSERT(NIMP(form) && ECONSP(form) && NULLP(CDR(form)), - form, ARG1, s_quasiquote); - if (0==depth) return evalcar(form, env); - return cons2(tmp, iqq(CAR(form), env, depth), EOL); + if NCONSP(form) { +#ifdef MACRO + while M_IDENTP(form) form = IDENT_PARENT(form); +#endif + return form; } - if (NIMP(tmp) && (i_uq_splicing==CAR(tmp))) { - tmp = CDR(tmp); - if (0==--edepth) - return append(cons2(evalcar(tmp, env), iqq(CDR(form), env, depth), EOL)); + tmp = CAR(form); + if NIMP(tmp) { + if IDENTP(tmp) { +#ifdef MACRO + while M_IDENTP(tmp) tmp = IDENT_PARENT(tmp); +#endif + if (i_quasiquote==tmp && TOPLEVELP(CAR(form), env)) { + depth++; + if (0==depth) CAR(form) = IM_QUASIQUOTE; + goto label; + } + if (i_unquote==tmp && TOPLEVELP(CAR(form), env)) { + --depth; + if (0==depth) CAR(form) = IM_UNQUOTE; + label: + tmp = CDR(form); + ASSERT(NIMP(tmp) && ECONSP(tmp) && NULLP(CDR(tmp)), + tmp, ARG1, s_quasiquote); + if (0!=depth) CAR(tmp) = m_iqq(CAR(tmp), depth, env); + return form; + } + } + else { + if TOPDENOTE_EQ(i_uq_splicing, CAR(tmp), env) { + if (0==--edepth) { + CAR(tmp) = IM_UQ_SPLICING; + CDR(form) = m_iqq(CDR(form), depth, env); + return form; + } + } + CAR(form) = m_iqq(tmp, edepth, env); + } } - return cons(iqq(CAR(form), env, edepth), iqq(CDR(form), env, depth)); + CAR(form) = tmp; + CDR(form) = m_iqq(CDR(form), depth, env); + return form; } - -/* Here are acros which return values rather than code. */ - SCM m_quasiquote(xorig, env) SCM xorig, env; { SCM x = CDR(xorig); ASSYNT(ilength(x)==1, xorig, s_expression, s_quasiquote); - return iqq(CAR(x), env, 1); + DEFER_INTS; + x = m_iqq(x, 1, env); + ALLOW_INTS; + return cons(IM_QUASIQUOTE, x); } SCM m_delay(xorig, env) SCM xorig, env; { ASSYNT(ilength(xorig)==2, xorig, s_expression, s_delay); - xorig = CDR(xorig); - return makprom(closure(cons2(EOL, CAR(xorig), CDR(xorig)), env)); + return cons2(IM_DELAY, EOL, CDR(xorig)); } extern int verbose; @@ -422,16 +625,24 @@ SCM m_define(x, env) ASSYNT(ilength(x) >= 2, arg1, s_expression, s_define); proc = CAR(x); x = CDR(x); while (NIMP(proc) && CONSP(proc)) { /* nested define syntax */ - x = cons(cons2(i_lambda, CDR(proc), x), EOL); + x = cons(cons2(TOPRENAME(i_lambda), CDR(proc), x), EOL); proc = CAR(proc); } - ASSYNT(NIMP(proc) && SYMBOLP(proc), arg1, s_variable, s_define); + ASSYNT(NIMP(proc) && IDENTP(proc), arg1, s_variable, s_define); ASSYNT(1==ilength(x), arg1, s_expression, s_define); if NULLP(env) { - x = evalcar(x, env); + x = evalcar(x,env); +#ifdef MACRO + while M_IDENTP(proc) { + ASSYNT(IMP(IDENT_MARK(proc)), proc, s_escaped, s_define); + proc = IDENT_PARENT(proc); + } +#endif arg1 = sym2vcell(proc); #ifndef RECKLESS - if (NIMP(CDR(arg1)) && ((SCM) SNAME(CDR(arg1))==proc) + if (NIMP(CDR(arg1)) && + (proc == + ((SCM) SNAME(MACROP(CDR(arg1)) ? CDR(CDR(arg1)) : CDR(arg1)))) && (CDR(arg1) != x)) warn("redefining built-in ", CHARS(proc)); else @@ -440,12 +651,12 @@ SCM m_define(x, env) warn("redefining ", CHARS(proc)); CDR(arg1) = x; #ifdef SICP - return cons2(i_quote, CAR(arg1), EOL); + return m_quote(cons2(i_quote, CAR(arg1), EOL), EOL); #else return UNSPECIFIED; #endif } - return cons2(IM_DEFINE, proc, x); + return cons2(IM_DEFINE, cons(proc,CAR(CAR(env))), x); } /* end of acros */ @@ -465,7 +676,7 @@ SCM m_letrec(xorig, env) /* vars list reversed here, inits reversed at evaluation */ arg1 = CAR(proc); ASRTSYNTAX(2==ilength(arg1), s_bindings); - ASRTSYNTAX(NIMP(CAR(arg1)) && SYMBOLP(CAR(arg1)), s_variable); + ASRTSYNTAX(NIMP(CAR(arg1)) && IDENTP(CAR(arg1)), s_variable); vars = cons(CAR(arg1), vars); *initloc = cons(CAR(CDR(arg1)), EOL); initloc = &CDR(*initloc); @@ -491,7 +702,7 @@ SCM m_let(xorig, env) ASSYNT(NIMP(proc), xorig, s_bindings, s_let); if CONSP(proc) /* plain let, proc is <bindings> */ return cons(IM_LET, CDR(m_letrec(xorig, env))); - if (!SYMBOLP(proc)) wta(xorig, s_bindings, s_let); /* bad let */ + if (!IDENTP(proc)) wta(xorig, s_bindings, s_let); /* bad let */ name = proc; /* named let, build equiv letrec */ x = CDR(x); ASSYNT(ilength(x) >= 2, xorig, s_body, s_let); @@ -500,7 +711,7 @@ SCM m_let(xorig, env) while NIMP(proc) { /* vars and inits both in order */ arg1 = CAR(proc); ASSYNT(2==ilength(arg1), xorig, s_bindings, s_let); - ASSYNT(NIMP(CAR(arg1)) && SYMBOLP(CAR(arg1)), xorig, s_variable, s_let); + ASSYNT(NIMP(CAR(arg1)) && IDENTP(CAR(arg1)), xorig, s_variable, s_let); *varloc = cons(CAR(arg1), EOL); varloc = &CDR(*varloc); *initloc = cons(CAR(CDR(arg1)), EOL); @@ -509,7 +720,9 @@ SCM m_let(xorig, env) } return m_letrec(cons2(i_let, - cons(cons2(name, cons2(i_lambda, vars, CDR(x)), EOL), EOL), + cons(cons2(name, + cons2(TOPRENAME(i_lambda), vars, CDR(x)), EOL), + EOL), acons(name, inits, EOL)), /* body */ env); } @@ -548,7 +761,6 @@ int badargsp(formals, args) char s_map[] = "map", s_for_each[] = "for-each", s_eval[] = "eval"; SCM eqv P((SCM x, SCM y)); -long tc16_macro; /* Type code for macros */ #ifdef CAUTIOUS static char s_bottom[] = "stacktrace bottommed out"; #endif @@ -591,7 +803,7 @@ SCM ceval(x, env) x = CAR(x); return IMP(x)?EVALIMP(x, env):I_VAL(x); } - if SYMBOLP(CAR(x)) { + if IDENTP(CAR(x)) { retval: return *lookupcar(x, env); } @@ -601,19 +813,22 @@ SCM ceval(x, env) case (127 & IM_CASE): x = CDR(x); t.arg1 = EVALCAR(x, env); +#ifndef INUMS_ONLY + arg2 = (SCM)(IMP(t.arg1) || !NUMP(t.arg1)); +#endif while(NIMP(x = CDR(x))) { proc = CAR(x); - if (i_else==CAR(proc)) { + if (IM_ELSE==CAR(proc)) { x = CDR(proc); goto begin; } proc = CAR(proc); while NIMP(proc) { - if (CAR(proc)==t.arg1 -#ifdef FLOATS - || NFALSEP(eqv(CAR(proc), t.arg1)) + if ( +#ifndef INUMS_ONLY + arg2 ? NFALSEP(eqv(CAR(proc), t.arg1)) : #endif - ) { + (CAR(proc)==t.arg1)) { x = CDR(CAR(x)); goto begin; } @@ -628,7 +843,7 @@ SCM ceval(x, env) if NFALSEP(t.arg1) { x = CDR(proc); if NULLP(x) return t.arg1; - if (i_arrow != CAR(x)) goto begin; + if (IM_ARROW != CAR(x)) goto begin; proc = CDR(x); proc = EVALCAR(proc, env); ASRTGO(NIMP(proc), badfun); @@ -718,16 +933,26 @@ SCM ceval(x, env) proc = CAR(x); switch (7 & (int)proc) { case 0: - t.lloc = lookupcar(x, env); + if CONSP(proc) + t.lloc = farlookup(proc,env); + else { + t.lloc = lookupcar(x,env); +#ifdef MACRO +# ifndef RECKLESS + if (NIMP(*t.lloc) && MACROP(*t.lloc)) { + unmemocar(x,env); + everr(x, env, CAR(x), s_badkey, s_set); + } +# endif +#endif + } break; case 1: t.lloc = &I_VAL(proc); break; -#ifdef MEMOIZE_LOCALS case 4: t.lloc = ilookup(proc, env); break; -#endif } x = CDR(x); *t.lloc = EVALCAR(x, env); @@ -743,7 +968,7 @@ SCM ceval(x, env) x = evalcar(x, env); env = CAR(env); DEFER_INTS; - CAR(env) = cons(proc, CAR(env)); + CAR(env) = proc; CDR(env) = cons(x, CDR(env)); ALLOW_INTS; return UNSPECIFIED; @@ -770,7 +995,7 @@ SCM ceval(x, env) goto evapply; case (ISYMNUM(IM_CONT)): t.arg1 = scm_make_cont(); - if (proc = setjmp(CONT(t.arg1)->jmpbuf)) + if ((proc = setjump(CONT(t.arg1)->jmpbuf))) #ifdef SHORT_INT return (SCM)thrown_value; #else @@ -792,6 +1017,13 @@ SCM ceval(x, env) } #endif goto evap1; + case (ISYMNUM(IM_DELAY)): + return makprom(closure(CDR(x), env)); + case (ISYMNUM(IM_QUASIQUOTE)): + return iqq(CAR(CDR(x)), env); + case (ISYMNUM(IM_FARLOC_CAR)): + case (ISYMNUM(IM_FARLOC_CDR)): + return *farlookup(x, env); default: goto badfun; } @@ -804,18 +1036,22 @@ SCM ceval(x, env) case tc7_fvect: case tc7_dvect: case tc7_cvect: case tc7_string: case tc7_smob: +#ifdef MACRO + if M_IDENTP(x) { + x = cons(x, UNDEFINED); + goto retval; + } +#endif return x; -#ifdef MEMOIZE_LOCALS case (127 & ILOC00): proc = *ilookup(CAR(x), env); ASRTGO(NIMP(proc), badfun); -# ifndef RECKLESS -# ifdef CAUTIOUS +#ifndef RECKLESS +# ifdef CAUTIOUS goto checkargs; -# endif # endif +#endif break; -#endif /* ifdef MEMOIZE_LOCALS */ case tcs_cons_gloc: proc = I_VAL(CAR(x)); ASRTGO(NIMP(proc), badfun); @@ -826,14 +1062,14 @@ SCM ceval(x, env) #endif break; case tcs_cons_nimcar: - if SYMBOLP(CAR(x)) { + if IDENTP(CAR(x)) { proc = *lookupcar(x, env); if IMP(proc) {unmemocar(x, env); goto badfun;} - if (tc16_macro==TYP16(proc)) { + if MACROP(proc) { unmemocar(x, env); t.arg1 = apply(CDR(proc), x, cons(env, listofnull)); switch ((int)(CAR(proc)>>16)) { - case 2: + case 2: /* mmacro */ if (ilength(t.arg1) <= 0) t.arg1 = cons2(IM_BEGIN, t.arg1, EOL); DEFER_INTS; @@ -841,9 +1077,9 @@ SCM ceval(x, env) CDR(x) = CDR(t.arg1); ALLOW_INTS; goto loop; - case 1: + case 1: /* macro */ if NIMP(x = t.arg1) goto loop; - case 0: + case 0: /* acro */ return t.arg1; } } @@ -1142,7 +1378,7 @@ SCM apply(proc, arg1, args) args = NULLP(args)?UNDEFINED:CAR(args); return SUBRF(proc)(arg1, args); case tc7_subr_2: - ASRTGO(NULLP(CDR(args)), wrongnumargs); + ASRTGO(NIMP(args) && NULLP(CDR(args)), wrongnumargs); args = CAR(args); return SUBRF(proc)(arg1, args); case tc7_subr_0: @@ -1364,12 +1600,27 @@ static int prinmacro(exp, port, writing) lputc('>', port); return !0; } - +#ifdef MACRO +static int prinid(exp, port, writing) + SCM exp; + SCM port; + int writing; +{ + SCM s = IDENT_PARENT(exp); + while (!IDENTP(s)) s = IDENT_PARENT(s); + lputs("#<identifier ", port); + iprin1(s, port, writing); + lputc(':', port); + intprint((long)exp, 16, port); + lputc('>', port); + return !0; +} +#endif char s_force[] = "force"; SCM force(x) SCM x; { - ASSERT((TYP16(x)==tc16_promise), x, ARG1, s_force); + ASSERT(NIMP(x) && (TYP16(x)==tc16_promise), x, ARG1, s_force); if (!((1L<<16) & CAR(x))) { SCM ans = apply(CDR(x), EOL, EOL); if (!((1L<<16) & CAR(x))) { @@ -1412,14 +1663,108 @@ SCM definedp(x, env) SCM x, env; { SCM proc = CAR(x = CDR(x)); +#ifdef MACRO + proc = ident2sym(proc); +#endif return (ISYMP(proc) - || (NIMP(proc) && SYMBOLP(proc) + || (NIMP(proc) && IDENTP(proc) && !UNBNDP(CDR(sym2vcell(proc)))))? (SCM)BOOL_T : (SCM)BOOL_F; } +#ifdef MACRO +static char s_identp[] = "identifier?"; +SCM identp(obj) + SCM obj; +{ + return (NIMP(obj) && IDENTP(obj)) ? BOOL_T : BOOL_F; +} + +static char s_ident_eqp[] = "identifier-equal?"; +SCM ident_eqp(id1, id2, env) + SCM id1, id2, env; +{ + SCM s1 = id1, s2 = id2; +# ifndef RECKLESS + if IMP(id1) + badarg1: wta(id1, (char *)ARG1, s_ident_eqp); + if IMP(id1) + badarg2: wta(id2, (char *)ARG2, s_ident_eqp); +# endif + if (id1==id2) return BOOL_T; + while M_IDENTP(s1) s1 = IDENT_PARENT(s1); + while M_IDENTP(s2) s2 = IDENT_PARENT(s2); + ASRTGO(SYMBOLP(s1), badarg1); + ASRTGO(SYMBOLP(s2), badarg2); + if (s1 != s2) return BOOL_F; + if (id_denote(id1, env)==id_denote(id2, env)) return BOOL_T; + return BOOL_F; +} + +static char s_renamed_ident[] = "renamed-identifier"; +SCM renamed_ident(id, env) + SCM id, env; +{ + SCM z; + ASSERT(NIMP(id) && IDENTP(id), id, ARG1, s_renamed_ident); + NEWCELL(z); + if IMP(env) { + CAR(z) = tc16_ident; + CDR(z) = id; + return z; + } + else { + SCM y; + CAR(z) = id; + CDR(z) = CAR(CAR(env)); + NEWCELL(y); + CAR(y) = tc16_ident | 1L<<16; + CDR(y) = z; + return y; + } +} + +static char s_syn_quote[] = "syntax-quote"; +SCM m_syn_quote(xorig, env) + SCM xorig, env; +{ + ASSYNT(ilength(CDR(xorig))==1, xorig, s_expression, s_syn_quote); + return cons(IM_QUOTE, CDR(xorig)); +} + +/* Ensure that the environment for LET-SYNTAX can be uniquely identified. */ +SCM m_atlet_syntax(xorig, env) + SCM xorig, env; +{ + if (IMP(env) || CONSP(CAR(CAR(env)))) + return m_let(xorig, env); + else { + SCM mark = renamed_ident(i_mark, BOOL_F); + return m_letstar(cons2(i_let, + cons(cons2(mark, BOOL_F, EOL), EOL), + acons(TOPRENAME(i_let), CDR(xorig), EOL)), + env); + } +} + +static char s_the_macro[] = "the-macro"; +SCM m_the_macro(xorig, env) + SCM xorig, env; +{ + SCM x = CDR(xorig); + ASSYNT(1==ilength(x), xorig, s_expression, s_the_macro); + if (NIMP(CAR(x)) && IDENTP(CAR(x))) + x = *lookupcar(x, env); + else + x = evalcar(x, env); + ASSYNT(NIMP(x) && MACROP(x), xorig, ARG1, s_the_macro); + return cons2(IM_QUOTE, x, EOL); +} +#endif + + static iproc subr1s[] = { - {"copy-tree", copytree}, + {"@copy-tree", copytree}, {s_eval, eval}, {s_force, force}, {s_proc_doc, l_proc_doc}, @@ -1427,6 +1772,9 @@ static iproc subr1s[] = { {"procedure->macro", makmacro}, {"procedure->memoizing-macro", makmmacro}, {"apply:nconc-to-last", nconc2last}, +#ifdef MACRO + {s_identp, identp}, +#endif {0, 0}}; static iproc lsubr2s[] = { @@ -1437,6 +1785,9 @@ static iproc lsubr2s[] = { static smobfuns promsmob = {markcdr, free0, prinprom}; static smobfuns macrosmob = {markcdr, free0, prinmacro}; +#ifdef MACRO +static smobfuns idsmob = {markcdr, free0, prinid}; +#endif SCM make_synt(name, macroizer, fcn) char *name; @@ -1469,9 +1820,10 @@ void init_eval() i_uq_splicing = CAR(sysintern("unquote-splicing", UNDEFINED)); /* acros */ - i_quasiquote = make_synt(s_quasiquote, makacro, m_quasiquote); + i_quasiquote = make_synt(s_quasiquote, makmmacro, m_quasiquote); make_synt(s_define, makmmacro, m_define); - make_synt(s_delay, makacro, m_delay); + make_synt(s_delay, makmmacro, m_delay); + make_synt("defined?", makacro, definedp); /* end of acros */ make_synt(s_and, makmmacro, m_and); @@ -1490,5 +1842,15 @@ void init_eval() make_synt(s_atapply, makmmacro, m_apply); make_synt(s_atcall_cc, makmmacro, m_cont); - make_synt("defined?", makacro, definedp); +#ifdef MACRO + tc16_ident = newsmob(&idsmob); + make_subr(s_renamed_ident, tc7_subr_2, renamed_ident); + make_subr(s_ident_eqp, tc7_subr_3, ident_eqp); + make_synt(s_syn_quote, makmmacro, m_syn_quote); + make_synt("@let-syntax", makmmacro, m_atlet_syntax); + /* This doesn't do anything special, but might in the future. */ + make_synt("@letrec-syntax", makmmacro, m_letrec); + make_synt(s_the_macro, makmmacro, m_the_macro); + i_mark = CAR(sysintern("let-syntax-mark", UNDEFINED)); +#endif } @@ -1,4 +1,4 @@ -/* This file was part of DLD, a dynamic link/unlink editor for C. +/* "findexec.c" was part of DLD, a dynamic link/unlink editor for C. Copyright (C) 1990 by W. Wilson Ho. @@ -59,9 +59,27 @@ Wed Feb 21 23:06:35 1996 Aubrey Jaffer <jaffer@jacal.bertronics> # include <strings.h> # endif #endif +#ifdef __amigados__ +# include <stdlib.h> +# include <sys/stat.h> +#endif #ifndef __STDC__ # define const /**/ #endif +#ifdef freebsd +/* This might be same for 44bsd derived system. */ +# include <sys/types.h> +# include <sys/stat.h> +#endif +#ifdef __alpha +# include <string.h> +# include <stdlib.h> +# include <sys/types.h> +# include <sys/stat.h> +#endif +#ifdef __GO32__ +# include <sys/stat.h> +#endif #ifndef DEFAULT_PATH # define DEFAULT_PATH ".:~/bin::/usr/local/bin:/usr/new:/usr/ucb:/usr/bin:/bin:/usr/hosts" @@ -93,11 +111,17 @@ char *dld_find_executable(name) char tbuf[MAXPATHLEN]; if (ABSOLUTE_FILENAME_P(name)) - return copy_of(name); + return access(name, X_OK) ? 0 : copy_of(name); - if ((name[0] == '.') && (name[1] == '/')) { + if (strchr(name, '/')) { + strcpy (tbuf, "."); /* in case getcwd doesn't work */ getcwd(tbuf, MAXPATHLEN); - strcat(tbuf, name + 1); + if ((name[0] == '.') && (name[1] == '/')) { + strcat(tbuf, name + 1); + } else { + if ('/' != tbuf[strlen(tbuf) - 1]) strcat(tbuf, "/"); + strcat(tbuf, name); + } return copy_of(tbuf); } @@ -1614,7 +1614,17 @@ Cambridge, MA 02139, USA. #include <sys/cdefs.h> extern size_t __getpagesize __P ((void)); #else +/* added by Denys Duchier: handle missing getpagesize.h + on solaris: getpagesize is in the c library, but there + is no include file that declares it. + */ +#if defined(sun) && defined(__svr4__) && !defined(__GNUG__) +extern int getpagesize(void); +#else +#ifndef hpux #include "getpagesize.h" +#endif +#endif #define __getpagesize() getpagesize() #endif diff --git a/install-sh b/install-sh deleted file mode 100644 index 89fc9b0..0000000 --- a/install-sh +++ /dev/null @@ -1,238 +0,0 @@ -#! /bin/sh -# -# install - install a program, script, or datafile -# This comes from X11R5. -# -# Calling this script install-sh is preferred over install.sh, to prevent -# `make' implicit rules from creating a file called install from it -# when there is no Makefile. -# -# This script is compatible with the BSD install script, but was written -# from scratch. -# - - -# set DOITPROG to echo to test this script - -# Don't use :- since 4.3BSD and earlier shells don't like it. -doit="${DOITPROG-}" - - -# put in absolute paths if you don't have them in your path; or use env. vars. - -mvprog="${MVPROG-mv}" -cpprog="${CPPROG-cp}" -chmodprog="${CHMODPROG-chmod}" -chownprog="${CHOWNPROG-chown}" -chgrpprog="${CHGRPPROG-chgrp}" -stripprog="${STRIPPROG-strip}" -rmprog="${RMPROG-rm}" -mkdirprog="${MKDIRPROG-mkdir}" - -tranformbasename="" -transform_arg="" -instcmd="$mvprog" -chmodcmd="$chmodprog 0755" -chowncmd="" -chgrpcmd="" -stripcmd="" -rmcmd="$rmprog -f" -mvcmd="$mvprog" -src="" -dst="" -dir_arg="" - -while [ x"$1" != x ]; do - case $1 in - -c) instcmd="$cpprog" - shift - continue;; - - -d) dir_arg=true - shift - continue;; - - -m) chmodcmd="$chmodprog $2" - shift - shift - continue;; - - -o) chowncmd="$chownprog $2" - shift - shift - continue;; - - -g) chgrpcmd="$chgrpprog $2" - shift - shift - continue;; - - -s) stripcmd="$stripprog" - shift - continue;; - - -t=*) transformarg=`echo $1 | sed 's/-t=//'` - shift - continue;; - - -b=*) transformbasename=`echo $1 | sed 's/-b=//'` - shift - continue;; - - *) if [ x"$src" = x ] - then - src=$1 - else - # this colon is to work around a 386BSD /bin/sh bug - : - dst=$1 - fi - shift - continue;; - esac -done - -if [ x"$src" = x ] -then - echo "install: no input file specified" - exit 1 -else - true -fi - -if [ x"$dir_arg" != x ]; then - dst=$src - src="" - - if [ -d $dst ]; then - instcmd=: - else - instcmd=mkdir - fi -else - -# Waiting for this to be detected by the "$instcmd $src $dsttmp" command -# might cause directories to be created, which would be especially bad -# if $src (and thus $dsttmp) contains '*'. - - if [ -f $src -o -d $src ] - then - true - else - echo "install: $src does not exist" - exit 1 - fi - - if [ x"$dst" = x ] - then - echo "install: no destination specified" - exit 1 - else - true - fi - -# If destination is a directory, append the input filename; if your system -# does not like double slashes in filenames, you may need to add some logic - - if [ -d $dst ] - then - dst="$dst"/`basename $src` - else - true - fi -fi - -## this sed command emulates the dirname command -dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` - -# Make sure that the destination directory exists. -# this part is taken from Noah Friedman's mkinstalldirs script - -# Skip lots of stat calls in the usual case. -if [ ! -d "$dstdir" ]; then -defaultIFS=' -' -IFS="${IFS-${defaultIFS}}" - -oIFS="${IFS}" -# Some sh's can't handle IFS=/ for some reason. -IFS='%' -set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` -IFS="${oIFS}" - -pathcomp='' - -while [ $# -ne 0 ] ; do - pathcomp="${pathcomp}${1}" - shift - - if [ ! -d "${pathcomp}" ] ; - then - $mkdirprog "${pathcomp}" - else - true - fi - - pathcomp="${pathcomp}/" -done -fi - -if [ x"$dir_arg" != x ] -then - $doit $instcmd $dst && - - if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && - if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && - if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && - if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi -else - -# If we're going to rename the final executable, determine the name now. - - if [ x"$transformarg" = x ] - then - dstfile=`basename $dst` - else - dstfile=`basename $dst $transformbasename | - sed $transformarg`$transformbasename - fi - -# don't allow the sed command to completely eliminate the filename - - if [ x"$dstfile" = x ] - then - dstfile=`basename $dst` - else - true - fi - -# Make a temp file name in the proper directory. - - dsttmp=$dstdir/#inst.$$# - -# Move or copy the file name to the temp name - - $doit $instcmd $src $dsttmp && - - trap "rm -f ${dsttmp}" 0 && - -# and set any options; do chmod last to preserve setuid bits - -# If any of these fail, we abort the whole thing. If we want to -# ignore errors from any of these, just make sure not to ignore -# errors from the above "$doit $instcmd $src $dsttmp" command. - - if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && - if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && - if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && - if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && - -# Now rename the file to the real destination. - - $doit $rmcmd -f $dstdir/$dstfile && - $doit $mvcmd $dsttmp $dstdir/$dstfile - -fi && - - -exit 0 @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -66,6 +66,14 @@ SCM stat2scm P((struct stat *stat_temp)); #ifdef __sgi__ # include <unistd.h> #endif +#ifdef freebsd +# include <unistd.h> +#endif +/* added by Denys Duchier */ +#ifdef __svr4__ +# include <sys/types.h> +# include <unistd.h> +#endif #ifndef STDC_HEADERS int chdir P((const char *path)); diff --git a/mkimpcat.scm b/mkimpcat.scm new file mode 100644 index 0000000..4c69937 --- /dev/null +++ b/mkimpcat.scm @@ -0,0 +1,221 @@ +;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc. +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this software; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;; As a special exception, the Free Software Foundation gives permission +;; for additional uses of the text contained in its release of GUILE. +;; +;; The exception is that, if you link the GUILE library with other files +;; to produce an executable, this does not by itself cause the +;; resulting executable to be covered by the GNU General Public License. +;; Your use of that executable is in no way restricted on account of +;; linking the GUILE library code into it. +;; +;; This exception does not however invalidate any other reasons why +;; the executable file might be covered by the GNU General Public License. +;; +;; This exception applies only to the code released by the +;; Free Software Foundation under the name GUILE. If you copy +;; code from other Free Software Foundation releases into a copy of +;; GUILE, as the General Public License permits, the exception does +;; not apply to the code that you add in this way. To avoid misleading +;; anyone as to the status of such modified files, you must delete +;; this exception notice from them. +;; +;; If you write modifications of your own for GUILE, it is your choice +;; whether to permit this exception to apply to your modifications. +;; If you do not wish that, delete this exception notice. + +;;;; "mkimpcat.scm" Build SCM-specific catalog for SLIB. +;;; Author: Aubrey Jaffer. + +(let ((catname "implcat")) + (call-with-output-file (in-vicinity (implementation-vicinity) catname) + (lambda (op) + (define (display* . args) + (for-each (lambda (arg) (display arg op)) args) + (newline op)) + (define wb:vicinity (string-append (implementation-vicinity) "../wb/")) + (define x-scm:vicinity + (string-append (implementation-vicinity) "../xscm-2.01/")) + (define (add-link feature ofile . libs) + (cond ((file-exists? ofile) + ;; remove #f from libs list + (set! libs (let rem ((l libs)) + (cond ((null? l) l) + ((car l) (cons (car l) (rem (cdr l)))) + (else (rem (cdr l)))))) + (display " " op) + (write (cons feature (cons 'compiled (cons ofile libs))) op) + (newline op) + #t) + (else #f))) + (define (add-alias from to) + (display " " op) + (write (cons from to) op) + (newline op)) + (define (add-source feature filename) (add-alias feature filename)) + (define (add-links feature usr:lib x:lib link:able-suffix) + (display* "#+" feature) + (display* "(") + (begin + (cond ((add-link 'i/o-extensions + (in-vicinity (implementation-vicinity) "ioext" + link:able-suffix) + (usr:lib "c")) + (add-alias 'line-i/o 'i/o-extensions) + (add-alias 'pipe 'i/o-extensions))) + (cond ((add-link 'rev2-procedures + (in-vicinity (implementation-vicinity) "sc2" + link:able-suffix)) + (add-alias 'rev3-procedures 'rev2-procedures))) + (cond ((or + (add-link 'db + (in-vicinity wb:vicinity "db.so")) + (add-link 'db + (in-vicinity wb:vicinity "db" link:able-suffix) + (in-vicinity wb:vicinity "handle" link:able-suffix) + (in-vicinity wb:vicinity "blink" link:able-suffix) + (in-vicinity wb:vicinity "prev" link:able-suffix) + (in-vicinity wb:vicinity "ent" link:able-suffix) + (in-vicinity wb:vicinity "sys" link:able-suffix) + (in-vicinity wb:vicinity "del" link:able-suffix) + (in-vicinity wb:vicinity "stats" link:able-suffix) + (in-vicinity wb:vicinity "blkio" link:able-suffix) + (in-vicinity wb:vicinity "scan" link:able-suffix) + (usr:lib "c"))) + (add-source 'wb-table + (in-vicinity wb:vicinity "wbtab")) + (add-alias 'wb 'db))) + (cond ((add-link 'stringvector + (in-vicinity x-scm:vicinity "strvec" link:able-suffix)) + (add-source 'x11 (in-vicinity x-scm:vicinity "x11")) + (add-source 'xevent(in-vicinity x-scm:vicinity "xevent")) + (add-source 'xt (in-vicinity x-scm:vicinity "xt")) + (add-source 'xm (in-vicinity x-scm:vicinity "xm")) + (add-source 'xmsubs(in-vicinity x-scm:vicinity "xmsubs")) + (add-source 'xaw (in-vicinity x-scm:vicinity "xaw")) + (add-source 'xpm (in-vicinity x-scm:vicinity "xpm")))) + + (add-link 'turtle-graphics + (in-vicinity (implementation-vicinity) "turtlegr" + link:able-suffix) + (x:lib "X11") + (usr:lib "m") + (usr:lib "c")) + (add-link 'curses + (in-vicinity (implementation-vicinity) "crs" + link:able-suffix) + (usr:lib "ncurses") + ;;(usr:lib "curses") + ;;(usr:lib "termcap") + (usr:lib "c")) + (add-link 'edit-line + (in-vicinity (implementation-vicinity) "edline" + link:able-suffix) + (usr:lib "edit") + (usr:lib "termcap") + (usr:lib "c")) + (add-link 'regex + (in-vicinity (implementation-vicinity) "rgx" + link:able-suffix) + (usr:lib "c")) + (add-link 'unix + (in-vicinity (implementation-vicinity) "unix" + link:able-suffix) + (in-vicinity (implementation-vicinity) "ioext" + link:able-suffix) + (usr:lib "c")) + (add-link 'posix + (in-vicinity (implementation-vicinity) "posix" + link:able-suffix) + (usr:lib "c")) + (add-link 'socket + (in-vicinity (implementation-vicinity) "socket" + link:able-suffix) + (usr:lib "c")) + (add-link 'record + (in-vicinity (implementation-vicinity) "record" + link:able-suffix)) + (add-link 'generalized-c-arguments + (in-vicinity (implementation-vicinity) "gsubr" + link:able-suffix)) + (add-link 'array-for-each + (in-vicinity (implementation-vicinity) "ramap" + link:able-suffix)) + ) + (display* ")") + ) + + (begin + (display* ";\"" catname "\" Implementation-specific SLIB catalog for " + (scheme-implementation-type) (scheme-implementation-version) + ". -*-scheme-*-") + (display* ";") + (display* "; DO NOT EDIT THIS FILE") + (display* "; it is automagically generated by \"" *load-pathname* "\"") + (newline op) + ) + + ;; Output association lists to file "implcat" + + (begin + ;; Simple associations -- OK for all modes of dynamic-linking + (display* "(") + (add-alias 'hobbit (in-vicinity (implementation-vicinity) "hobbit")) + (add-alias 'scmhob (in-vicinity (implementation-vicinity) "scmhob")) + (add-alias 'build (in-vicinity (implementation-vicinity) "build")) + + ;; (add-alias 'impl:callback '(identity)) + + (display* ")") + ) + + (begin + ;; Messy because this trait has no C-installed feature name + (display* "#.(if (defined? renamed-identifier)") + (display* " '(") + (display " " op) + (add-source 'macro (in-vicinity (implementation-vicinity) "Macro")) + (display* " )") + (display* " '())") + ) + + (add-links 'dld + (lambda (lib) (string-append "/usr/lib/lib" lib ".a")) + (lambda (lib) (string-append "/usr/X11/lib/lib" lib ".sa")) + ".o") + (add-links 'dld:dyncm + (lambda (lib) + (or (and (member lib '("c" "m")) + (let ((sa (string-append "/usr/lib/lib" lib ".sa"))) + (and (file-exists? sa) sa))) + (string-append "/usr/lib/lib" lib ".a"))) + (lambda (lib) (string-append "/usr/X11/lib/lib" lib ".sa")) + ".o") + (add-links 'shl + (lambda (lib) + (if (member lib '("c" "m")) + (string-append "/lib/lib" lib ".sl") + (string-append "/usr/lib/lib" lib ".sl"))) + (lambda (lib) + (string-append "/usr/X11R5/lib/lib" lib ".sl")) + ".sl") + (add-links 'sun-dl + ;; These libraries are (deferred) linked in conversion to ".so" + (lambda (lib) #f) + (lambda (lib) #f) + ".so") + ))) diff --git a/mkinstalldirs b/mkinstalldirs deleted file mode 100755 index 0e29377..0000000 --- a/mkinstalldirs +++ /dev/null @@ -1,35 +0,0 @@ -#!/bin/sh -# Make directory hierarchy. -# Written by Noah Friedman <friedman@prep.ai.mit.edu> -# Public domain. - -defaultIFS=' -' -IFS="${IFS-${defaultIFS}}" - -errstatus=0 - -for file in ${1+"$@"} ; do - oIFS="${IFS}" - # Some sh's can't handle IFS=/ for some reason. - IFS='%' - set - `echo ${file} | sed -e 's@/@%@g' -e 's@^%@/@'` - IFS="${oIFS}" - - pathcomp='' - - for d in ${1+"$@"} ; do - pathcomp="${pathcomp}${d}" - - if test ! -d "${pathcomp}"; then - echo "mkdir $pathcomp" 1>&2 - mkdir "${pathcomp}" || errstatus=$? - fi - - pathcomp="${pathcomp}/" - done -done - -exit $errstatus - -# eof @@ -4,5 +4,5 @@ trailing number is the patchlevel. */ #ifndef SCMVERSION -# define SCMVERSION "4e6" +# define SCMVERSION "5b3" #endif @@ -47,11 +47,17 @@ #include <pwd.h> #include <sys/types.h> #include <sys/wait.h> +/* added by Denys Duchier: for kill */ +#include <signal.h> #ifndef STDC_HEADERS char *ttyname P((int fd)); FILE *popen P((const char* command, const char* type)); int pclose P((FILE* stream)); +#else /* added by Denys Duchier */ +# ifdef SVR4 +# include <unistd.h> +# endif #endif /* Only the superuser can successfully execute this call */ @@ -158,7 +164,7 @@ SCM scm_getgroups() scm_s_getgroups); int val = getgroups(ngroups, groups); if (val < 0) { - must_free(groups); + must_free((char *)groups); ALLOW_INTS; return BOOL_F; } @@ -1465,6 +1465,8 @@ SCM array_imap(ra, proc) SCM inds = make_uve(ARRAY_NDIM(ra)+0L, MAKINUM(-1L)); long *vinds = VELTS(inds); int j, k, kmax = ARRAY_NDIM(ra) - 1; + if (kmax < 0) + return aset(ra, apply(proc, EOL, EOL), EOL); for (k = 0; k <= kmax; k++) vinds[k] = ARRAY_DIMS(ra)[k].lbnd; k = kmax; @@ -1,4 +1,4 @@ -/* Copyright (C) 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -81,11 +81,16 @@ static SCM the_rtd_rtd; #define RTD_FIELDS(x) (((rtd_type *)CDR(x))->fields) #define RCLO_RTD(x) (((rec_cclo *)CDR(x))->pred.rtd) +/* If we are compiling this as a dll, then we cannot assume that + arrays will be available when the dll is loaded */ #ifdef ARRAYS -# define MAKE_REC_INDS(n) make_uve((long)n, MAKINUM(1)) -# define REC_IND_REF(x, i) VELTS(x)[(i)] -# define REC_IND_SET(x, i, val) VELTS(x)[(i)] = (val) -#else +# ifndef DLL +# define MAKE_REC_INDS(n) make_uve((long)n, MAKINUM(1)) +# define REC_IND_REF(x, i) VELTS(x)[(i)] +# define REC_IND_SET(x, i, val) VELTS(x)[(i)] = (val) +# endif +#endif +#ifndef MAKE_REC_INDS # define MAKE_REC_INDS(n) make_vector(MAKINUM(n), INUM0) # define REC_IND_REF(x, i) INUM(VELTS(x)[(i)]) # define REC_IND_SET(x, i, val) VELTS(x)[(i)] = MAKINUM(val) @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -45,6 +45,8 @@ #include "scm.h" #include "setjump.h" void igc P((char *what, STACKITEM *stackbase)); +void unexec P((char *new_name, char *a_name, unsigned data_start, + unsigned bss_start, unsigned entry_address)); #ifdef ARM_ULIB # include <termio.h> @@ -119,6 +121,8 @@ char *isymnames[] = { "#@and", "#@begin", "#@case", "#@cond", "#@do", "#@if", "#@lambda", "#@let", "#@let*", "#@letrec", "#@or", "#@quote", "#@set!", "#@define", "#@apply", "#@call-with-current-continuation", + "#@farloc-car", "#@farloc-cdr", "#@delay", "#@quasiquote", + "#@unquote", "#@unquote-splicing", "#@else", "#@=>", /* user visible ISYMS */ /* other keywords */ /* Flags */ @@ -152,7 +156,7 @@ void ipruk(hdr, ptr, port) { lputs("#<unknown-", port); lputs(hdr, port); - if CELLP(ptr) { + if (scm_cell_p(ptr)) { lputs(" (0x", port); intprint(CAR(ptr), 16, port); lputs(" . 0x", port); @@ -175,6 +179,7 @@ void iprlist(hdr, exp, tlr, port, writing) iprin1(CAR(exp), port, writing); exp = CDR(exp); for(;NIMP(exp);exp = CDR(exp)) { + if (!scm_cell_p(~1L & exp)) break; if NECONSP(exp) break; lputc(' ', port); /* CHECK_INTS; */ @@ -223,6 +228,10 @@ taloop: else goto idef; break; case 1: /* gloc */ + if (!scm_cell_p(exp-1)) { + ipruk("gloc", exp, port); + break; + } lputs("#@", port); exp = CAR(exp-1); goto taloop; @@ -231,6 +240,10 @@ taloop: ipruk("immediate", exp, port); break; case 0: + if (!scm_cell_p(exp)) { + ipruk("heap", exp, port); + break; + } switch TYP7(exp) { case tcs_cons_gloc: case tcs_cons_imcar: @@ -245,7 +258,7 @@ taloop: if (writing) { lputc('\"', port); for(i = 0;i<LENGTH(exp);++i) switch (CHARS(exp)[i]) { - case '"': + case '\"': case '\\': lputc('\\', port); default: @@ -583,33 +596,22 @@ char *grow_tok_buf(tok_buf) return CHARS(tok_buf); } -static int flush_ws(port, eoferr) +static int flush_ws(port) SCM port; -char *eoferr; -{ - register int c; - while(1) switch (c = lgetc(port)) { - case EOF: -goteof: - if (eoferr) wta(UNDEFINED, s_eofin, eoferr); - return c; - case ';': -lp: - switch (c = lgetc(port)) { - case EOF: - goto goteof; - default: - goto lp; - case LINE_INCREMENTORS: - break; - } - case LINE_INCREMENTORS: - if (port==loadport) linum++; - case WHITE_SPACES: - break; - default: - return c; - } +{ + register int c; + while(1) switch (c = lgetc(port)) { + case ';': lp: switch (c = lgetc(port)) { + default: goto lp; + case EOF: return c; + case LINE_INCREMENTORS: break; + } + case LINE_INCREMENTORS: if (port==loadport) linum++; + case WHITE_SPACES: break; + case EOF: + default: + return c; + } } SCM lread(port) SCM port; @@ -619,24 +621,24 @@ SCM lread(port) if UNBNDP(port) port = cur_inp; else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read); do { - c = flush_ws(port, (char *)NULL); + c = flush_ws(port); if (EOF==c) return EOF_VAL; lungetc(c, port); tok_buf = makstr(30L); } while (EOF_VAL==(tok_buf = lreadr(tok_buf, port))); return tok_buf; } -static SCM lreadr(tok_buf, port) +static SCM lreadpr(tok_buf, port) SCM tok_buf; -SCM port; + SCM port; { int c; sizet j; SCM p; tryagain: - c = flush_ws(port, s_read); + c = flush_ws(port); switch (c) { -/* case EOF: return EOF_VAL;*/ + case EOF: return EOF_VAL; #ifdef BRACKETS_AS_PARENS case '[': #endif @@ -644,8 +646,7 @@ tryagain: #ifdef BRACKETS_AS_PARENS case ']': #endif - case ')': warn("unexpected \")\"", ""); - goto tryagain; + case ')': return UNDEFINED; /* goto tryagain; */ case '\'': return cons2(i_quote, lreadr(tok_buf, port), EOL); case '`': return cons2(i_quasiquote, lreadr(tok_buf, port), EOL); case ',': @@ -765,6 +766,18 @@ tok: return CAR(p); } } +static SCM lreadr(tok_buf, port) + SCM tok_buf; + SCM port; +{ + SCM ans = lreadpr(tok_buf, port); + switch (ans) { + case UNDEFINED: + warn("unexpected \")\"", ""); + return lreadpr(tok_buf, port); + } + return ans; +} #ifdef _UNICOS _Pragma("noopt"); /* # pragma _CRI noopt */ @@ -785,7 +798,8 @@ static sizet read_token(ic, tok_buf, port) case '[': case ']': #endif case '(': case ')': case '\"': case ';': - case ',': case '`': case '#': + case ',': case '`': + /* case '#': */ case WHITE_SPACES: case LINE_INCREMENTORS: lungetc(c, port); @@ -806,39 +820,25 @@ static SCM lreadparen(tok_buf, port, name) SCM port; char *name; { - SCM tmp, tl, ans; - int c = flush_ws(port, name); - if (')'==c -#ifdef BRACKETS_AS_PARENS - || ']'==c -#endif - ) return EOL; - lungetc(c, port); - if (i_dot==(tmp = lreadr(tok_buf, port))) { - ans = lreadr(tok_buf, port); + SCM lst, fst, tmp = lreadpr(tok_buf, port); + if (UNDEFINED==tmp) return EOL; + if (i_dot==tmp) { + fst = lreadr(tok_buf, port); closeit: - if (')' != (c = flush_ws(port, name)) -#ifdef BRACKETS_AS_PARENS - && ']' != c -#endif - ) - wta(UNDEFINED, "missing close paren", ""); - return ans; + tmp = lreadpr(tok_buf, port); + if (UNDEFINED != tmp) wta(UNDEFINED, "missing close paren", ""); + return fst; } - ans = tl = cons(tmp, EOL); - while (')' != (c = flush_ws(port, name)) -#ifdef BRACKETS_AS_PARENS - && ']' != c -#endif - ) { - lungetc(c, port); - if (i_dot==(tmp = lreadr(tok_buf, port))) { - CDR(tl) = lreadr(tok_buf, port); + fst = lst = cons(tmp, EOL); + while (UNDEFINED != (tmp = lreadpr(tok_buf, port))) { + if (EOF_VAL==tmp) wta(lst, s_eofin, s_list); + if (i_dot==tmp) { + CDR(lst) = lreadr(tok_buf, port); goto closeit; } - tl = (CDR(tl) = cons(tmp, EOL)); + lst = (CDR(lst) = cons(tmp, EOL)); } - return ans; + return fst; } /* These procedures implement synchronization primitives. Processors @@ -962,7 +962,7 @@ SCM scm_load_string(str) return BOOL_T; } -SCM exitval; /* INUM with return value */ +SCM exitval = MAKINUM(EXIT_FAILURE); /* INUM return value */ extern char s_unexec[]; SCM repl_driver(initpath) char *initpath; @@ -973,7 +973,7 @@ SCM repl_driver(initpath) long i; #endif CONT(rootcont)->stkbse = (STACKITEM *)&i; - i = setjmp(CONT(rootcont)->jmpbuf); + i = setjump(CONT(rootcont)->jmpbuf); #ifndef SHORT_INT if (i) i = UNCOOK(i); #endif @@ -1218,20 +1218,20 @@ SCM quit(n) SCM n; { if (UNBNDP(n) || BOOL_T==n) n = MAKINUM(EXIT_SUCCESS); - else if INUMP(n) exitval = n; + if INUMP(n) exitval = n; else exitval = MAKINUM(EXIT_FAILURE); if (errjmp_bad) exit(INUM(exitval)); dowinds(EOL, ilength(dynwinds)); - longjmp(CONT(rootcont)->jmpbuf, COOKIE(-1)); + longjump(CONT(rootcont)->jmpbuf, COOKIE(-1)); } SCM abrt() { - if (errjmp_bad) exit(INUM(exitval)); + if (errjmp_bad) exit(EXIT_FAILURE); dowinds(EOL, ilength(dynwinds)); #ifdef CAUTIOUS stacktrace = EOL; #endif - longjmp(CONT(rootcont)->jmpbuf, COOKIE(-2)); + longjump(CONT(rootcont)->jmpbuf, COOKIE(-2)); } char s_restart[] = "restart"; SCM restart() @@ -1241,24 +1241,11 @@ SCM restart() #ifdef CAUTIOUS stacktrace = EOL; #endif - longjmp(CONT(rootcont)->jmpbuf, COOKIE(-3)); -} - -#ifdef CAN_DUMP -char s_unexec[] = "unexec"; -SCM scm_unexec(newpath) - SCM newpath; -{ - ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_unexec); - *loc_errobj = newpath; -# ifdef CAUTIOUS - stacktrace = EOL; -# endif - longjmp(CONT(rootcont)->jmpbuf, COOKIE(-4)); + longjump(CONT(rootcont)->jmpbuf, COOKIE(-3)); } -#endif -char s_execpath[] = "execpath"; +char s_no_ep[] = "no execpath"; +#define s_execpath (s_no_ep+3) SCM scm_execpath(newpath) SCM newpath; { @@ -1272,10 +1259,36 @@ SCM scm_execpath(newpath) } ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_execpath); if (execpath) free(execpath); - execpath = scm_cat_path(0L, CHARS(newpath), 0L); + if ((execpath = (char *)malloc((sizet)(LENGTH(newpath) + 1)))) + strncpy(execpath, CHARS(newpath), LENGTH(newpath) + 1); return retval; } +#ifdef CAN_DUMP +char s_unexec[] = "unexec"; +SCM scm_unexec(newpath) + SCM newpath; +{ + ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_unexec); + ASSERT(execpath, UNSPECIFIED, s_no_ep, s_unexec); + *loc_errobj = newpath; +# ifdef CAUTIOUS + stacktrace = EOL; +# endif + longjump(CONT(rootcont)->jmpbuf, COOKIE(-4)); +} +#endif + +#ifdef CAREFUL_INTS +void ints_viol(sense) + int sense; +{ + fputs(";ints already ", stderr); + fputs(sense ? "en" : "dis", stderr); + fputs("abled\n", stderr); +} +#endif + void han_sig() { sig_deferred = 0; @@ -1289,6 +1302,7 @@ void han_alrm() wta(UNDEFINED, (char *)ALRM_SIGNAL, ""); } +#ifdef TAIL_RECURSIVE_LOAD SCM tryload(filename) SCM filename; { @@ -1317,8 +1331,36 @@ SCM tryload(filename) SIDEVAL(form, EOL); } } +} +#else +SCM tryload(filename) + SCM filename; +{ + ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_load); + { + SCM oloadpath = *loc_loadpath; + SCM oloadport = loadport; + long olninum = linum; + SCM form, port; + port = open_file(filename, makfromstr("r", (sizet)sizeof(char))); + if FALSEP(port) return port; + *loc_loadpath = filename; + loadport = port; + linum = 1; + while(1) { + form = lread(port); + if (EOF_VAL==form) break; + SIDEVAL(form, EOL); + } + close_port(port); + linum = olninum; + loadport = oloadport; + *loc_loadpath = oloadpath; + } return BOOL_T; } +#endif + #ifdef CAUTIOUS void scm_print_stack(stk) SCM stk; @@ -1375,9 +1417,11 @@ void warn(str1, str2) err_head("WARNING"); lputs("WARNING: ", cur_errp); lputs(str1, cur_errp); - lputs(str2, cur_errp); - lputc('\n', cur_errp); - lfflush(cur_errp); + if (str2) { + lputs(str2, cur_errp); + lputc('\n', cur_errp); + lfflush(cur_errp); + } } SCM lerrno(arg) @@ -1497,7 +1541,7 @@ void everr(exp, env, arg, pos, s_subr) #ifndef CAUTIOUS /* We don't have to clear stacktrace because CAUTIOUS never gets here */ /* We don't have to dowinds() because dynwinds is EOL */ - longjmp(CONT(rootcont)->jmpbuf, COOKIE((int)pos)); + longjump(CONT(rootcont)->jmpbuf, COOKIE((int)pos)); /* will do error processing at stack base */ #endif } @@ -1621,7 +1665,6 @@ void init_repl( iverbose ) add_feature(s_char_readyp); #endif #ifdef CAN_DUMP - if (!execpath) execpath = dld_find_executable(CHARS(CAR(progargs))); add_feature("dump"); scm_ldstr("\ (define (dump file . thunk)\n\ @@ -1630,6 +1673,7 @@ void init_repl( iverbose ) ((boolean? (car thunk)))\n\ (else (set! boot-tail (car thunk))))\n\ (set! restart exec-self)\n\ + (require #f)\n\ (unexec file))\n\ "); #endif @@ -1,6 +1,54 @@ +/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + +/* "rgx.c" regular expression matching using C regex library. + Author: Aubrey Jaffer */ + #include "scm.h" #include "regex.h" #include <stdio.h> +/* added by Denys Duchier: for bcopy */ +#ifdef sun +#include <strings.h> +#endif static char rcsid[] = "$Id: rgx.c, v 1.20 1995/02/15 04:39:45 dpb Exp $"; @@ -104,7 +152,11 @@ static smobfuns rgxsmob = {markregex, fregex, prinregex}; SCM lregerror(scode) SCM scode; { - int code, len; + int code; + /* added by Denys Duchier: conditional declaration */ +#ifdef __REGEXP_LIBRARY_H__ + int len; +#endif SCM str; ASSERT(INUMP(scode), scode, ARG1, s_regerror); code = INUM(scode); @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -330,6 +330,35 @@ unsigned long scm_addr(args, s_name) } #endif /* ARRAYS */ +/* scm_cell_p() returns !0 if the SCM argument `x' is cell-aligned and + points into a valid heap segment. This code is duplicated from + mark_locations() and obunhash() in "sys.c", which means that + changes to these routines must be coordinated. */ + +#include "continue.h" +extern sizet hplim_ind; +extern CELLPTR *hplims; + +int scm_cell_p(x) + SCM x; +{ + register int i, j; + register CELLPTR ptr; + if NCELLP(x) return 0; + ptr = (CELLPTR)SCM2PTR(x); + i = 0; + j = hplim_ind; + do { + if PTR_GT(hplims[i++], ptr) break; + if PTR_LE(hplims[--j], ptr) break; + if ((i != j) + && PTR_LE(hplims[i++], ptr) + && PTR_GT(hplims[--j], ptr)) continue; + return !0; /* NFREEP(x) */ + } while(i<j); + return 0; +} + void init_rope() { } @@ -147,10 +147,10 @@ SCM appendb(args) tail: if NULLP(args) return EOL; arg = CAR(args); - ASSERT(NULLP(arg) || (NIMP(arg) && CONSP(arg)), arg, ARG1, s_appendb); args = CDR(args); if NULLP(args) return arg; if NULLP(arg) goto tail; + ASSERT(NIMP(arg) && CONSP(arg), arg, ARG1, s_appendb); CDR(last_pair(arg)) = appendb(args); return arg; } @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -291,11 +291,13 @@ int floprint(sexp, port, writing) int writing; { #ifdef FLOATS - char num_buf[FLOBUFLEN]; - lfwrite(num_buf, (sizet)sizeof(char), iflo2str(sexp, num_buf), port); -#else - ipruk("float", sexp, port); + if (!errjmp_bad) { + char num_buf[FLOBUFLEN]; + lfwrite(num_buf, (sizet)sizeof(char), iflo2str(sexp, num_buf), port); + return !0; + } else #endif + ipruk("float", sexp, port); return !0; } int bigprint(exp, port, writing) @@ -304,11 +306,13 @@ int bigprint(exp, port, writing) int writing; { #ifdef BIGDIG - exp = big2str(exp, (unsigned int)10); - lfwrite(CHARS(exp), (sizet)sizeof(char), (sizet)LENGTH(exp), port); -#else - ipruk("bignum", exp, port); + if (!errjmp_bad) { + exp = big2str(exp, (unsigned int)10); + lfwrite(CHARS(exp), (sizet)sizeof(char), (sizet)LENGTH(exp), port); + return !0; + } else #endif + ipruk("bignum", exp, port); return !0; } /*** END nums->strs ***/ @@ -588,6 +592,7 @@ SCM istr2flo(str, len, radix) case '@': { /* polar input for complex number */ /* get a `real' for angle */ second = istr2flo(&str[i], (long)(len-i), radix); + if IMP(second) return BOOL_F; if (!(INEXP(second))) return BOOL_F; /* not `real' */ if (CPLXP(second)) return BOOL_F; /* not `real' */ tmp = REALPART(second); @@ -602,6 +607,7 @@ SCM istr2flo(str, len, radix) if (i==(len-1)) return makdbl(res, lead_sgn); /* get a `ureal' for complex part */ second = istr2flo(&str[i], (long)((len-i)-1), radix); + if IMP(second) return BOOL_F; if (!(INEXP(second))) return BOOL_F; /* not `ureal' */ if (CPLXP(second)) return BOOL_F; /* not `ureal' */ tmp = REALPART(second); @@ -863,7 +869,6 @@ SCM equal(x, y) else return BOOL_F; } } - return BOOL_F; } SCM numberp(x) @@ -2328,6 +2333,7 @@ static dblproc cxrs[] = { {"$abs", fabs}, {"$exp", exp}, {"$log", log}, + {"$log10", log10}, {"$sin", sin}, {"$cos", cos}, {"$tan", tan}, @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -56,9 +56,10 @@ unsigned int sleep P((unsigned int seconds)); char *getenv P((const char *name)); int system P((const char *)); -#endif -#ifdef hpux -# define const /**/ +#else /* added by Denys Duchier */ +# ifdef SVR4 +# include <unistd.h> +# endif #endif void final_repl P((void)); @@ -82,7 +83,7 @@ void init_banner() { fputs("SCM version ", stderr); fputs(SCMVERSION, stderr); - fputs(", Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 \ + fputs(", Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 \ Free Software Foundation.\n\ SCM comes with ABSOLUTELY NO WARRANTY; for details type `(terms)'.\n\ This is free software, and you are welcome to redistribute it\n\ @@ -232,8 +233,8 @@ SCM l_sleep(i) SYSCALL(j = sleep(INUM(i));); # endif return MAKINUM(j); -} # endif +} # endif #endif @@ -581,190 +582,46 @@ SCM softtype() #endif } -/* Concatentate str2 onto str1 at position n and return concatenated - string if file exists; 0 otherwise. */ - -char *scm_cat_path(str1, str2, n) - char *str1; - const char *str2; - long n; -{ - if (!n) n = strlen(str2); - if (str1) - { - long len = strlen(str1); - str1 = (char *)realloc(str1, (sizet)(len + n + 1)); - if (!str1) return 0; - strncat(str1 + len, str2, n); - return str1; - } - str1 = (char *)malloc((sizet)(n + 1)); - if (!str1) return 0; - str1[0] = 0; - strncat(str1, str2, n); - return str1; -} - -char *scm_try_path(path) - char *path; -{ - FILE *f; - /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */ - if (!path) return 0; - SYSCALL(f = fopen(path, "r");); - if (f) { - fclose(f); - return path; - } - free(path); - return 0; -} - -char *scm_sep_init_try(path, sep, initname) - char *path; - const char *sep, *initname; -{ - if (path) path = scm_cat_path(path, sep, 0L); - if (path) path = scm_cat_path(path, initname, 0L); - return scm_try_path(path); -} - -#ifdef MSDOS -char *dld_find_executable(file) - const char *file; -{ - return scm_cat_path(0L, file, 0L); -} -#endif - -#ifndef INIT_FILE_NAME -# define INIT_FILE_NAME "Init.scm" -#endif -#ifndef DIRSEP -# define DIRSEP "/" -#endif -#ifndef GENERIC_NAME -# define GENERIC_NAME "scm" -#endif - -/* Given dld_find_executable()'s best guess for the pathname of this - executable, find (and verify the existence of) initname in the - implementation-vicinity of this program. Returns a newly allocated - string if successful, 0 if not */ - -char *scm_find_impl_file(exec_path, generic_name, initname, sep) - char *exec_path; - const char *generic_name, *initname, *sep; -{ - char *sepptr = strrchr(exec_path, sep[0]); - char *extptr = exec_path + strlen(exec_path); - char *path = 0; - if (sepptr) { - long sepind = sepptr - exec_path + 1L; - - /* In case exec_path is in the source directory, look first in - exec_path's directory. */ - path = scm_cat_path(0L, exec_path, sepind - 1L); - path = scm_sep_init_try(path, sep, initname); - if (path) return path; - -#ifdef MSDOS - if (!strcmp(extptr - 4, ".exe") || !strcmp(extptr - 4, ".com") || - !strcmp(extptr - 4, ".EXE") || !strcmp(extptr - 4, ".COM")) - extptr = extptr - 4; -#endif - - if (generic_name && - !strncmp(exec_path + sepind, generic_name, extptr - exec_path)) - generic_name = 0; - - /* If exec_path is in directory "exe" or "bin": */ - path = scm_cat_path(0L, exec_path, sepind - 1L); - sepptr = path + sepind - 4; - if (!strcmp(sepptr, "exe") || !strcmp(sepptr, "bin") || - !strcmp(sepptr, "EXE") || !strcmp(sepptr, "BIN")) { - char *peer; - - /* Look for initname in peer directory "lib". */ - if (path) { - strncpy(sepptr, "lib", 3); - path = scm_sep_init_try(path, sep, initname); - if (path) return path; - } - - /* Look for initname in peer directories "lib" and "src" in - subdirectory with the name of the executable (sans any type - extension like .EXE). */ - for(peer="lib";!0;peer="src") { - path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L); - if (path) { - strncpy(path + sepind - 4, peer, 3); - path[extptr - exec_path] = 0; - path = scm_sep_init_try(path, sep, initname); - if (path) return path; - } - if (!strcmp(peer,"src")) break; - } - - if (generic_name) { - - /* Look for initname in peer directories "lib" and "src" in - subdirectory with the generic name. */ - for(peer="lib";!0;peer="src") { - path = scm_cat_path(0L, exec_path, sepind); - if (path) { - strncpy(path + sepind - 4, "lib", 3); - path = scm_cat_path(path, generic_name, 0L); - path = scm_sep_init_try(path, sep, initname); - if (path) return path; - } - if (!strcmp(peer,"src")) break; - }}} - -#ifdef MSDOS - if (strlen(extptr)) { - /* If exec_path has type extension, look in a subdirectory with - the name of the executable sans the executable file's type - extension. */ - path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L); - path = scm_sep_init_try(path, sep, initname); - if (path) return path; - - if (generic_name) { - - /* Also look in generic_name subdirectory. */ - path = scm_cat_path(0L, exec_path, sepind); - if (path) path = scm_cat_path(path, generic_name, 0L); - path = scm_sep_init_try(path, sep, initname); - if (path) return path; - }} -#endif - } - else { +#ifndef RTL - /* We don't have a parse-able exec_path. The only path to try is - just initname. */ - path = scm_cat_path(0L, initname, 0L); - if (path) path = scm_try_path(path); - if (path) return path; - } - return 0; -} +# ifndef INIT_FILE_NAME +# define INIT_FILE_NAME "Init.scm" +# endif +# ifndef DIRSEP +# define DIRSEP "/" +# endif +# ifndef GENERIC_NAME +# define GENERIC_NAME "scm" +# endif -#ifndef RTL char *execpath = 0; -int main( argc, argv ) +int main(argc, argv) int argc; char **argv; { - int retval, buf0stdin = 0; - char *getenvpath, *implpath = 0; + int retval, buf0stdin = 0, nargc; + char *getenvpath, *implpath = 0, **nargv; + + execpath = 0; + if ((nargv = script_process_argv(argc, argv))) { + nargc = script_count_argv(nargv); +# ifdef unix +# ifndef MSDOS + execpath = script_find_executable(argv[2]); +# endif +# endif + } + else { + nargv = argv; + nargc = argc; + } + /* fprintf(stderr, "execpath = %s\n", execpath); fflush(stderr); */ + if (!execpath) execpath = dld_find_executable(argv[0]); # ifndef nosve getenvpath = getenv("SCM_INIT_PATH"); if (getenvpath) implpath = scm_cat_path(0L, getenvpath, 0L); if (implpath) { - /* The value of the environment variable supersedes other locations, as long as the file exists. */ implpath = scm_try_path(implpath); @@ -776,18 +633,14 @@ int main( argc, argv ) } # endif - if (!implpath) { - execpath = dld_find_executable(argv[0]); - if (execpath) { - /* fprintf(stderr, "dld found exe \"%s\"\n", execpath); fflush(stderr); */ - implpath = scm_find_impl_file(execpath, - GENERIC_NAME, INIT_FILE_NAME, DIRSEP); - /* fprintf(stderr, "scm_find_impl_file returned \"%s\"\n", implpath); fflush(stderr); */ - } + if (execpath && (!implpath)) { + implpath = scm_find_impl_file(execpath, + GENERIC_NAME, INIT_FILE_NAME, DIRSEP); + /* fprintf(stderr, "scm_find_impl_file returned \"%s\"\n", implpath); fflush(stderr); */ + } # ifdef IMPLINIT - if (!implpath) implpath = scm_cat_path(0L, IMPLINIT, 0L); + if (!implpath) implpath = scm_cat_path(0L, IMPLINIT, 0L); # endif - } # ifndef GO32 if (isatty(fileno(stdin))) { buf0stdin = !0; /* stdin gets marked BUF0 in init_scm() */ @@ -808,13 +661,14 @@ int main( argc, argv ) } # endif # endif - retval = run_scm(argc, argv, + retval = run_scm(nargc, nargv, (isatty(fileno(stdin)) && isatty(fileno(stdout))) - ? (argc <= 1) ? 2 : 1 : 0, + ? (nargc <= 1) ? 2 : 1 : 0, buf0stdin, implpath ? implpath : ""); if (implpath) free(implpath); if (execpath) free(execpath); + execpath = 0; return retval; } #endif @@ -1,15 +1,15 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. - * +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. + * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. @@ -36,7 +36,7 @@ * * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. + * If you do not wish that, delete this exception notice. */ /* "scm.h" SCM data types and external functions. */ @@ -45,11 +45,17 @@ extern "C" { #endif +#ifdef hpux +# ifndef __GNUC__ +# define const /**/ +# endif +#endif + typedef long SCM; typedef struct {SCM car, cdr;} cell; typedef struct {long sname;SCM (*cproc)();} subr; -typedef struct {char *string;SCM (*cproc)();} iproc; typedef struct {long sname;double (*dproc)();} dsubr; +typedef struct {const char *string;SCM (*cproc)();} iproc; #include <stdio.h> #include "scmfig.h" @@ -122,6 +128,7 @@ typedef struct {SCM type;double *real;} dbl; #define ICDR (0x00080000L) #define IFRINC (0x00000100L) #define IDSTMSK (-IDINC) +#define MAKILOC(if, id) (ILOC00 + (((long)id)<<20) + (((long)if)<<8)) #define IFRAME(n) ((int)((ICDR-IFRINC)>>8) & ((int)(n)>>8)) #define IDIST(n) (((unsigned long)(n))>>20) #define ICDRP(n) (ICDR & (n)) @@ -167,6 +174,8 @@ extern char *isymnames[]; #define s_quote (ISYMCHARS(IM_QUOTE)+2) #define s_set (ISYMCHARS(IM_SET)+2) #define s_define (ISYMCHARS(IM_DEFINE)+2) +#define s_delay (ISYMCHARS(IM_DELAY)+2) +#define s_quasiquote (ISYMCHARS(IM_QUASIQUOTE)+2) extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; #define s_apply (ISYMCHARS(IM_APPLY)+2) @@ -175,8 +184,16 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; /* corresponds to it's position in isymnames[] in sys.c */ #define IM_APPLY MAKISYM(14) #define IM_CONT MAKISYM(15) +#define IM_FARLOC_CAR MAKISYM(16) +#define IM_FARLOC_CDR MAKISYM(17) +#define IM_DELAY MAKISYM(18) +#define IM_QUASIQUOTE MAKISYM(19) +#define IM_UNQUOTE MAKISYM(20) +#define IM_UQ_SPLICING MAKISYM(21) +#define IM_ELSE MAKISYM(22) +#define IM_ARROW MAKISYM(23) -#define NUM_ISYMS 16 +#define NUM_ISYMS 24 #define BOOL_F MAKIFLAG(NUM_ISYMS+0) #define BOOL_T MAKIFLAG(NUM_ISYMS+1) @@ -192,11 +209,11 @@ extern SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; /* Now some unnamed flags used as magic cookies by repl_driver. */ /* Argument n can range from -4 to 16 */ #ifdef SHORT_INT -#define COOKIE(n) (n) -#define UNCOOK(f) (f) +# define COOKIE(n) (n) +# define UNCOOK(f) (f) #else -#define COOKIE(n) MAKIFLAG(NUM_ISYMS+6+4+n) -#define UNCOOK(f) (ISYMNUM(f)-(NUM_ISYMS+6+4)) +# define COOKIE(n) MAKIFLAG(NUM_ISYMS+6+4+n) +# define UNCOOK(f) (ISYMNUM(f)-(NUM_ISYMS+6+4)) #endif #define FALSEP(x) (BOOL_F==(x)) @@ -630,6 +647,7 @@ SCM floequal P((SCM x, SCM y)); SCM uve_equal P((SCM u, SCM v)); SCM raequal P((SCM ra0, SCM ra1)); SCM array_equal P((SCM u, SCM v)); +SCM array_rank P((SCM ra)); int rafill P((SCM ra, SCM fill, SCM ignore)); SCM uve_fill P((SCM uve, SCM fill)); SCM array_fill P((SCM ra, SCM fill)); @@ -679,6 +697,9 @@ SCM map P((SCM proc, SCM arg1, SCM args)); SCM scm_make_cont P((void)); SCM copytree P((SCM obj)); SCM eval P((SCM obj)); +SCM identp P((SCM obj)); +SCM ident_eqp P((SCM id1, SCM id2, SCM env)); +SCM renamed_ident P((SCM id, SCM env)); SCM input_portp P((SCM x)); SCM output_portp P((SCM x)); SCM cur_input_port P((void)); @@ -718,6 +739,7 @@ SCM aset P((SCM v, SCM obj, SCM args)); SCM aref P((SCM v, SCM args)); SCM cvref P((SCM v, sizet pos, SCM last)); SCM quit P((SCM n)); +void ints_viol P((int sense)); void add_final P((void (*final)(void))); SCM makcclo P((SCM proc, long len)); SCM make_uve P((long k, SCM prot)); @@ -730,7 +752,6 @@ SCM scm_load_string P((SCM str)); void scm_print_stack P((SCM stk)); char * dld_find_executable P((const char* command)); SCM scm_unexec P((const SCM pathname)); -char * scm_cat_path P((char *str1, const char *str2, long n)); /* Defined in "rope.c" */ SCM long2num P((long n)); @@ -750,6 +771,7 @@ void scm_ldstr P((char *str)); int scm_ldfile P((char *path)); int scm_ldprog P((char *path)); unsigned long scm_addr P((SCM args, char *name)); +int scm_cell_p P((SCM x)); #ifdef FLOATS SCM makdbl P((double x, double y)); @@ -764,7 +786,7 @@ double floident P((double x)); #endif #ifdef BIGDIG -void longdigs P((long x, BIGDIG digs [DIGSPERLONG ])); +void longdigs P((long x, BIGDIG digs[DIGSPERLONG])); SCM adjbig P((SCM b, sizet nlen)); SCM normbig P((SCM b)); SCM copybig P((SCM b, int sign)); @@ -779,6 +801,15 @@ long pseudolong P((long x)); int bigcomp P((SCM x, SCM y)); SCM bigequal P((SCM x, SCM y)); +/* "script.c" functions */ +char * scm_cat_path P((char *str1, const char *str2, long n)); +char * scm_try_path P((char *path)); +char * script_find_executable P((const char *command)); +char ** script_process_argv P((int argc, char **argv)); +int script_count_argv P((char **argv)); +char * scm_find_impl_file P((char *exec_path, const char *generic_name, + const char *initname, const char *sep)); + #ifdef RECKLESS # define ASSERT(_cond, _arg, _pos, _subr) ; # define ASRTGO(_cond, _label) ; @@ -5,6 +5,13 @@ @setchapternewpage on @c Choices for setchapternewpage are {on,off,odd}. @paragraphindent 2 +@defcodeindex ft +@syncodeindex ft tp +@c @dircategory Scheme +@c @direntry +@c * SCM: (scm). A Scheme interpreter. +@c @end direntry + @c %**end of header @iftex @@ -17,13 +24,13 @@ @titlepage @title SCM @subtitle Scheme Implementation -@subtitle Version 4e6 -@subtitle March 1996 +@subtitle Version 5b3 +@subtitle May 1997 @author by Aubrey Jaffer @page @vskip 0pt plus 1filll -Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation +Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -40,7 +47,7 @@ except that this permission notice may be stated in a translation approved by the author. @end titlepage -@node Top, Copying, (dir), (dir) +@node Top, Overview, (dir), (dir) @ifinfo @@ -49,7 +56,7 @@ information about SCM can be found on SCM's @dfn{WWW} home page: @center http://www-swiss.ai.mit.edu/~jaffer/SCM.html -Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation +Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -74,9 +81,9 @@ by the author. @end ifinfo @menu -* Copying:: Conditions for copying and changing SCM. -* Overview:: Whats here and how to start using it. -* Installing SCM:: Where it goes and how to get it there. +* Overview:: +* Installing SCM:: +* Operational Features:: * The Language:: Reference. * Packages:: Optional Capabilities. * The Implementation:: How it works. @@ -85,8 +92,37 @@ by the author. * Type Index:: @end menu -@node Copying, Overview, Top, Top -@chapter Copying +@node Overview, Installing SCM, Top, Top +@chapter Overview + +@noindent +Scm is a portable Scheme implementation written in C. Scm provides a +machine independent platform for [JACAL], a symbolic algebra system. + +@iftex +@noindent +The most recent information about SCM can be found on SCM's @dfn{WWW} +home page: +@ifset html +<A HREF="http://www-swiss.ai.mit.edu/~jaffer/SCM.html"> +@end ifset + +@center http://www-swiss.ai.mit.edu/~jaffer/SCM.html + +@ifset html +</A> +@end ifset +@end iftex + +@menu +* Copying:: +* SCM Features:: +* SCM Authors:: +* Bibliography:: +@end menu + +@node Copying, SCM Features, Overview, Overview +@section Copying @center COPYRIGHT (c) 1989 BY @center PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. @@ -158,42 +194,7 @@ INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. -@node Overview, Installing SCM, Copying, Top -@chapter Overview - -@noindent -Scm is a portable Scheme implementation written in C. Scm provides a -machine independent platform for [JACAL], a symbolic algebra system. - -@iftex -@noindent -The most recent information about SCM can be found on SCM's @dfn{WWW} -home page: -@ifset html -<A HREF="http://www-swiss.ai.mit.edu/~jaffer/SCM.html"> -@end ifset - -@center http://www-swiss.ai.mit.edu/~jaffer/SCM.html - -@ifset html -</A> -@end ifset -@end iftex - -@menu -* SCM Features:: -* SCM Authors:: -* Bibliography:: -* Invoking SCM:: -* SCM Options:: -* SCM Variables:: -* SCM Examples:: -* SCM Session:: -* Editing Scheme Code:: -* Debugging Scheme Code:: -@end menu - -@node SCM Features, SCM Authors, Overview, Overview +@node SCM Features, SCM Authors, Copying, Overview @section Features @itemize @bullet @@ -267,7 +268,7 @@ C-stack and being able to garbage collect off the C-stack There are many other contributors to SCM. They are acknowledged in the file @file{ChangeLog}, a log of changes that have been made to scm. -@node Bibliography, Invoking SCM, SCM Authors, Overview +@node Bibliography, , SCM Authors, Overview @section Bibliography @table @asis @@ -365,429 +366,15 @@ Documentation on the internal representation and how to extend or include @code{scm} in other programs. @end table -@node Invoking SCM, SCM Options, Bibliography, Overview -@section Invoking SCM - -@quotation -@exdent @b{ scm } [-a @i{kbytes}] [-ibvqmu] [-p @i{number}] -@w{[-c @i{expression}]} @w{[-e @i{expression}]} @w{[-f @i{filename}]} -@w{[-l @i{filename}]} @w{[-r @i{feature}]} @w{[-- | - | -s]} -@w{[@i{filename}]} @w{[@i{arguments} @dots{}]} -@end quotation - -@noindent -Upon startup @code{scm} loads the file specified by by the environment -variable @var{SCM_INIT_PATH}. - -@noindent -If @var{SCM_INIT_PATH} is not defined or if the file it names is not -present, @code{scm} tries to find the directory containing the -executable file. If it is able to locate the executable, @code{scm} -looks for the initialization file (usually @file{Init.scm}) in -platform-dependent directories relative to this directory. -@xref{File-System Habitat} for a blow-by-blow description. - -@noindent -As a last resort (if initialization file cannot be located), the C -compile parameter @var{IMPLINIT} (defined in the makefile or -@file{scmfig.h}) is tried. - -@noindent -Unless the option @code{-no-init-file} or @code{--no-init-file} occurs -in the command line, @file{Init.scm} checks to see if there is file -@file{ScmInit.scm} in the path specified by the environment variable -@var{HOME} (or in the current directory if @var{HOME} is undefined). If -it finds such a file it is loaded. - -@noindent -@file{Init.scm} then looks for command input from one of three sources: -From an option on the command line, from a file named on the command -line, or from standard input. - -@noindent -This explanation applies to SCMLIT or other builds of SCM. - -@noindent -Scheme-code files can also invoke SCM and its variants. @xref{Syntax -Extensions, #!}. - -@node SCM Options, SCM Variables, Invoking SCM, Overview -@section Options - -@noindent -The options are processed in the order specified on the command line. - -@deffn {Command Option} -a kb -specifies that @code{scm} should allocate an initial heapsize of -@var{kb} kilobytes. This option, if present, must be the first on -the command line. If not specified, the default is -@code{INIT_HEAP_SIZE} in source file @file{setjump.h} which the -distribution sets at @code{25000*sizeof(cell)}. -@end deffn - -@deffn {Command Option} -no-init-file -@deffnx {Command Option} --no-init-file -Inhibits the loading of @file{ScmInit.scm} as described above. -@end deffn - -@deffn {Command Option} -e expression -@deffnx {Command Option} -c expression -specifies that the scheme expression @var{expression} is to be -evaluated. These options are inspired by @code{perl} and @code{sh} -respectively. On Amiga systems the entire option and argument need to be -enclosed in quotes. For instance @samp{"-e(newline)"}. -@end deffn - -@deffn {Command Option} -r feature -requires @var{feature}. This will load a file from [SLIB] if that -@var{feature} is not already supported. If @var{feature} is 2, 3, 4, or -5 @code{scm} will require the features neccessary to support [R2RS], -[R3RS], [R4RS], or proposed [R5RS], respectively. -@end deffn - -@deffn {Command Option} -l filename -@deffnx {Command Option} -f filename -loads @var{filename}. @code{Scm} will load the first (unoptioned) file -named on the command line if no @code{-c}, @code{-e}, @code{-f}, -@code{-l}, or @code{-s} option preceeds -it. -@end deffn - -@deffn {Command Option} -p level -sets the prolixity (verboseness) to @var{level}. This is the same as -the @code{scm} command (verobse @var{level}). -@end deffn - -@deffn {Command Option} -v -(verbose mode) specifies that @code{scm} will print prompts, evaluation -times, notice of loading files, and garbage collection statistics. This -is the same as @code{-p3}. -@end deffn - -@deffn {Command Option} -q -(quiet mode) specifies that @code{scm} will print no extra -information. This is the same as @code{-p0}. -@end deffn - -@deffn {Command Option} -m -specifies that subsequent loads, evaluations, and user interactions will -be with [R4RS] macro capability. To use a specific [R4RS] macro -implementation from [SLIB] (instead of [SLIB]'s default) put @code{-r} -@var{macropackage} before @code{-m} on the command line. -@end deffn - -@deffn {Command Option} -u -specifies that subsequent loads, evaluations, and user interactions will -be without [R4RS] macro capability. [R4RS] macro capability can -be restored by a subsequent @code{-m} on the command line or from Scheme -code. -@end deffn - -@deffn {Command Option} -i -specifies that @code{scm} should run interactively. That means that -@code{scm} will not terminate until the @code{(quit)} or @code{(exit)} -command is given, even if there are errors. It also sets the prolixity -level to 2 if it is less than 2. This will print prompts, evaluation -times, and notice of loading files. The prolixity level can be set by -subsequent options. If @code{scm} is started from a tty, it will assume -that it should be interactive unless given a subsequent @code{-b} -option. -@end deffn - -@deffn {Command Option} -b -specifies that @code{scm} should run non-interactively. That means that -@code{scm} will terminate after processing the command line or if there -are errors. -@end deffn - -@deffn {Command Option} -s -specifies, by analogy with @code{sh}, that further options are to be -treated as program aguments. -@end deffn - -@deffn {Command Option} - -@deffnx {Command Option} -- -specifies that there are no more options on the command line. -@end deffn - -@deffn {Command Option} -d filename -loads SLIB database-utilities and opens @var{filename} as a database. -@end deffn - -@deffn {Command Option} -o filename -saves the current SCM session as the executable program @file{filename}. -This option works only in SCM builds supporting @code{dump} -(@pxref{Dump}). - -If options appear on the command line after @samp{-o @var{filename}}, -then the saved session will continue with processing those options when -it is invoked. Otherwise the (new) command line is processed as usual -when the saved image is invoked. -@end deffn - -@deffn {Command Option} --help -prints usage information and URL; then exit. -@end deffn - -@deffn {Command Option} --version -prints version information and exit. -@end deffn - -@node SCM Variables, SCM Examples, SCM Options, Overview -@section Environment Variables - -@defvr {Environment Variable} SCM_INIT_PATH -is the pathname where @code{scm} will look for its initialization -code. The default is the file @file{Init.scm} in the source directory. -@end defvr - -@defvr {Environment Variable} SCHEME_LIBRARY_PATH -is the [SLIB] Scheme library directory. -@end defvr - -@defvr {Environment Variable} HOME -is the directory where @file{Init.scm} will look for the user -initialization file @file{ScmInit.scm}. -@end defvr - -@section Scheme Variables - -@defvar *argv* -contains the list of arguments to the program. @code{*argv*} can change -during argument processing. This list is suitable for use as an argument -to [SLIB] @code{getopt}. -@end defvar - -@defvar *R4RS-macro* -controls whether loading and interaction support [R4RS] macros. Define -this in @file{ScmInit.scm} or files specified on the command line. This -can be overridden by subsequent @code{-m} and @code{-u} options. -@end defvar - -@defvar *interactive* -controls interactivity as explained for the @code{-i} and @code{-b} -options. Define this in @file{ScmInit.scm} or files specified on the -command line. This can be overridden by subsequent @code{-i} and -@code{-b} options. -@end defvar - -@node SCM Examples, SCM Session, SCM Variables, Overview -@section Examples - -@table @code -@item % scm foo.scm -Loads and executes the contents of @file{foo.scm} and then enters -interactive session. - -@item % scm -f foo.scm arg1 arg2 arg3 -Parameters @code{arg1}, @code{arg2}, and @code{arg3} are stored in the -global list @code{*argv*}; Loads and executes the contents of -@file{foo.scm} and exits. - -@item % scm -s foo.scm arg1 arg2 -Sets *argv* to @code{("foo.scm" "arg1" "arg2")} and enters interactive -session. - -@item % scm -e `(write (list-ref *argv* *optind*))' bar -Prints @samp{"bar"}. - -@item % scm -rpretty-print -r format -i -Loads @code{pretty-print} and @code{format} and enters interactive -session. - -@item % scm -r5 -Loads @code{dynamic-wind}, @code{values}, and [R4RS] macros and enters -interactive (with macros) session. - -@item % scm -r5 -r4 -Like above but @code{rev4-optional-procedures} are also loaded. -@end table - -@node SCM Session, Editing Scheme Code, SCM Examples, Overview -@section SCM Session - -@itemize @bullet -@item -Options, file loading and features can be specified from the command -line. @xref{System interface, , , scm, SCM}. @xref{Require, , , slib, -SLIB}. -@item -Typing the end-of-file character at the top level session (while SCM is -not waiting for parenthesis closure) causes SCM to exit. -@item -Typing the interrupt character aborts evaluation of the current form -and resumes the top level read-eval-print loop. -@end itemize - -@node Editing Scheme Code, Debugging Scheme Code, SCM Session, Overview -@section Editing Scheme Code - -@table @asis -@item Gnu Emacs: -Editing of Scheme code is supported by emacs. Buffers holding files -ending in .scm are automatically put into scheme-mode. - -If your Emacs can run a process in a buffer you can use the Emacs -command @samp{M-x run-scheme} with SCM. However, the run-scheme -(@file{xscheme.el}) which comes included with Gnu Emacs 18 will work -only with MIT Cscheme. If you are using Emacs 18, get the emacs -packages: - -@ifclear html -@itemize @bullet -@item -ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/cmuscheme.el -@item -ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/comint.el -@end itemize -@end ifclear - -@ifset html -<A HREF="file://ftp-swiss.ai.mit.edu/pub/scheme-editor-packages/cmuscheme.el"> -ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/cmuscheme.el -</A> -<A HREF="file://ftp-swiss.ai.mit.edu/pub/scheme-editor-packages/comint.el"> -ftp-swiss.ai.mit.edu:/pub/scheme-editor-packages/comint.el -</A> -@end ifset - -These files are already standard in Emacs 19. - -If your Emacs can not run a process in a buffer, see ``under other -systems'' below. - -@item Epsilon (MS-DOS): -There is lisp (and scheme) mode available by use of the package -@samp{LISP.E}. It offers several different indentation formats. With -this package, buffers holding files ending in @samp{.L}, @samp{.LSP}, -@samp{.S}, and @samp{.SCM} (my modification) are automatically put into -lisp-mode. - -It is possible to run a process in a buffer under Epsilon. With Epsilon -5.0 the command line options @samp{-e512 -m0} are neccessary to manage -RAM properly. It has been reported that when compiling SCM with Turbo -C, you need to @samp{#define NOSETBUF} for proper operation in a process -buffer with Epsilon 5.0. - -One can also call out to an editor from SCM if RAM is at a premium; See -``under other systems'' below. - -@item other systems: -Define the environment variable @samp{EDITOR} to be the name of the -editing program you use. The SCM procedure @code{(ed arg1 @dots{})} -will invoke your editor and return to SCM when you exit the editor. The -following definition is convenient: - -@example -(define (e) (ed "work.scm") (load "work.scm")) -@end example - -Typing @samp{(e)} will invoke the editor with the file of interest. -After editing, the modified file will be loaded. -@end table - -@node Debugging Scheme Code, , Editing Scheme Code, Overview -@section Debugging Scheme Code - -@noindent -The @code{cautious} and @code{stack-limit} options of @code{build} -(@pxref{Build Options}) support debugging in Scheme. - -@table @dfn -@item CAUTIOUS -If SCM is built with the @samp{CAUTIOUS} flag, then when an error -occurs, a @dfn{stack trace} of certain pending calls are printed as part -of the default error response. A (memoized) expression and newline are -printed for each partially evaluated combination whose procedure is not -builtin. @xref{Memoized Expressions} for how to read memoized -expressions. - -Also as the result of the @samp{CAUTIOUS} flag, both @code{error} and -@code{user-interrupt} (invoked by @key{C-c}) to print stack traces and -conclude by calling @code{breakpoint} (@pxref{Breakpoints, , , slib, -SLIB}) instead of aborting to top level. Under either condition, -program execution can be resumed by @code{(continue)}. - -In this configuration one can interrupt a running Scheme program with -@key{C-c}, inspect or modify top-level values, trace or untrace -procedures, and continue execution with @code{(continue)}. - -@item STACK_LIMIT -If SCM is built with the @samp{STACK_LIMIT} flag, the interpreter will -check stack size periodically. If the size of stack exceeds a certain -amount (default is @code{HEAP_SEG_SIZE/2}), SCM generates a -@code{segment violation} interrupt. - -The usefulness of @samp{STACK_LIMIT} depends on the user. I don't use -it; but the user I added this feature for got primarily this type of -error. -@end table - -@noindent -There are several SLIB macros which so useful that SCM automatically -loads the appropriate module from SLIB if they are invoked. - -@defmac trace proc1 @dots{} -Traces the top-level named procedures given as arguments. -@defmacx trace -With no arguments, makes sure that all the currently traced identifiers -are traced (even if those identifiers have been redefined) and returns a -list of the traced identifiers. -@end defmac - -@defmac untrace proc1 @dots{} -Turns tracing off for its arguments. -@defmacx untrace -With no arguments, untraces all currently traced identifiers and returns -a list of these formerly traced identifiers. -@end defmac - -The routine I use most for debugging is: - -@deffn Procedure print arg1 ... -@code{Print} writes all its arguments, separated by spaces. -@code{Print} outputs a @code{newline} at the end and returns the value -of the last argument. - -One can just insert @samp{(print '<proc-name>} and @samp{)} around an -expression in order to see its value as a program operates. -@end deffn - -@noindent -Sometimes more elaborate measures are needed to print values in a useful -manner. When the values to be printed may have very large (or infinite) -external representations, @ref{Quick Print, , , slib, SLIB}, can be -used. - -When @code{trace} is not sufficient to find program flow problems, -@ifset html -<A HREF="http://www.cs.tut.fi/staff/pk/scheme/psd/article/article.html"> -@end ifset -SLIB-PSD, the Portable Scheme Debugger -@ifset html -</A> -@end ifset -offers source code debugging from -GNU Emacs. PSD runs slowly, so start by instrumenting only a few -functions at a time. -@lisp -ftp-swiss.ai.mit.edu:pub/scm/slib-psd1-3.tar.gz -prep.ai.mit.edu:pub/gnu/jacal/slib-psd1-3.tar.gz -ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz -ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz -@end lisp - - -@node Installing SCM, The Language, Overview, Top +@node Installing SCM, Operational Features, Overview, Top @chapter Installing SCM @menu -* File-System Habitat:: All the usual suspects. -* Executable Pathname:: Where did I come from? -* Making SCM:: -* Building SCM:: +* Making SCM:: Bootstrapping. * SLIB:: REQUIREd reading. +* Building SCM:: * Installing Dynamic Linking:: +* Configure Module Catalog:: * Saving Images:: Make Fast-Booting Executables * Automatic C Preprocessor Definitions:: * Problems Compiling:: @@ -797,133 +384,7 @@ ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz * Reporting Problems:: @end menu -@node File-System Habitat, Executable Pathname, Installing SCM, Installing SCM -@section File-System Habitat - -@noindent -Where should software reside? Although individually a minor annoyance, -cumulatively this question represents many thousands of frustrated user -hours spent trying to find support files or guessing where packages need -to be installed. Even simple programs require proper habitat; games -need to find their score files. - -@noindent -Aren't there standards for this? Some Operating Systems have devised -regimes of software habitats -- only to have them violated by large -software packages and imports from other OS varieties. - -@noindent -In some programs, the expected locations of support files are fixed at -time of compilation. This means that the program may not run on -configurations unanticipated by the authors. Compiling locations into a -program also can make it immovable -- necessitating recompilation to -install it. - -@quotation -Programs of the world unite! You have nothing to lose but loss itself. -@end quotation - -@noindent -The function @code{scm_find_impl_file} in @file{scm.c} is an attempt to -create a utility (for inclusion in programs) which will hide the details -of platform-dependent file habitat conventions. It takes as input the -pathname of the executable file which is running. If there are systems -for which this information is either not available or unrelated to the -locations of support files, then a higher level interface will be -needed. - -@deftypefun char *scm_find_impl_file(char *@var{exec_path}, char -*@var{generic_name}, char *@var{initname}, char *@var{sep}) Given the -pathname of this executable (@var{exec_path}), test for the existence of -@var{initname} in the implementation-vicinity of this program. Return a -newly allocated string of the path if successful, 0 if not. The -@var{sep} argument is a @emph{mull-terminated string} of the character -used to separate directory components. -@end deftypefun - -@itemize @bullet -@item -One convention is to install the support files for an executable program -in the same directory as the program. This possibility is tried first, -which satisfies not only programs using this convention, but also -uninstalled builds when testing new releases, etc. - -@item -Another convention is to install the executables in a directory named -@file{bin}, @file{BIN}, @file{exe}, or @file{EXE} and support files in a -directroy named @file{lib}, which is a peer the executable directory. -This arrangement allows multiple executables can be stored in a single -directory. For example, the executable might be in -@samp{/usr/local/bin/} and initialization file in -@samp{/usr/local/lib/}. - -If the executable directory name matches, the peer directroy @file{lib} -is tested for @var{initname}. - -@item -Sometimes @file{lib} directories become too crowded. So we look in any -subdirectories of @file{lib} or @file{src} having the name (sans type -suffix such as @samp{.EXE}) of the program we are running. For example, -the executable might be @samp{/usr/local/bin/foo} and initialization -file in @samp{/usr/local/lib/foo/}. - -@item -But the executable name may not be the usual program name; So also look -in any @var{generic_name} subdirectories of @file{lib} or @file{src} -peers. - -@item -Finally, if the name of the executable file being run has a (system -dependent) suffix which is not needed to invoke the program, then look -in a subdirectory (of the one containing the executable file) named for -the executable (without the suffix); And look in a @var{generic_name} -subdirectory. For example, the executable might be -@samp{C:\foo\bar.exe} and the initialization file in @samp{C:\foo\bar\}. -@end itemize - - -@node Executable Pathname, Making SCM, File-System Habitat, Installing SCM -@section Executable Pathname - -@noindent -When a program is executed by MS-DOS, the full pathname of that -executable is available in @code{argv[0]}. This value can be passed to -@code{dld_find_executable} (@pxref{File-System Habitat}). - -In order to find the habitat for a unix program, we first need to know -the full pathname for the associated executable file. - -@deftypefun char *dld_find_executable (const char *@var{command}) -@code{dld_find_executable} returns the absolute path name of the file -that would be executed if @var{command} were given as a command. It -looks up the environment variable @var{PATH}, searches in each of the -directory listed for @var{command}, and returns the absolute path name -for the first occurrence. Thus, it is advisable to invoke -@code{dld_init} as: - -@example -main (int argc, char **argv) -@{ - @dots{} - if (dld_init (dld_find_executable (argv[0]))) @{ - @dots{} - @} - @dots{} -@} -@end example - -@quotation -@strong{Note:} If the current process is executed using the -@code{execve} call without passing the correct path name as argument 0, -@code{dld_find_executable (argv[0]) } will also fail to locate the -executable file. -@end quotation - -@code{dld_find_executable} returns zero if @code{command} is not found -in any of the directories listed in @code{PATH}. -@end deftypefun - -@node Making SCM, Building SCM, Executable Pathname, Installing SCM +@node Making SCM, SLIB, Installing SCM, Installing SCM @section Making SCM The SCM distribution has @dfn{Makefile} which contains rules for making @@ -956,13 +417,93 @@ Buy a SCM executable from jaffer@@ai.mit.edu. See the end of the Use scmconfig (From: bos@@scrg.cs.tcd.ie): Build and install scripts using GNU @dfn{autoconf} are available from -@file{scmconfig4e6.tar.gz} in the distribution directories. See -@file{README.unix} in @file{scmconfig4e6.tar.gz} for further +@file{scmconfig4e3.tar.gz} in the distribution directories. See +@file{README.unix} in @file{scmconfig4e3.tar.gz} for further instructions. + +@emph{Note:} The last release of scmconfig (4e3) was on March 20, 1996. +I am moving it to the OLD subdirectory until someone submits an update. +@end itemize + + +@node SLIB, Building SCM, Making SCM, Installing SCM +@section SLIB + +@noindent +[SLIB] is a portable Scheme library meant to provide compatibility and +utility functions for all standard Scheme implementations. Although +SLIB is not @emph{neccessary} to run SCM, I strongly suggest you obtain +and install it. Bug reports about running SCM without SLIB have very +low priority. SLIB is available from the same sites as SCM: + +@ifclear html +@itemize @bullet +@item +ftp-swiss.ai.mit.edu:/pub/scm/slib2c0.tar.gz +@item +prep.ai.mit.edu:/pub/gnu/jacal/slib2c0.tar.gz +@item +ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2c0.tar.gz +@item +ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2c0.tar.gz @end itemize +@end ifclear + +@ifset html +<A HREF="file://ftp-swiss.ai.mit.edu/pub/scm/slib2c0.tar.gz"> +ftp-swiss.ai.mit.edu:/pub/scm/slib2c0.tar.gz +</A> +<A HREF="file://prep.ai.mit.edu/pub/gnu/jacal/slib2c0.tar.gz"> +prep.ai.mit.edu:/pub/gnu/jacal/slib2c0.tar.gz +</A> +<A HREF="file://ftp.maths.tcd.ie/pub/bosullvn/jacal/slib2c0.tar.gz"> +ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2c0.tar.gz +</A> +<A HREF="file://ftp.cs.indiana.edu/pub/scheme-repository/code/lib/slib2c0.tar.gz"> +ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib2c0.tar.gz +</A> +@end ifset + +@noindent +Unpack SLIB (@samp{tar xzf slib2c0.tar.gz} or @samp{unzip -ao +slib2c0.zip}) in an appropriate directory for your system; both +@code{tar} and @code{unzip} will create the directory @file{slib}. + +@noindent +Then create a file @file{require.scm} in the SCM +@dfn{implementation-vicinity} (this is the same directory as where the +file @file{Init.scm} is installed). @file{require.scm} should have the +contents: + +@example +(define (library-vicinity) "/usr/local/lib/slib/") +(load (in-vicinity (library-vicinity) "require")) +@end example +@noindent +where the pathname string @file{/usr/local/lib/slib/} is to be replaced +by the pathname into which you installed SLIB. Absolute pathnames are +recommended here; if you use a relative pathname, SLIB can get confused +when the working directory is changed (@pxref{I/O-Extensions, chmod}). +The way to specify a relative pathname is to append it to the +implementation-vicinity, which is absolute: + +@example +(define library-vicinity + (let ((lv (string-append (implementation-vicinity) "../slib/"))) + (lambda () lv))) +(load (in-vicinity (library-vicinity) "require")) +@end example + +@noindent +Alternatively, you can set the (shell) environment variable +@code{SCHEME_LIBRARY_PATH} to the pathname of the SLIB directory +(@pxref{SCM Variables, SCHEME_LIBRARY_PATH, Environment Variables}). If +set, the environment variable overrides @file{require.scm}. Again, +absolute pathnames are recommended. -@node Building SCM, SLIB, Making SCM, Installing SCM + +@node Building SCM, Installing Dynamic Linking, SLIB, Installing SCM @section Building SCM The file @dfn{build.scm} builds and runs a relational database of how to @@ -974,11 +515,13 @@ additions to jaffer@@ai.mit.edu. @menu * Invoking Build:: * Build Options:: +* Compiling and Linking Custom Files:: @end menu @node Invoking Build, Build Options, Building SCM, Building SCM @subsection Invoking Build +@noindent The @emph{all} method will also work for MS-DOS and unix. Use the @emph{all} method if you encounter problems with @file{build.scm}. @@ -988,7 +531,7 @@ From the SCM source directory, type @samp{build} followed by up to 9 command line arguments. @item unix -From the SCM source directory, type @samp{build.scm} followed by command +From the SCM source directory, type @samp{./build.scm} followed by command line arguments. @item @emph{all} @@ -998,7 +541,51 @@ type @code{(load "build.scm")}. Alternatively, start @samp{scm} or @end table -@node Build Options, , Invoking Build, Building SCM +@noindent +Invoking build without the @samp{-F} option will build or create a shell +script with the @code{arrays}, @code{inexact}, and @code{bignums} +options as defaults. + +@example +bash$ ./build.scm +@print{} +#!/bin/sh +rm -f scmflags.h +echo '#define IMPLINIT "/home/jaffer/scm/Init.scm"'>>scmflags.h +echo '#define BIGNUMS'>>scmflags.h +echo '#define FLOATS'>>scmflags.h +echo '#define ARRAYS'>>scmflags.h +gcc -O2 -c continue.c scm.c findexec.c script.c time.c repl.c scl.c \ + eval.c sys.c subr.c unif.c rope.c +gcc -rdynamic -o scm continue.o scm.o findexec.o script.o time.o \ + repl.o scl.o eval.o sys.o subr.o unif.o rope.o -lm -lc +@end example + +@noindent +To cross compile for another platform, invoke build with the @samp{-p} +or @samp{---platform=} option. This will create a script for the +platform named in the @samp{-p} or @samp{---platform=} option. + +@example +bash$ ./build.scm -p vms +@print{} +$DELETE scmflags.h +$CREATE scmflags.h +$DECK +#define IMPLINIT "/home/jaffer/scm/Init.scm" +#define BIGNUMS +#define FLOATS +#define ARRAYS +$EOD +$ cc continue scm findexec script time repl scl eval sys subr unif rope +$ macro setjump +$ link continue,scm,findexec,script,time,repl,scl,eval,sys,subr,unif,rope,setjump,sys$input/opt + -lc,sys$share:vaxcrtl/share +$RENAME continue.exe scm.exe +@end example + + +@node Build Options, Compiling and Linking Custom Files, Invoking Build, Building SCM @subsection Build Options @noindent @@ -1025,6 +612,7 @@ acorn-unixlib acorn *unknown* *unknown* aix powerpc aix *unknown* amiga-aztec m68000 amiga aztec amiga-dice-c m68000 amiga dice-c +amiga-gcc m68000 amiga gcc amiga-sas/c-5.10 m68000 amiga sas/c atari-st-gcc m68000 atari.st gcc atari-st-turbo-c m68000 atari.st turbo-c @@ -1034,14 +622,14 @@ gcc *unknown* unix gcc highc.31 i386 ms-dos highc hp-ux hp-risc hp-ux *unknown* linux i386 linux gcc -linux-elf i386 linux gcc +linux-aout i386 linux gcc microsoft-c 8086 ms-dos microsoft-c -microsoft-c-nt i386 ms-dos microsoft-c +microsoft-c-nt i386 ms-dos microsoft-c microsoft-quick-c 8086 ms-dos microsoft-quick-c ms-dos 8086 ms-dos *unknown* os/2-cset i386 os/2 c-set++ os/2-emx i386 os/2 gcc -sun sparc sun-os *unknown* +sunos sparc sunos *unknown* svr4 *unknown* unix *unknown* turbo-c-2 8086 ms-dos turbo-c unicos cray unicos *unknown* @@ -1292,91 +880,73 @@ new C code into scm which uses VMS system services or library routines (which need to unwind the stack in an ordrly manner) you may need to use this feature. -@item memoize-local-bindings -Saves the interpeter from having to look up local bindings for every -identifier reference +@item macro +C level support for hygienic and referentially transparent macros (R4RS +macros). @end table @end deffn -@node SLIB, Installing Dynamic Linking, Building SCM, Installing SCM -@section SLIB +@node Compiling and Linking Custom Files, , Build Options, Building SCM +@subsection Compiling and Linking Custom Files @noindent -[SLIB] is a portable Scheme library meant to provide compatibility and -utility functions for all standard Scheme implementations. Although -SLIB is not @emph{neccessary} to run SCM, I strongly suggest you obtain -and install it. Bug reports about running SCM without SLIB have very -low priority. SLIB is available from the same sites as SCM: +A correspondent asks: -@ifclear html -@itemize @bullet -@item -ftp-swiss.ai.mit.edu:/pub/scm/slib2a6.tar.gz -@item -prep.ai.mit.edu:/pub/gnu/jacal/slib2a6.tar.gz -@item -ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz -@item -ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2a6.tar.gz -@end itemize -@end ifclear - -@ifset html -<A HREF="file://ftp-swiss.ai.mit.edu/pub/scm/slib2a6.tar.gz"> -ftp-swiss.ai.mit.edu:/pub/scm/slib2a6.tar.gz -</A> -<A HREF="file://prep.ai.mit.edu/pub/gnu/jacal/slib2a6.tar.gz"> -prep.ai.mit.edu:/pub/gnu/jacal/slib2a6.tar.gz -</A> -<A HREF="file://ftp.maths.tcd.ie/pub/bosullvn/jacal/slib2a6.tar.gz"> -ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz -</A> -<A HREF="file://ftp.cs.indiana.edu/pub/scheme-repository/code/lib/slib2a6.tar.gz"> -ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib2a6.tar.gz -</A> -@end ifset - -@noindent -Unpack SLIB (@samp{tar xzf slib2a6.tar.gz} or @samp{unzip -ao -slib2a6.zip}) in an appropriate directory for your system; both -@code{tar} and @code{unzip} will create the directory @file{slib}. +@quotation +How can we link in our own c files to the SCM interpreter so that we can +add our own functionality? (e.g. we have a bunch of tcp functions we +want access to). Would this involve changing build.scm or the Makefile +or both? +@end quotation @noindent -Then create a file @file{require.scm} in the SCM -@dfn{implementation-vicinity} (this is the same directory as where the -file @file{Init.scm} is installed). @file{require.scm} should have the -contents: +(@pxref{Changing Scm} has instructions describing the C code format). +@cindex foo.c +Suppose a C file @dfn{foo.c} has functions you wish to add to SCM. To +compile and link your file at compile time, use the @samp{-c} and +@samp{-i} options to build: @example -(define (library-vicinity) "/usr/local/lib/slib/") -(load (in-vicinity (library-vicinity) "require")) +bash$ build -c foo.c -i init_foo +@print{} +#!/bin/sh +rm -f scmflags.h +echo '#define IMPLINIT "/home/jaffer/scm/Init.scm"'>>scmflags.h +echo '#define COMPILED_INITS init_foo();'>>scmflags.h +echo '#define BIGNUMS'>>scmflags.h +echo '#define FLOATS'>>scmflags.h +echo '#define ARRAYS'>>scmflags.h +gcc -O2 -c continue.c scm.c findexec.c script.c time.c repl.c scl.c \ + eval.c sys.c subr.c unif.c rope.c foo.c +gcc -rdynamic -o scm continue.o scm.o findexec.o script.o time.o \ + repl.o scl.o eval.o sys.o subr.o unif.o rope.o foo.o -lm -lc @end example @noindent -where the pathname string @file{/usr/local/lib/slib/} is to be replaced -by the pathname into which you installed SLIB. Absolute pathnames are -recommended here; if you use a relative pathname, SLIB can get confused -when the working directory is changed (@pxref{I/O-Extensions, chmod}). -The way to specify a relative pathname is to append it to the -implementation-vicinity, which is absolute: +To make a dynamically loadable object file use the @code{-t dll} option: @example -(define library-vicinity - (let ((lv (string-append (implementation-vicinity) "../slib/"))) - (lambda () lv))) -(load (in-vicinity (library-vicinity) "require")) +bash$ build -t dll -c foo.c +@print{} +#!/bin/sh +rm -f scmflags.h +echo '#define IMPLINIT "/home/jaffer/scm/Init.scm"'>>scmflags.h +echo '#define BIGNUMS'>>scmflags.h +echo '#define FLOATS'>>scmflags.h +echo '#define ARRAYS'>>scmflags.h +echo '#define DLL'>>scmflags.h +gcc -O2 -fpic -c foo.c +gcc -shared -o foo.so foo.o -lm -lc @end example @noindent -Alternatively, you can set the (shell) environment variable -@code{SCHEME_LIBRARY_PATH} to the pathname of the SLIB directory -(@pxref{SCM Variables, SCHEME_LIBRARY_PATH, Environment Variables}). If -set, the environment variable overrides @file{require.scm}. Again, -absolute pathnames are recommended. +Once @file{foo.c} compiles correctly (and your SCM build supports +dynamic-loading), you can load the compiled file with the Scheme command +@code{(load "./foo.so")}. @xref{Configure Module Catalog} for how to +add a compiled dll file to SLIB's catalog. - -@node Installing Dynamic Linking, Saving Images, SLIB, Installing SCM +@node Installing Dynamic Linking, Configure Module Catalog, Building SCM, Installing SCM @section Installing Dynamic Linking @noindent @@ -1430,7 +1000,63 @@ when linking, compile and link against the file @end quotation -@node Saving Images, Automatic C Preprocessor Definitions, Installing Dynamic Linking, Installing SCM +@node Configure Module Catalog, Saving Images, Installing Dynamic Linking, Installing SCM +@section Configure Module Catalog + +@noindent +The SLIB module @dfn{catalog} can be extended to define other +@code{require}-able packages by adding calls to the Scheme source file +@file{mkimpcat.scm}. Within @file{mkimpcat.scm}, the following +procedures are defined. + +@defun add-link feature object-file lib1 @dots{} +@var{feature} should be a symbol. @var{object-file} should be a string +naming a file containing compiled @dfn{object-code}. Each @var{lib}n +argument should be either a string naming a library file or @code{#f}. + +If @var{object-file} exists, the @code{add-link} procedure registers +symbol @var{feature} so that the first time @code{require} is called +with the symbol @var{feature} as its argument, @var{object-file} and the +@var{lib1} @dots{} are dynamically linked into the executing SCM +session. + +If @var{object-file} exists, @code{add-link} returns @code{#t}, +otherwise it returns @code{#f}. + +For example, to install a compiled dll @file{foo}, add these lines to +@file{mkimpcat.scm}: + +@example + (add-link 'foo + (in-vicinity (implementation-vicinity) "foo" + link:able-suffix)) +@end example + + +@end defun + +@defun add-alias alias feature +@var{alias} and @var{feature} are symbols. The procedure +@code{add-alias} registers @var{alias} as an alias for @var{feature}. +An unspecified value is returned. + +@code{add-alias} causes @code{(require '@var{alias})} to behave like +@code{(require '@var{feature})}. +@end defun + +@defun add-source feature filename +@var{feature} is a symbol. @var{filename} is a string naming a file +containing Scheme source code. The procedure @code{add-source} +registers @var{feature} so that the first time @code{require} is called +with the symbol @var{feature} as its argument, the file @var{filename} +will be @code{load}ed. An unspecified value is returned. +@end defun + +@noindent +Remember to delete the file @file{slibcat} after modifying the file +@file{mkimpcat.scm} in order to force SLIB to rebuild its cache. + +@node Saving Images, Automatic C Preprocessor Definitions, Configure Module Catalog, Installing SCM @section Saving Images @noindent @@ -1479,6 +1105,7 @@ __ZTC__ Zortech C _AIX AIX operating system AMIGA SAS/C 5.10 or Dice C on AMIGA +__amigados__ Gnu CC on AMIGA atarist ATARI-ST under Gnu CC GNUDOS DJGPP (obsolete in version 1.08) __GO32__ DJGPP (future?) @@ -1489,23 +1116,32 @@ MSDOS Microsoft C 5.10 and 6.00A __MSDOS__ Turbo C, Borland C, and DJGPP nosve Control Data NOS/VE SVR2 System V Revision 2. +__svr4__ SunOS THINK_C developement environment for the Macintosh ultrix VAX with ULTRIX operating system. unix most Unix and similar systems and DJGPP (!?) __unix__ Gnu CC and DJGPP _UNICOS Cray operating system +vaxc VAX C compiler +VAXC VAX C compiler +vax11c VAX C compiler +VAX11 VAX C compiler _Windows Borland C 3.1 compiling for Windows _WIN32 MS VisualC++ 4.2 under Windows-NT vms (and VMS) VAX-11 C under VMS. +__alpha DEC Alpha processor +__alpha__ DEC Alpha processor hp9000s800 HP RISC processor __i386__ DJGPP i386 DJGPP MULTIMAX Encore computer pyr Pyramid 9810 processor +__sgi__ Silicon Graphics Inc. sparc SPARC processor sequent Sequent computer tahoe CCI Tahoe processor +vax VAX processor @end example @node Problems Compiling, Problems Linking, Automatic C Preprocessor Definitions, Installing SCM @@ -1700,186 +1336,281 @@ and date of that distribution. In this case, corresponding with the vendor is recommended. @end enumerate -@node The Language, Packages, Installing SCM, Top -@chapter The Language - -This section describes features which are either present in all builds -of SCM or which must be enabled when SCM is compiled. +@node Operational Features, The Language, Installing SCM, Top +@chapter Operational Features @menu -* Standards Compliance:: Links to sections in [R4RS] and [SLIB] -* System Interface:: Like how to exit +* Invoking SCM:: +* SCM Options:: +* Invocation Examples:: +* SCM Variables:: +* SCM Session:: +* Editing Scheme Code:: +* Debugging Scheme Code:: * Errors:: -* Memoized Expressions:: What #@@0+1 and #@@? mean -* Internal State:: GC, errors, and diagnostics -* Miscellaneous Procedures:: -* Time:: Both real time and processor time -* Interrupts:: and exceptions -* Process Synchronization:: Because interrupts are preemptive -* Files and Ports:: -* Soft Ports:: Emulate I/O devices -* Syntax Extensions:: and how to Define New Syntax -* Low Level Syntactic Hooks:: +* Memoized Expressions:: +* Internal State:: +* Shell Scripts:: @end menu -@node Standards Compliance, System Interface, The Language, The Language -@section Standards Compliance +@node Invoking SCM, SCM Options, Operational Features, Operational Features +@section Invoking SCM + +@quotation +@exdent @b{ scm } [-a @i{kbytes}] [-ibvqmu] [-p @i{number}] +@w{[-c @i{expression}]} @w{[-e @i{expression}]} @w{[-f @i{filename}]} +@w{[-l @i{filename}]} @w{[-r @i{feature}]} @w{[-- | - | -s]} +@w{[@i{filename}]} @w{[@i{arguments} @dots{}]} +@end quotation @noindent -Scm conforms to the -@ifset html -[IEEE], -@end ifset -@cite{IEEE Standard 1178-1990. IEEE Standard for the Scheme Programming -Language.} -@ifclear html -(@pxref{Bibliography}), -@end ifclear -and -@ifset html -[R4RS], <A HREF="r4rs_toc.html"> -@end ifset -@cite{Revised(4) Report on the Algorithmic Language Scheme}. -@ifset html -</A> -@end ifset -@ifinfo -@ref{Top, , , r4rs, Revised(4) Report on the Algorithmic Language -Scheme}. -@end ifinfo -All the required features of these specifications are supported. -Many of the optional features are supported as well. +Upon startup @code{scm} loads the file specified by by the environment +variable @var{SCM_INIT_PATH}. -@subheading Optionals of [R4RS] Supported by SCM +@noindent +If @var{SCM_INIT_PATH} is not defined or if the file it names is not +present, @code{scm} tries to find the directory containing the +executable file. If it is able to locate the executable, @code{scm} +looks for the initialization file (usually @file{Init.scm}) in +platform-dependent directories relative to this directory. +@xref{File-System Habitat} for a blow-by-blow description. -@table @asis -@item two clause @code{if}: @code{(if <test> <consequent>)} -@xref{Conditionals, , , r4rs, Revised(4) Scheme}. -@item @code{let*} -@itemx named @code{let} -@xref{Binding constructs, , , r4rs, Revised(4) Scheme}. -@item @code{do} -@xref{Iteration, , , r4rs, Revised(4) Scheme}. -@item All varieties of @code{define} -@xref{Definitions, , , r4rs, Revised(4) Scheme}. -@item @code{list-tail} -@xref{Pairs and lists, , , r4rs, Revised(4) Scheme}. -@item @code{string-copy} -@itemx @code{string-fill!} -@xref{Strings, , , r4rs, Revised(4) Scheme}. -@item @code{make-vector} of two arguments -@itemx @code{vector-fill!} -@xref{Vectors, , , r4rs, Revised(4) Scheme}. -@item @code{apply} of more than 2 arguments -@xref{Control features, , , r4rs, Revised(4) Scheme}. -@item @code{-} and @code{/} of more than 2 arguments -@itemx @code{exp} -@itemx @code{log} -@itemx @code{sin} -@itemx @code{cos} -@itemx @code{tan} -@itemx @code{asin} -@itemx @code{acos} -@itemx @code{atan} -@itemx @code{sqrt} -@itemx @code{expt} -@itemx @code{make-rectangular} -@itemx @code{make-polar} -@itemx @code{real-part} -@itemx @code{imag-part} -@itemx @code{magnitude} -@itemx @code{angle} -@itemx @code{exact->inexact} -@itemx @code{inexact->exact} -@xref{Numerical operations, , , r4rs, Revised(4) Scheme}. -@item @code{delay} -@itemx @code{force} -@xref{Control features, , , r4rs, Revised(4) Scheme}. -@itemx @code{with-input-from-file} -@itemx @code{with-output-to-file} -@xref{Ports, , , r4rs, Revised(4) Scheme}. -@itemx @code{char-ready?} -@xref{Input, , , r4rs, Revised(4) Scheme}. -@itemx @code{transcript-on} -@itemx @code{transcript-off} -@xref{System interface, , , r4rs, Revised(4) Scheme}. -@end table +@noindent +As a last resort (if initialization file cannot be located), the C +compile parameter @var{IMPLINIT} (defined in the makefile or +@file{scmfig.h}) is tried. -@subheading Optionals of [R4RS] not Supported by SCM +@noindent +Unless the option @code{-no-init-file} or @code{--no-init-file} occurs +in the command line, @file{Init.scm} checks to see if there is file +@file{ScmInit.scm} in the path specified by the environment variable +@var{HOME} (or in the current directory if @var{HOME} is undefined). If +it finds such a file it is loaded. -@table @asis -@item @code{numerator} -@itemx @code{denominator} -@itemx @code{rationalize} -@xref{Numerical operations, , , r4rs, Revised(4) Scheme}. -@item [R4RS] appendix Macros -@xref{Macros, , , r4rs, Revised(4) Scheme}. -@end table +@noindent +@file{Init.scm} then looks for command input from one of three sources: +From an option on the command line, from a file named on the command +line, or from standard input. -@subheading [SLIB] Features of SCM and SCMLIT +@noindent +This explanation applies to SCMLIT or other builds of SCM. -@table @code -@item delay -@itemx full-continuation -@itemx ieee-p1178 -@itemx object-hash -@itemx rev4-report -@itemx source -See SLIB file @file{Template.scm}. -@item current-time -@xref{Time, , , slib, SLIB}. -@item defmacro -@xref{Defmacro, , , slib, SLIB}. -@item dynamic-wind -@xref{Dynamic-Wind, , , slib, SLIB}. -@item eval -@xref{System, , , slib, SLIB}. -@item getenv -@itemx system -@xref{System Interface, , , slib, SLIB}. -@item hash -@xref{Hashing, , , slib, SLIB}. -@item logical -@xref{Bit-Twiddling, , , slib, SLIB}. -@item multiarg-apply -@xref{Multi-argument Apply, , , slib, SLIB}. -@item multiarg/and- -@xref{Multi-argument / and -, , , slib, SLIB}. -@item rev4-optional-procedures -@xref{Rev4 Optional Procedures, , , slib, SLIB}. -@item string-port -@xref{String Ports, , , slib, SLIB}. -@item tmpnam -@xref{Input/Output, , , slib, SLIB}. -@item transcript -@xref{Transcripts, , , slib, SLIB}. -@item vicinity -@xref{Vicinity, , , slib, SLIB}. -@item with-file -@xref{With-File, , , slib, SLIB}. -@end table +@noindent +Scheme-code files can also invoke SCM and its variants. @xref{Syntax +Extensions, #!}. -@subheading [SLIB] Features of SCM +@node SCM Options, Invocation Examples, Invoking SCM, Operational Features +@section Options + +@noindent +The options are processed in the order specified on the command line. + +@deffn {Command Option} -a kb +specifies that @code{scm} should allocate an initial heapsize of +@var{kb} kilobytes. This option, if present, must be the first on +the command line. If not specified, the default is +@code{INIT_HEAP_SIZE} in source file @file{setjump.h} which the +distribution sets at @code{25000*sizeof(cell)}. +@end deffn + +@deffn {Command Option} -no-init-file +@deffnx {Command Option} --no-init-file +Inhibits the loading of @file{ScmInit.scm} as described above. +@end deffn + +@deffn {Command Option} -e expression +@deffnx {Command Option} -c expression +specifies that the scheme expression @var{expression} is to be +evaluated. These options are inspired by @code{perl} and @code{sh} +respectively. On Amiga systems the entire option and argument need to be +enclosed in quotes. For instance @samp{"-e(newline)"}. +@end deffn + +@deffn {Command Option} -r feature +requires @var{feature}. This will load a file from [SLIB] if that +@var{feature} is not already supported. If @var{feature} is 2, 3, 4, or +5 @code{scm} will require the features neccessary to support [R2RS], +[R3RS], [R4RS], or proposed [R5RS], respectively. +@end deffn + +@deffn {Command Option} -l filename +@deffnx {Command Option} -f filename +loads @var{filename}. @code{Scm} will load the first (unoptioned) file +named on the command line if no @code{-c}, @code{-e}, @code{-f}, +@code{-l}, or @code{-s} option preceeds +it. +@end deffn + +@deffn {Command Option} -p level +sets the prolixity (verboseness) to @var{level}. This is the same as +the @code{scm} command (verobse @var{level}). +@end deffn + +@deffn {Command Option} -v +(verbose mode) specifies that @code{scm} will print prompts, evaluation +times, notice of loading files, and garbage collection statistics. This +is the same as @code{-p3}. +@end deffn + +@deffn {Command Option} -q +(quiet mode) specifies that @code{scm} will print no extra +information. This is the same as @code{-p0}. +@end deffn + +@deffn {Command Option} -m +specifies that subsequent loads, evaluations, and user interactions will +be with [R4RS] macro capability. To use a specific [R4RS] macro +implementation from [SLIB] (instead of [SLIB]'s default) put @code{-r} +@var{macropackage} before @code{-m} on the command line. +@end deffn + +@deffn {Command Option} -u +specifies that subsequent loads, evaluations, and user interactions will +be without [R4RS] macro capability. [R4RS] macro capability can +be restored by a subsequent @code{-m} on the command line or from Scheme +code. +@end deffn + +@deffn {Command Option} -i +specifies that @code{scm} should run interactively. That means that +@code{scm} will not terminate until the @code{(quit)} or @code{(exit)} +command is given, even if there are errors. It also sets the prolixity +level to 2 if it is less than 2. This will print prompts, evaluation +times, and notice of loading files. The prolixity level can be set by +subsequent options. If @code{scm} is started from a tty, it will assume +that it should be interactive unless given a subsequent @code{-b} +option. +@end deffn + +@deffn {Command Option} -b +specifies that @code{scm} should run non-interactively. That means that +@code{scm} will terminate after processing the command line or if there +are errors. +@end deffn + +@deffn {Command Option} -s +specifies, by analogy with @code{sh}, that further options are to be +treated as program aguments. +@end deffn + +@deffn {Command Option} - +@deffnx {Command Option} -- +specifies that there are no more options on the command line. +@end deffn + +@deffn {Command Option} -d filename +loads SLIB database-utilities and opens @var{filename} as a database. +@end deffn + +@deffn {Command Option} -o filename +saves the current SCM session as the executable program @file{filename}. +This option works only in SCM builds supporting @code{dump} +(@pxref{Dump}). + +If options appear on the command line after @samp{-o @var{filename}}, +then the saved session will continue with processing those options when +it is invoked. Otherwise the (new) command line is processed as usual +when the saved image is invoked. +@end deffn + +@deffn {Command Option} --help +prints usage information and URL; then exit. +@end deffn + +@deffn {Command Option} --version +prints version information and exit. +@end deffn + +@node Invocation Examples, SCM Variables, SCM Options, Operational Features +@section Invocation Examples @table @code -@item array -@xref{Arrays, , , slib, SLIB}. -@item array-for-each -@xref{Array Mapping, , , slib, SLIB}. -@item bignum -@itemx complex -@itemx inexact -@itemx rational -@itemx real -@xref{Require, , , slib, SLIB}. +@item % scm foo.scm +Loads and executes the contents of @file{foo.scm} and then enters +interactive session. + +@item % scm -f foo.scm arg1 arg2 arg3 +Parameters @code{arg1}, @code{arg2}, and @code{arg3} are stored in the +global list @code{*argv*}; Loads and executes the contents of +@file{foo.scm} and exits. + +@item % scm -s foo.scm arg1 arg2 +Sets *argv* to @code{("foo.scm" "arg1" "arg2")} and enters interactive +session. + +@item % scm -e `(write (list-ref *argv* *optind*))' bar +Prints @samp{"bar"}. + +@item % scm -rpretty-print -r format -i +Loads @code{pretty-print} and @code{format} and enters interactive +session. + +@item % scm -r5 +Loads @code{dynamic-wind}, @code{values}, and [R4RS] macros and enters +interactive (with macros) session. + +@item % scm -r5 -r4 +Like above but @code{rev4-optional-procedures} are also loaded. @end table -@node System Interface, Errors, Standards Compliance, The Language -@section System Interface +@node SCM Variables, SCM Session, Invocation Examples, Operational Features +@section Environment Variables -@noindent -For documentation of the procedures @code{getenv} and @code{system} -@xref{System Interface, , , slib, SLIB}. +@defvr {Environment Variable} SCM_INIT_PATH +is the pathname where @code{scm} will look for its initialization +code. The default is the file @file{Init.scm} in the source directory. +@end defvr + +@defvr {Environment Variable} SCHEME_LIBRARY_PATH +is the [SLIB] Scheme library directory. +@end defvr + +@defvr {Environment Variable} HOME +is the directory where @file{Init.scm} will look for the user +initialization file @file{ScmInit.scm}. +@end defvr + +@defvr {Environment Variable} EDITOR +is the name of the program which @code{ed} will call. If @var{EDITOR} +is not defined, the default is @samp{ed}. +@end defvr + +@section Scheme Variables + +@defvar *argv* +contains the list of arguments to the program. @code{*argv*} can change +during argument processing. This list is suitable for use as an argument +to [SLIB] @code{getopt}. +@end defvar + +@defvar *R4RS-macro* +controls whether loading and interaction support [R4RS] macros. Define +this in @file{ScmInit.scm} or files specified on the command line. This +can be overridden by subsequent @code{-m} and @code{-u} options. +@end defvar + +@defvar *interactive* +controls interactivity as explained for the @code{-i} and @code{-b} +options. Define this in @file{ScmInit.scm} or files specified on the +command line. This can be overridden by subsequent @code{-i} and +@code{-b} options. +@end defvar + +@node SCM Session, Editing Scheme Code, SCM Variables, Operational Features +@section SCM Session + +@itemize @bullet +@item +Options, file loading and features can be specified from the command +line. @xref{System interface, , , scm, SCM}. @xref{Require, , , slib, +SLIB}. +@item +Typing the end-of-file character at the top level session (while SCM is +not waiting for parenthesis closure) causes SCM to exit. +@item +Typing the interrupt character aborts evaluation of the current form +and resumes the top level read-eval-print loop. +@end itemize @defun quit @defunx quit n @@ -1890,42 +1621,193 @@ systems, SCM can also tail-call another program. @xref{I/O-Extensions, execp}. @end defun +@defun program-arguments +Returns a list of strings of the arguments scm was called with. +@end defun + +@noindent +For documentation of the procedures @code{getenv} and @code{system} +@xref{System Interface, , , slib, SLIB}. + @defun vms-debug -If SCM is compiled under VMS these commands will invoke the editor or -debugger respectively. +If SCM is compiled under VMS this @code{vms-debug} will invoke the VMS +debugger. @end defun -@defun ed filename + +@node Editing Scheme Code, Debugging Scheme Code, SCM Session, Operational Features +@section Editing Scheme Code + +@defun ed arg1 @dots{} +The value of the environment variable @code{EDITOR} (or just @code{ed} +if it isn't defined) is invoked as a command with arguments @var{arg1} +@dots{}. + +@defunx ed filename If SCM is compiled under VMS @code{ed} will invoke the editor with a single the single argument @var{filename}. - -@defunx ed arg1 @dots{} -Otherwise, the value of the environment variable @code{EDITOR} (or just -@code{ed} if it isn't defined) is invoked as a command with arguments -@var{arg1} @dots{}. @end defun -@defun program-arguments -Returns a list of strings of the arguments scm was called with. -@end defun -@defun errno -@defunx errno n -With no argument returns the current value of the system variable -@code{errno}. When given an argument, @code{errno} sets the system -variable @code{errno} to @var{n} and returns the previous value of -@code{errno}. @code{(errno 0)} will clear outstanding errors. This is -recommended after @code{try-load} returns @code{#f} since this occurs -when the file could not be opened. -@end defun +@table @asis +@item Gnu Emacs: +Editing of Scheme code is supported by emacs. Buffers holding files +ending in .scm are automatically put into scheme-mode. EMACS for MS-DOS +and MS-Windows systems is available (free) from: -@defun perror string -Prints on standard error output the argument @var{string}, a colon, -followed by a space, the error message corresponding to the current -value of @code{errno} and a newline. The value returned is unspecified. -@end defun +@ifclear html +@itemize @bullet +@item +http://simtel.coast.net/SimTel/gnu/demacs.html +@end itemize +@end ifclear + +@ifset html +<A HREF="http://simtel.coast.net/SimTel/gnu/demacs.html"> +http://simtel.coast.net/SimTel/gnu/demacs.html +</A> +@end ifset + +If your Emacs can run a process in a buffer you can use the Emacs +command @samp{M-x run-scheme} with SCM. Otherwise, use the emacs +command @samp{M-x suspend-emacs}; or see ``other systems'' below. + +@item Epsilon (MS-DOS): +There is lisp (and scheme) mode available by use of the package +@samp{LISP.E}. It offers several different indentation formats. With +this package, buffers holding files ending in @samp{.L}, @samp{.LSP}, +@samp{.S}, and @samp{.SCM} (my modification) are automatically put into +lisp-mode. + +It is possible to run a process in a buffer under Epsilon. With Epsilon +5.0 the command line options @samp{-e512 -m0} are neccessary to manage +RAM properly. It has been reported that when compiling SCM with Turbo +C, you need to @samp{#define NOSETBUF} for proper operation in a process +buffer with Epsilon 5.0. + +One can also call out to an editor from SCM if RAM is at a premium; See +``under other systems'' below. + +@item other systems: +Define the environment variable @samp{EDITOR} to be the name of the +editing program you use. The SCM procedure @code{(ed arg1 @dots{})} +will invoke your editor and return to SCM when you exit the editor. The +following definition is convenient: + +@example +(define (e) (ed "work.scm") (load "work.scm")) +@end example + +Typing @samp{(e)} will invoke the editor with the file of interest. +After editing, the modified file will be loaded. +@end table + +@node Debugging Scheme Code, Errors, Editing Scheme Code, Operational Features +@section Debugging Scheme Code + +@noindent +The @code{cautious} and @code{stack-limit} options of @code{build} +(@pxref{Build Options}) support debugging in Scheme. + +@table @dfn +@item CAUTIOUS +If SCM is built with the @samp{CAUTIOUS} flag, then when an error +occurs, a @dfn{stack trace} of certain pending calls are printed as part +of the default error response. A (memoized) expression and newline are +printed for each partially evaluated combination whose procedure is not +builtin. @xref{Memoized Expressions} for how to read memoized +expressions. + +Also as the result of the @samp{CAUTIOUS} flag, both @code{error} and +@code{user-interrupt} (invoked by @key{C-c}) to print stack traces and +conclude by calling @code{breakpoint} (@pxref{Breakpoints, , , slib, +SLIB}) instead of aborting to top level. Under either condition, +program execution can be resumed by @code{(continue)}. -@node Errors, Memoized Expressions, System Interface, The Language +In this configuration one can interrupt a running Scheme program with +@key{C-c}, inspect or modify top-level values, trace or untrace +procedures, and continue execution with @code{(continue)}. + +@item STACK_LIMIT +If SCM is built with the @samp{STACK_LIMIT} flag, the interpreter will +check stack size periodically. If the size of stack exceeds a certain +amount (default is @code{HEAP_SEG_SIZE/2}), SCM generates a +@code{segment violation} interrupt. + +The usefulness of @samp{STACK_LIMIT} depends on the user. I don't use +it; but the user I added this feature for got primarily this type of +error. +@end table + +@noindent +There are several SLIB macros which so useful that SCM automatically +loads the appropriate module from SLIB if they are invoked. + +@defmac trace proc1 @dots{} +Traces the top-level named procedures given as arguments. +@defmacx trace +With no arguments, makes sure that all the currently traced identifiers +are traced (even if those identifiers have been redefined) and returns a +list of the traced identifiers. +@end defmac + +@defmac untrace proc1 @dots{} +Turns tracing off for its arguments. +@defmacx untrace +With no arguments, untraces all currently traced identifiers and returns +a list of these formerly traced identifiers. +@end defmac + +The routines I use most frequently for debugging are: + +@deffn Procedure print arg1 @dots{} +@code{Print} writes all its arguments, separated by spaces. +@code{Print} outputs a @code{newline} at the end and returns the value +of the last argument. + +One can just insert @samp{(print '<proc-name>} and @samp{)} around an +expression in order to see its value as a program operates. +@end deffn + +@deffn Syntax print-args name1 @dots{} +Writes @var{name1} @dots{} (separated by spaces) and then writes the +values of the closest lexical bindings enclosing the call to +@code{Print-args}. + +@example +(define (foo a b) (print-args foo) (+ a b)) +(foo 3 6) +@print{} In foo: a = 3; b = 6; +@result{} 9 +@end example +@end deffn + +@noindent +Sometimes more elaborate measures are needed to print values in a useful +manner. When the values to be printed may have very large (or infinite) +external representations, @ref{Quick Print, , , slib, SLIB}, can be +used. + +When @code{trace} is not sufficient to find program flow problems, +@ifset html +<A HREF="http://www.cs.tut.fi/staff/pk/scheme/psd/article/article.html"> +@end ifset +SLIB-PSD, the Portable Scheme Debugger +@ifset html +</A> +@end ifset +offers source code debugging from +GNU Emacs. PSD runs slowly, so start by instrumenting only a few +functions at a time. +@lisp +ftp-swiss.ai.mit.edu:pub/scm/slib-psd1-3.tar.gz +prep.ai.mit.edu:pub/gnu/jacal/slib-psd1-3.tar.gz +ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz +ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz +@end lisp + + +@node Errors, Memoized Expressions, Debugging Scheme Code, Operational Features @section Errors @noindent @@ -1983,21 +1865,49 @@ alarm @code{(alarm-interrupt)} @end enumerate @defvar errobj -If SCM encounters a non-fatal error it aborts evaluation of the current -form, prints a message explaining the error, and resumes the top level -read-eval-print loop. The value of @var{errobj} is the offending object -if appropriate. The builtin procedure @code{error} does @emph{not} set -@var{errobj}. +When SCM encounters a non-fatal error, it aborts evaluation of the +current form, prints a message explaining the error, and resumes the top +level read-eval-print loop. The value of @var{errobj} is the offending +object if appropriate. The builtin procedure @code{error} does +@emph{not} set @var{errobj}. @end defvar -@defun error arg1 arg2 arg3 @dots{} -Alias for @ref{System, error, , slib, SLIB}. Outputs an error message -containing the arguments, aborts evaluation of the current form and -resumes the top level read-eval-print loop. Error is defined in -@file{Init.scm}; Feel free to redefine it to suit your purposes. +@noindent +@code{errno} and @code{perror} report ANSI C errors encountered during a +call to a system or library function. + +@defun errno +@defunx errno n +With no argument returns the current value of the system variable +@code{errno}. When given an argument, @code{errno} sets the system +variable @code{errno} to @var{n} and returns the previous value of +@code{errno}. @code{(errno 0)} will clear outstanding errors. This is +recommended after @code{try-load} returns @code{#f} since this occurs +when the file could not be opened. @end defun -@subsection CAUTIOUS enhancements +@defun perror string +Prints on standard error output the argument @var{string}, a colon, +followed by a space, the error message corresponding to the current +value of @code{errno} and a newline. The value returned is unspecified. +@end defun + +@noindent +@code{warn} and @code{error} provide a uniform way for Scheme code to +signal warnings and errors. + +@defun warn arg1 arg2 arg3 @dots{} +Alias for @ref{System, slib:warn, , slib, SLIB}. Outputs an error +message containing the arguments. @code{warn} is defined in +@file{Init.scm}. +@end defun + +@defun error arg1 arg2 arg3 @dots{} +Alias for @ref{System, slib:error, , slib, SLIB}. Outputs an error +message containing the arguments, aborts evaluation of the current form +and resumes the top level read-eval-print loop. @code{Error} is defined +in @file{Init.scm}. +@end defun @noindent If SCM is built with the @samp{CAUTIOUS} flag, then when an error @@ -2021,7 +1931,7 @@ printed and @code{#f} otherwise. See @file{Init.scm} for an example of the use of @code{stack-trace}. @end defun -@node Memoized Expressions, Internal State, Errors, The Language +@node Memoized Expressions, Internal State, Errors, Operational Features @section Memoized Expressions @noindent @@ -2097,7 +2007,7 @@ open-input-file @result{} @end example -@node Internal State, Miscellaneous Procedures, Memoized Expressions, The Language +@node Internal State, Shell Scripts, Memoized Expressions, Operational Features @section Internal State @defvar *interactive* @@ -2162,14 +2072,443 @@ also gives the hexadecimal heap segment and stack bounds. @end defun @defvr Constant *scm-version* -Contains the version string (e.g. @file{4e6}) of SCM. +Contains the version string (e.g. @file{5b3}) of SCM. @end defvr +@subsection Executable path + +@noindent +In order to dump a saved executable or to dynamically-link using DLD, +SCM must know where its executable file is. Sometimes SCM +(@pxref{Executable Pathname}) guesses incorrectly the location of the +currently running executable. In that case, the correct path can be set +by calling @code{execpath} with the pathname. + +@defun execpath +Returns the path (string) which SCM uses to find the executable file +whose invocation the currently running session is, or #f if the path is +not set. +@defunx execpath #f +@defunx execpath newpath +Sets the path to @code{#f} or @var{newpath}, respectively. The old path +is returned. +@end defun + @noindent For other configuration constants and procedures @xref{Configuration, , , slib, SLIB}. -@node Miscellaneous Procedures, Time, Internal State, The Language + +@node Shell Scripts, , Internal State, Operational Features +@section Shell Scripts + +@menu +* Unix Shell Scripts:: Same old same old +* SCSH scripts:: From Olin Shivers' Scheme Shell +* MS-DOS Compatible Scripts:: Run under both MS-DOS and Unix +@end menu + +@node Unix Shell Scripts, SCSH scripts, Shell Scripts, Shell Scripts +@subsection Unix Shell Scripts + +@noindent +In reading this section, keep in mind that the first line of a script +file has (different) meanings to SCM and the operating system +(@code{execve}). + +@deftp file #! interpreter +@deftpx file #! interpreter arg + +@tindex Shell Script +@tindex Shell-Script +On unix systems, a @dfn{Shell-Script} is a file (with execute +permissions) whose first two characters are @samp{#!}. The +@var{interpreter} argument must be the pathname of the program to +process the rest of the file. The directories named by environment +variable @code{PATH} are @emph{not} searched to find @var{interpreter}. +The @var{arg} is an optional argument encapsulating the rest of the +first line's contents, if not just whitespace. + +When executing a shell-script, the operating system invokes +@var{interpreter} with (if present) @var{arg}, the pathname of the shell +script file, and then any arguments which the shell-script was invoked +with. +@end deftp + +@deffn {Read syntax} #! ignored +When the first two characters of the file being loaded are @code{#!}, +the first line of that file will be ignored. +@end deffn + +@noindent +This combination of interpretatons allows SCM source files to be used as +POSIX shell-scripts if the first line is: + +@example +#!/usr/local/bin/scm +@end example +or +@example +#!/usr/local/bin/scm -l +@end example + +@noindent +When such a file is invoked, /usr/local/bin/scm is executed with the +name of this file as the first argument. +@example +#!/usr/local/bin/scm +(print (program-arguments)) +(quit) +@result{} ("scm" "./script") +@end example + +@example +#!/usr/local/bin/scm -l +(print (program-arguments)) +@result{} ("scm" "-l" "./script") +@end example + +@noindent +The following shell-script will print factorial of its argument: +@example +#!/usr/local/bin/scm -l +(define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) +(print (fact (string->number (cadddr (program-arguments))))) +@end example + +@example +./fact 6 +@result{} 720 +@end example + +@noindent +Shell-scripts suffer from several drawbacks: +@itemize @bullet +@item +Some Unixes limit the length of the @samp{#!} interpreter line to the +size of an object file header, which can be as small as 32 bytes. +@item +A full, explicit pathname must be specified, perhaps requiring more than +32 bytes and making scripts vulnerable to breakage when programs are +moved. +@item +At most one argument is parsed from the first line of the shell-script. +Its position is fixed between the interpreter and any command line +arguments. +@end itemize + +@noindent +The following approach solves these problems at the expense of slower +startup. Make @samp{#!/bin/sh} the first line and prepend every +subsequent line to be executed by the shell with @code{:;} (@code{type;} +in older versions). The last line to be executed by the shell should +contain an @dfn{exec} command; @code{exec} tail-calls its argument. + +@noindent +@code{/bin/sh} is thus invoked with the name of the script file, which +it executes as a *sh script. Usually the second line starts +@samp{:;exec scm -f$0}, which executes scm, which in turn loads the +script file. When SCM loads the script file, it ignores the first and +second lines, and evaluates the rest of the file as Scheme source code. + +@noindent +The second line of the script file does not have the length restriction +mentioned above. Also, @code{/bin/sh} searches the directories listed +in the `PATH' environment variable for @samp{scm}, eliminating the need +to use absolute locations in order to invoke a program. + +@example +#!/bin/sh +:;exec scm -l$0 $* +(define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) +(print (fact (string->number (caddr (program-arguments))))) +@end example + +@example +./fact 6 +@result{} 720 +@end example + +@node SCSH scripts, MS-DOS Compatible Scripts, Unix Shell Scripts, Shell Scripts +@subsection SCSH scripts + +@noindent +Olin Shivers' @dfn{Scheme Shell} project solves the one-argument +limitation by introducing @samp{\} as a @dfn{meta-argument}. This +extensions is also supported by SCM. + +@deftp file #! interpreter \ + +@tindex Shell Script +@tindex shell-script +@tindex meta-argument +This is an enhancement to the shell-script format. When the optional +@var{arg} is @samp{\}, the @var{interpreter} substitutes the second +line of @var{file} for @samp{\}, then appends any arguments given on +the command line invoking this shell-script. +@end deftp + +@deffn {Read syntax} #! ignored !# +When the first two characters of the file being loaded are @code{#!} and +a @samp{\} is present before a newline in the file, all characters up +to @samp{!#} will be ignored by SCM @code{read}. +@end deffn + +@noindent +This combination of interpretatons allows SCM source files to be used as +POSIX shell-scripts if the first line is: + +@example +#!/usr/local/bin/scm \ +@end example + +@noindent +The following shell-script will print its expanded argument list, then +factorial of its argument: + +@example +#!/usr/local/bin/scm \ + -p0 -l !# +(print (program-arguments)) +(define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) +(print (fact (string->number (list-ref (program-arguments) *optind*)))) +@end example + +@example +./fact 5 +@result{} ("scm" "-p0" "-l" "./fact" "5") +120 +@end example + + +@node MS-DOS Compatible Scripts, , SCSH scripts, Shell Scripts +@subsection MS-DOS Compatible Scripts + +@noindent +It turns out that we can create shell-scripts which run both under unix +and MS-DOS. To implement this, I have written the MS-DOS programs: +@code{#!.bat} and @code{!#.exe}. +@pindex !# +@pindex !#.exe +@pindex #! +@pindex #!.bat + +@noindent +With these two programs installed in a @code{PATH} directory, we have +the following syntax for @var{<program>.BAT} files. + +@deftp file #! interpreter \ %0 %1 %2 %3 %4 %5 %6 %7 %8 + +@tindex Shell Script +@tindex shell-script +The first two characters of the shell-script are @samp{#!}. The +@var{interpreter} can be either a unix style program path (using +@samp{/} between filename components) or a DOS program name or path. +The rest of the first line of the shell-script should be literally +@samp{\ %0 %1 %2 %3 %4 %5 %6 %7 %8}, as shown. + +If @var{interpreter} has @samp{/} in it, @var{interpreter} is converted +to a DOS style filename (@samp{/} @result{} @samp{\}). + +In looking for an executable named @var{interpreter}, @code{#!} first +checks this (converted) filename; if @var{interpreter} doesn't exist, it +then tries to find a program named like the string starting after the +last @samp{\} (or @samp{/}) in @var{interpreter}. When searching for +executables, @code{#!} tries all directories named by environment +variable @code{PATH}. + +Once the @var{interpreter} executable path is found, arguments are +processed in the manner of scheme-shell, with the all the text after the +@samp{\} taken as part of the meta-argument. More precisely, @code{#!} +calls @var{interpreter} with any options on the second line of the +shell-script up to @samp{!#}, the name of the shell-script file, and +then any of at most 8 arguments given on the command line invoking this +shell-script. +@end deftp + +@noindent +The following shell-script will print its expanded argument list, then +factorial of its argument. This shell-script in both MS-DOS and unix +systems. + +@example +#! /usr/local/bin/scm \ %0 %1 %2 %3 %4 %5 %6 %7 %8 + -p1 -l !# +(print (program-arguments)) +(define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) +(print (fact (string->number (list-ref (program-arguments) *optind*)))) +@end example + + +@node The Language, Packages, Operational Features, Top +@chapter The Language + +@menu +* Standards Compliance:: Links to sections in [R4RS] and [SLIB] +* Miscellaneous Procedures:: +* Time:: Both real time and processor time +* Interrupts:: and exceptions +* Process Synchronization:: Because interrupts are preemptive +* Files and Ports:: +* Soft Ports:: Emulate I/O devices +* Syntax Extensions:: +* Low Level Syntactic Hooks:: +* Syntactic Hooks for Hygienic Macros:: +@end menu + +@node Standards Compliance, Miscellaneous Procedures, The Language, The Language +@section Standards Compliance + +@noindent +Scm conforms to the +@ifset html +[IEEE], +@end ifset +@cite{IEEE Standard 1178-1990. IEEE Standard for the Scheme Programming +Language.} +@ifclear html +(@pxref{Bibliography}), +@end ifclear +and +@ifset html +[R4RS], <A HREF="r4rs_toc.html"> +@end ifset +@cite{Revised(4) Report on the Algorithmic Language Scheme}. +@ifset html +</A> +@end ifset +@ifinfo +@ref{Top, , , r4rs, Revised(4) Report on the Algorithmic Language +Scheme}. +@end ifinfo +All the required features of these specifications are supported. +Many of the optional features are supported as well. + +@subheading Optionals of [R4RS] Supported by SCM + +@table @asis +@item two clause @code{if}: @code{(if <test> <consequent>)} +@xref{Conditionals, , , r4rs, Revised(4) Scheme}. +@item @code{let*} +@itemx named @code{let} +@xref{Binding constructs, , , r4rs, Revised(4) Scheme}. +@item @code{do} +@xref{Iteration, , , r4rs, Revised(4) Scheme}. +@item All varieties of @code{define} +@xref{Definitions, , , r4rs, Revised(4) Scheme}. +@item @code{list-tail} +@xref{Pairs and lists, , , r4rs, Revised(4) Scheme}. +@item @code{string-copy} +@itemx @code{string-fill!} +@xref{Strings, , , r4rs, Revised(4) Scheme}. +@item @code{make-vector} of two arguments +@itemx @code{vector-fill!} +@xref{Vectors, , , r4rs, Revised(4) Scheme}. +@item @code{apply} of more than 2 arguments +@xref{Control features, , , r4rs, Revised(4) Scheme}. +@item @code{-} and @code{/} of more than 2 arguments +@itemx @code{exp} +@itemx @code{log} +@itemx @code{sin} +@itemx @code{cos} +@itemx @code{tan} +@itemx @code{asin} +@itemx @code{acos} +@itemx @code{atan} +@itemx @code{sqrt} +@itemx @code{expt} +@itemx @code{make-rectangular} +@itemx @code{make-polar} +@itemx @code{real-part} +@itemx @code{imag-part} +@itemx @code{magnitude} +@itemx @code{angle} +@itemx @code{exact->inexact} +@itemx @code{inexact->exact} +@xref{Numerical operations, , , r4rs, Revised(4) Scheme}. +@item @code{delay} +@itemx @code{force} +@xref{Control features, , , r4rs, Revised(4) Scheme}. +@itemx @code{with-input-from-file} +@itemx @code{with-output-to-file} +@xref{Ports, , , r4rs, Revised(4) Scheme}. +@itemx @code{char-ready?} +@xref{Input, , , r4rs, Revised(4) Scheme}. +@itemx @code{transcript-on} +@itemx @code{transcript-off} +@xref{System interface, , , r4rs, Revised(4) Scheme}. +@end table + +@subheading Optionals of [R4RS] not Supported by SCM + +@table @asis +@item @code{numerator} +@itemx @code{denominator} +@itemx @code{rationalize} +@xref{Numerical operations, , , r4rs, Revised(4) Scheme}. +@item [R4RS] appendix Macros +@xref{Macros, , , r4rs, Revised(4) Scheme}. +@end table + +@subheading [SLIB] Features of SCM and SCMLIT + +@table @code +@item delay +@itemx full-continuation +@itemx ieee-p1178 +@itemx object-hash +@itemx rev4-report +@itemx source +See SLIB file @file{Template.scm}. +@item current-time +@xref{Time, , , slib, SLIB}. +@item defmacro +@xref{Defmacro, , , slib, SLIB}. +@item dynamic-wind +@xref{Dynamic-Wind, , , slib, SLIB}. +@item eval +@xref{System, , , slib, SLIB}. +@item getenv +@itemx system +@xref{System Interface, , , slib, SLIB}. +@item hash +@xref{Hashing, , , slib, SLIB}. +@item logical +@xref{Bit-Twiddling, , , slib, SLIB}. +@item multiarg-apply +@xref{Multi-argument Apply, , , slib, SLIB}. +@item multiarg/and- +@xref{Multi-argument / and -, , , slib, SLIB}. +@item rev4-optional-procedures +@xref{Rev4 Optional Procedures, , , slib, SLIB}. +@item string-port +@xref{String Ports, , , slib, SLIB}. +@item tmpnam +@xref{Input/Output, , , slib, SLIB}. +@item transcript +@xref{Transcripts, , , slib, SLIB}. +@item vicinity +@xref{Vicinity, , , slib, SLIB}. +@item with-file +@xref{With-File, , , slib, SLIB}. +@end table + +@subheading [SLIB] Features of SCM + +@table @code +@item array +@xref{Arrays, , , slib, SLIB}. +@item array-for-each +@xref{Array Mapping, , , slib, SLIB}. +@item bignum +@itemx complex +@itemx inexact +@itemx rational +@itemx real +@xref{Require, , , slib, SLIB}. +@end table + +@node Miscellaneous Procedures, Time, Standards Compliance, The Language @section Miscellaneous Procedures @defun try-load filename @@ -2218,8 +2557,10 @@ new object is returned. @end defun @defun copy-tree obj +@defunx @@copy-tree obj @xref{Tree Operations, copy-tree, , slib, SLIB}. This extends the SLIB -version by also copying vectors. +version by also copying vectors. Use @code{@@copy-tree} if you +depend on this feature; @code{copy-tree} could get redefined. @end defun @defun acons obj1 obj2 obj3 @@ -2235,7 +2576,7 @@ This command displays the GNU General Public License. Displays the text contents of @var{filename}. @end defun -@deffn Procedure print arg1 ... +@deffn Procedure print arg1 @dots{} @code{Print} writes all its arguments, separated by spaces. @code{Print} outputs a @code{newline} at the end and returns the value of the last argument. @@ -2414,7 +2755,7 @@ and with-error-to-file in that the first argument is a port, rather than a string naming a file. @end defun -@deffn {procedure} char-ready? +@deffn {procedure} char-ready? @deffnx {procedure} char-ready? port Returns @code{#t} if a character is ready on the input @var{port} and @@ -2497,6 +2838,26 @@ reached end-of-file. For example: @node Syntax Extensions, Low Level Syntactic Hooks, Soft Ports, The Language @section Syntax Extensions +@deffn {procedure} procedure-documentation proc +Returns the documentation string of @var{proc} if it exists, or +@code{#f} if not. + +If the body of a @code{lambda} (or the definition of a procedure) has +more than one expression, and the first expression (preceeding any +internal definitions) is a string, then that string is the +@dfn{documentation string} of that procedure. +@cindex documentation string + +@example +(procedure-documentation (lambda (x) "Identity" x)) @result{} "Identity" +(define (square x) + "Return the square of X." + (* x x)) +@result{} #<unspecified> +(procedure-documentation square) @result{} "Return the square of X." +@end example +@end deffn + @deffn {Read syntax} #. expression Is read as the object resulting from the evaluation of @var{expression}. This substitution occurs even inside quoted structure. @@ -2537,52 +2898,9 @@ ignored by the @code{read}. Nested @code{#|@dots{}|#} can occur inside @var{any thing}. @end deffn -@deffn {Read syntax} #! any thing -On the first line of a file will be ignored when loaded by SCM. This -makes SCM files usable as POSIX shell scripts if the first line is: - -@example -#!/usr/local/bin/scm -@end example - -When such a file is invoked it executes /usr/local/bin/scm with the -name of this file as the first argument. The following shell script -will print factorial of its argument: -@example -#!/usr/local/bin/scm -;;; -*-scheme-*- tells emacs this is a scheme file. -(define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) -(display (fact (string->number (caddr (program-arguments))))) -(newline) -(quit) -@end example - -This technique has some drawbacks: -@itemize @bullet -@item -Some Unixes limit the length of the @samp{#!} interpreter line to the -size of an object file header, which can be as small as 32 bytes. -@item -A full, explicit pathname must be specified, perhaps requiring more than -32 bytes and making scripts vulnerable to programs being moved. -@end itemize - -The following approach solves both problems -- at the expense of -slightly slower startup. @code{type;} should appear on every line to be -executed by the shell. These lines do not have the length restriction -mentioned above. Also, @code{/bin/sh} searches the directories listed -in the `PATH' environment variable for @samp{scm}, eliminating the need -to know absolute locations in order to invoke a program. -@example -#!/bin/sh -type;exec scm $0 $* -;;; -*-scheme-*- tells emacs this is a scheme file. -(define (fact n) (if (< n 2) 1 (* n (fact (+ -1 n))))) -(display (fact (string->number (caddr (program-arguments))))) -(newline) -(quit) -@end example -@end deffn +@noindent +A similar read syntax @dfn{#!} (exclamation rather than vertical bar) is +supported for Posix shell-scripts (@pxref{Shell Scripts}). @defspec defined? symbol Equivalent to @code{#t} if @var{symbol} is a syntactic keyword (such as @@ -2606,7 +2924,7 @@ SCM also supports the following constructs from Common Lisp: @code{gentemp}. @xref{Defmacro, , , slib, SLIB}. -@node Low Level Syntactic Hooks, , Syntax Extensions, The Language +@node Low Level Syntactic Hooks, Syntactic Hooks for Hygienic Macros, Syntax Extensions, The Language @section Low Level Syntactic Hooks @deffn {Callback procedure} read:sharp c port @@ -2684,13 +3002,149 @@ have the same effect as @code{(@@call-with-current-continuation procedure)}. @end defspec +@node Syntactic Hooks for Hygienic Macros, , Low Level Syntactic Hooks, The Language +@section Syntactic Hooks for Hygienic Macros + +SCM provides a synthetic identifier type for efficient implementation of +hygienic macros (for example, @code{syntax-rules} @pxref{Macros, , , +r4rs, Revised(4) Scheme}) A synthetic identifier may be inserted in +Scheme code by a macro expander in any context where a symbol would +normally be used. Collectively, symbols and synthetic identifiers are +@emph{identifiers}. + +@defun identifier? obj +Returns @code{#t} if @var{obj} is a symbol or a synthetic +identifier, and @code{#f} otherwise. +@end defun + +If it is necessary to distinguish between symbols and synthetic identifiers, +use the predicate @code{symbol?}. + +A synthetic identifier includes two data: a parent, which is an +identifier, and an environment, which is either @code{#f} or a lexical +environment which has been passed to a macro expander +(a procedure passed as an argument to @code{procedure->macro}, +@code{procedure->memoizing-macro}, or @code{procedure->syntax}). + +@defun renamed-identifier parent env +Returns a synthetic identifier. @var{parent} must be an identifier, and +@var{env} must either be @code{#f} or a lexical environment passed to a +macro expander. @code{renamed-identifier} returns a distinct object for +each call, even if passed identical arguments. +@end defun + +There is no direct way to access the data internal to a synthetic +identifier, those data are used during variable lookup. If a synthetic +identifier is inserted as quoted data then during macro expansion it +will be repeatedly replaced by its parent, until a symbol is obtained. + +@subsection Use of synthetic identifiers +@code{renamed-identifier} may be used as a replacement for @code{gentemp}: +@lisp +(define gentemp + (let ((name (string->symbol "An unlikely variable"))) + (lambda () + (renamed-identifier name #f)))) +@end lisp + +If an identifier returned by this version of @code{gentemp} is inserted +in a binding position as the name of a variable then it is guaranteed +that no other identifier may denote that variable. If an identifier +returned by @code{gentemp} is inserted free, then it will denote the +top-level value bound to its parent, the symbol named ``An unlikely +variable''. This behavior, of course, is meant to be put to good use: + +@lisp +(define top-level-foo + (procedure->memoizing-macro + (lambda (exp env) + (renamed-identifier 'foo #f)))) +@end lisp + +Defines a macro which may always be used to refer to the top-level binding +of @code{foo}. + +@lisp +(define foo 'top-level) +(let ((foo 'local)) + (top-level-foo)) @result{} top-level +@end lisp + +In other words, we can avoid capturing @code{foo}. + +If a lexical environment is passed as the second argument to +@code{renamed-identifier} then if the identifier is inserted free +its parent will be looked up in that environment, rather than in +the top-level environment. The use of such an identifier @emph{must} +be restricted to the lexical scope of its environment. + +There is another restriction imposed for implementation convenience: +Macros passing their lexical environments to @code{renamed-identifier} +may be lexically bound only by the special forms @code{@@let-syntax} or +@code{@@letrec-syntax}. No error is signaled if this restriction is not +met, but synthetic identifier lookup will not work properly. + +@defspec @@let-syntax +@defspecx @@letrec-syntax +Behave as @code{let} and @code{letrec}, but may also put extra +information in the lexical environment so that @code{renamed-identifier} +will work properly during expansion of the macros bound by these forms. +@end defspec + +In order to maintain referential transparency it is necessary to +determine whether two identifiers have the same denotation. With +synthetic identifiers it is not necessary that two identifiers be +@code{eq?} in order to denote the same binding. + +@defun identifier-equal? id1 id2 env +Returns @code{#t} if identifiers @var{id1} and @var{id2} denote the same +binding in lexical environment @var{env}, and @code{#f} otherwise. +@var{env} must be a lexical environment passed to a macro transformer +during macro expansion. + +For example, +@lisp +(define top-level-foo? + (procedure->memoizing-macro + (let ((foo-name (renamed-identifier 'foo #f))) + (lambda (exp env) + (identifier-equal? (cadr exp) foo-name env))))) + +(top-level-foo? foo) @result{} #t + +(let ((foo 'local)) + (top-level-foo? foo)) @result{} #f +@end lisp +@end defun + +@defspec syntax-quote obj +Synthetic identifiers are converted to their parent symbols by @code{quote} +and @code{quasiquote} so that literal data in macro definitions will be +properly transcribed. @code{syntax-quote} behaves like @code{quote}, but +preserves synthetic identifier intact. +@end defspec + +@defspec the-macro mac +@code{the-macro} is the simplest of all possible macro transformers: +@var{mac} may be a syntactic keyword (macro name) or an expression +evaluating to a macro, otherwise an error is signaled. @var{mac} is +evaluated and returned once only, after which the same memoizied value is +returned. + +@code{the-macro} may be used to protect local copies of macros against +redefinition, for example: +@lisp +(@@let-syntax ((let (the-macro let))) + ;; code that will continue to work even if LET is redefined. + @dots{}) +@end lisp +@end defspec @node Packages, The Implementation, The Language, Top @chapter Packages @menu -* Executable path:: -* Compiling And Linking:: Hobbit and Dynamic Linking +* Compiling And Linking:: Hobbit * Dynamic Linking:: * Dump:: Create Fast-Booting Executables * Numeric:: Numeric Language Extensions @@ -2703,26 +3157,7 @@ procedure)}. * Sockets:: Cruise the Net @end menu -@node Executable path, Compiling And Linking, Packages, Packages -@section Executable path - -In order to dump a saved executable or to dynamically-link using DLD, -SCM must know where its executable file is. Sometimes SCM -(@pxref{Executable Pathname}) guesses incorrectly the location of the -currently running executable. In that case, the correct path can be set -by calling @code{execpath} with the pathname. - -@defun execpath -Returns the path (string) which SCM uses to find the executable file -whose invocation the currently running session is, or #f if the path is -not set. -@defunx execpath #f -@defunx execpath newpath -Sets the path to @code{#f} or @var{newpath}, respectively. The old path -is returned. -@end defun - -@node Compiling And Linking, Dynamic Linking, Executable path, Packages +@node Compiling And Linking, Dynamic Linking, Packages, Packages @section Compiling And Linking @defun compile-file name1 name2 @dots{} @@ -2775,10 +3210,28 @@ Compilation finished at Sun Jul 21 00:59:17 @noindent If SCM has been compiled with @file{dynl.c} then the additional -properties of load and require (from [SLIB]) specified here are -supported. The @code{require} forms are preferred. The variable -@code{*catalog*} can be extended to define other @code{require}-able -packages. See @file{Link.scm} for details. +properties of load and ([SLIB]) require specified here are supported. +The @code{require} form is preferred. + +@defun require feature +If the symbol @var{feature} has not already been given as an argument to +@code{require}, then the object and library files associated with +@var{feature} will be dynamically-linked, and an unspecified value +returned. If @var{feature} is not found in @code{*catalog*}, then an +error is signaled. +@end defun + +@defun usr:lib lib +Returns the pathname of the C library named @var{lib}. For example: +@code{(usr:lib "m")} returns @code{"/usr/lib/libm.a"}, the path of the C +math library. +@end defun + +@defun x:lib lib +Returns the pathname of the X library named @var{lib}. For example: +@code{(x:lib "X11")} returns @code{"/usr/X11/lib/libX11.sa"}, the path +of the X11 library. +@end defun @defun load filename lib1 @dots{} In addition to the [R4RS] requirement of loading Scheme expressions if @@ -2790,19 +3243,22 @@ instance). The object-suffix need not be given to load. For example, (load (in-vicinity (implementation-vicinity) "sc2")) or (load (in-vicinity (implementation-vicinity) "sc2.o")) or (require 'rev2-procedures) +@ftindex rev2-procedures or (require 'rev3-procedures) +@ftindex rev3-procedures @end example will load/link @file{sc2.o} if it exists. -The @var{lib1} @dots{} pathnames are for additional libraries which may be -needed for object files not produced by the Hobbit compiler. For +The @var{lib1} @dots{} pathnames specify additional libraries which may +be needed for object files not produced by the Hobbit compiler. For instance, crs is linked on Linux by @example (load (in-vicinity (implementation-vicinity) "crs.o") (usr:lib "ncurses") (usr:lib "c")) or (require 'curses) +@ftindex curses @end example Turtlegr graphics library is linked by: @@ -2811,6 +3267,7 @@ Turtlegr graphics library is linked by: (load (in-vicinity (implementation-vicinity) "turtlegr") (usr:lib "X11") (usr:lib "c") (usr:lib "m")) or (require 'turtle-graphics) +@ftindex turtle-graphics @end example And the string regular expression (@pxref{Regular Expression Pattern @@ -2822,16 +3279,10 @@ Matching}) package is linked by: or @example (require 'regex) +@ftindex regex @end example @end defun -@defun require 'db -@defunx require 'wb -Either form will dynamically load the WB database system from the -wb:vicinity (@file{../wb/}) specified in @file{Link.scm}. See -@file{scm/ANNOUNCE} for ftp sites where WB is available. -@end defun - @noindent The following functions comprise the low-level Scheme interface to dynamic linking. See the file @file{Link.scm} in the SCM distribution @@ -2885,15 +3336,12 @@ loaded file from the current SCM session. If successful, returned. @end defun -@defun usr:lib lib -Returns the pathname of the C library named lib. For example: -@code{(usr:lib "m")} could return @code{"/usr/lib/libm.a"}, the path of -the C math library. -@end defun @node Dump, Numeric, Dynamic Linking, Packages @section Dump +@ftindex dump +@ftindex unexec @dfn{Dump}, (also known as @dfn{unexec}), saves the continuation of an entire SCM session to an executable file, which can then be invoked as a program. Dumped executables start very quickly, since no Scheme code @@ -2956,7 +3404,7 @@ unspecified value. @end defun When a dumped executable is invoked, the variable @var{*interactive*} -(@pxref{System Interface}) has the value it possessed when @code{dump} +(@pxref{Internal State}) has the value it possessed when @code{dump} created it. Calling @code{dump} with a single argument sets @var{*interactive*} to @code{#f}, which is the state it has at the beginning of command line processing. @@ -3052,6 +3500,10 @@ must be a real number. It is an error if the value which should be returned by a call to these procedures is @emph{not} real. @end defun +@defun $log10 x +Real-only base 10 logarithm. +@end defun + @defun $atan2 y x Computes @code{(angle (make-rectangular x y))} for real numbers @var{y} and @var{x}. @@ -3251,6 +3703,9 @@ memory. @node Array Mapping, Uniform Array, Conventional Arrays, Arrays @subsection Array Mapping +@code{(require 'array-for-each)} +@ftindex array-for-each + @defun array-map! array0 proc array1 @dots{} If @var{array1}, @dots{} are arrays, they must have the same number of @@ -3826,7 +4281,7 @@ sender itself does not receive the signal. @item -1 If the process is privileged, send the signal to all -processes except for some special system processes. +processes except for some special system processes. Otherwise, send the signal to all processes with the same effective user ID. @@ -4663,7 +5118,7 @@ to most of the C @dfn{socket} library. For more information on sockets, @menu * Host Data:: -* Internet Addresses and Socket Names:: +* Internet Addresses and Socket Names:: * Socket:: @end menu @@ -4840,6 +5295,7 @@ This allows both reading and writing to the same port to work. If you want buffered ports you can (assuming sock-port is a socket i/o port): @example (require 'i/o-extensions) +@ftindex i/o-extensions (define i-port (duplicate-port sock-port "r")) (define o-port (duplicate-port sock-port "w")) @end example @@ -4936,7 +5392,9 @@ sockets for multiple connections without input blocking. ;;; To connect to chat `telnet localhost 8001' (require 'socket) +@ftindex socket (require 'i/o-extensions) +@ftindex i/o-extensions (let ((listener-socket (socket:bind (make-stream-socket af_inet) 8001)) (connections '())) @@ -4985,7 +5443,9 @@ or you can use a client written in scheme: ;;; characters from the socket to current-output-port. (require 'socket) +@ftindex socket (require 'i/o-extensions) +@ftindex i/o-extensions (define con (make-stream-socket af_inet)) (set! con (socket:connect con (inet:string->address "localhost") 8001)) @@ -5007,8 +5467,8 @@ or you can use a client written in scheme: @menu * Data Types:: * Operations:: +* Program Self-Knowledge:: What SCM needs to know about itself. * Improvements To Make:: -* Finishing Dynamic Linking:: @end menu @node Data Types, Operations, The Implementation, The Implementation @@ -5609,7 +6069,7 @@ iflag CCCCCCC101110100 isym CCCCCCC001110100} @r{ IMCAR: only in car of evaluated code, cdr has cell's GC bit} @t{ispcsym 000CCCC00CCCC100 -iloc 0DDDDDDDDDDDDDDDEFFFFFFF11111100 +iloc 0DDDDDDDDDDDEFFFFFFFFFFF11111100 pointer PPPPPPPPPPPPPPPPPPPPPPPPPPPPP000 gloc PPPPPPPPPPPPPPPPPPPPPPPPPPPPP001} @@ -5647,7 +6107,6 @@ asubr ..........int hpoff.....01100111 ...........SCM (*f)()........... subr_1o ..........int hpoff.....01101101 ...........SCM (*f)()........... subr_2o ..........int hpoff.....01101111 ...........SCM (*f)()........... lsubr_2 ..........int hpoff.....01110101 ...........SCM (*f)()........... -lsubr_2n..........int hpoff.....01110111 ...........SCM (*f)()........... rpsubr ..........int hpoff.....01111101 ...........SCM (*f)()...........} @r{ PTOBs:} @t{ port 0bwroxxxxxxxxG1110111 ..........FILE *stream.......... @@ -5675,7 +6134,7 @@ macro 000000000000000mxxxxxxxxG1111111 ...........SCM name............. array ...short rank..cxxxxxxxxG1111111 ............*array..............} @end format -@node Operations, Improvements To Make, Data Types, The Implementation +@node Operations, Program Self-Knowledge, Data Types, The Implementation @section Operations @menu @@ -6343,7 +6802,7 @@ the @var{argc} length array of null-terminated strings @var{argv}. If @code{NULL} terminated. @code{makfromstrs} is used by @code{run_scm} to convert the arguments SCM was called with to a @code{SCM} list which is the value of SCM procedure calls to @code{program-arguments} -(@pxref{System Interface, program-arguments}). +(@pxref{SCM Session, program-arguments}). @end deftypefun @deftypefun char **makargvfrmstrs (SCM @var{args}, char *@var{s_name}) @@ -6370,6 +6829,18 @@ continuations, but without all the rest of the SCM machinery. The concept of continuations is explained in @ref{Control features, call-with-current-continuation, , r4rs, Revised(4) Scheme}. +@noindent +The C constructs @code{jmp_buf}, @code{setjmp}, and @code{longjmp} +implement escape continuations. On VAX and Cray platforms, the setjmp +provided does not save all the registers. The source files +@file{setjump.mar}, @file{setjump.s}, and @file{ugsetjump.s} provide +implementations which do meet this criteria. + +@noindent +SCM uses the names @code{jump_buf}, @code{setjump}, and @code{longjump} +in lieu of @code{jmp_buf}, @code{setjmp}, and @code{longjmp} to prevent +name and declaration conflicts. + @deftp {Data type} CONTINUATION jmpbuf length stkbse other parent is a @code{typedef}ed structure holding all the information needed to represent a continuation. The @var{other} slot can be used to hold any @@ -6420,7 +6891,7 @@ Allocates (@code{malloc}) storage for a @code{CONTINUATION} of the current extent of stack. This newly allocated @code{CONTINUATION} is returned if successful, @code{0} if not. After @code{make_root_continuation} returns, the calling routine still needs -to @code{setjmp(@var{new_continuation}->jmpbuf)} in order to complete +to @code{setjump(@var{new_continuation}->jmpbuf)} in order to complete the capture of this continuation. @end deftypefun @@ -6430,7 +6901,7 @@ encapsulating) the stack state from @code{@var{parent_cont}->stkbse} to the current top of stack. The newly allocated @code{CONTINUATION} is returned if successful, @code{0}q if not. After @code{make_continuation} returns, the calling routine still needs to -@code{setjmp(@var{new_continuation}->jmpbuf)} in order to complete the +@code{setjump(@var{new_continuation}->jmpbuf)} in order to complete the capture of this continuation. @end deftypefun @@ -6444,7 +6915,7 @@ Sets @code{thrown_value} to @var{value} and returns from the continuation @var{cont}. If @code{CHEAP_CONTINUATIONS} is @code{#define}d, then -@code{throw_to_continuation} does @code{longjmp(@var{cont}->jmpbuf, val)}. +@code{throw_to_continuation} does @code{longjump(@var{cont}->jmpbuf, val)}. If @code{CHEAP_CONTINUATIONS} is not @code{#define}d, the CONTINUATION @var{cont} contains a copy of a portion of the C stack (whose bound must @@ -6456,7 +6927,7 @@ the stack is grown larger than the saved stack, if neccessary. @item the saved stack is copied back into it's original position. @item -@code{longjmp(@var{cont}->jmpbuf, val)}; +@code{longjump(@var{cont}->jmpbuf, val)}; @end itemize @end deftypefun @@ -6576,7 +7047,185 @@ environment. @code{eval} copies @code{expression} so that memoization does not modify @code{expression}. @end deftypefun -@node Improvements To Make, Finishing Dynamic Linking, Operations, The Implementation +@node Program Self-Knowledge, Improvements To Make, Operations, The Implementation +@section Program Self-Knowledge + +@menu +* File-System Habitat:: +* Executable Pathname:: +* Script Support:: +@end menu + +@node File-System Habitat, Executable Pathname, Program Self-Knowledge, Program Self-Knowledge +@subsection File-System Habitat + +@noindent +Where should software reside? Although individually a minor annoyance, +cumulatively this question represents many thousands of frustrated user +hours spent trying to find support files or guessing where packages need +to be installed. Even simple programs require proper habitat; games +need to find their score files. + +@noindent +Aren't there standards for this? Some Operating Systems have devised +regimes of software habitats -- only to have them violated by large +software packages and imports from other OS varieties. + +@noindent +In some programs, the expected locations of support files are fixed at +time of compilation. This means that the program may not run on +configurations unanticipated by the authors. Compiling locations into a +program also can make it immovable -- necessitating recompilation to +install it. + +@quotation +Programs of the world unite! You have nothing to lose but loss itself. +@end quotation + +@noindent +The function @code{scm_find_impl_file} in @file{scm.c} is an attempt to +create a utility (for inclusion in programs) which will hide the details +of platform-dependent file habitat conventions. It takes as input the +pathname of the executable file which is running. If there are systems +for which this information is either not available or unrelated to the +locations of support files, then a higher level interface will be +needed. + +@deftypefun char *scm_find_impl_file(char *@var{exec_path}, char +*@var{generic_name}, char *@var{initname}, char *@var{sep}) Given the +pathname of this executable (@var{exec_path}), test for the existence of +@var{initname} in the implementation-vicinity of this program. Return a +newly allocated string of the path if successful, 0 if not. The +@var{sep} argument is a @emph{null-terminated string} of the character +used to separate directory components. +@end deftypefun + +@itemize @bullet +@item +One convention is to install the support files for an executable program +in the same directory as the program. This possibility is tried first, +which satisfies not only programs using this convention, but also +uninstalled builds when testing new releases, etc. + +@item +Another convention is to install the executables in a directory named +@file{bin}, @file{BIN}, @file{exe}, or @file{EXE} and support files in a +directroy named @file{lib}, which is a peer the executable directory. +This arrangement allows multiple executables can be stored in a single +directory. For example, the executable might be in +@samp{/usr/local/bin/} and initialization file in +@samp{/usr/local/lib/}. + +If the executable directory name matches, the peer directroy @file{lib} +is tested for @var{initname}. + +@item +Sometimes @file{lib} directories become too crowded. So we look in any +subdirectories of @file{lib} or @file{src} having the name (sans type +suffix such as @samp{.EXE}) of the program we are running. For example, +the executable might be @samp{/usr/local/bin/foo} and initialization +file in @samp{/usr/local/lib/foo/}. + +@item +But the executable name may not be the usual program name; So also look +in any @var{generic_name} subdirectories of @file{lib} or @file{src} +peers. + +@item +Finally, if the name of the executable file being run has a (system +dependent) suffix which is not needed to invoke the program, then look +in a subdirectory (of the one containing the executable file) named for +the executable (without the suffix); And look in a @var{generic_name} +subdirectory. For example, the executable might be +@samp{C:\foo\bar.exe} and the initialization file in @samp{C:\foo\bar\}. +@end itemize + + +@node Executable Pathname, Script Support, File-System Habitat, Program Self-Knowledge +@subsection Executable Pathname + +@noindent +For purposes of finding @file{Init.scm}, dumping an executable, and +dynamic linking, a SCM session needs the pathname of its executable +image. + +@noindent +When a program is executed by MS-DOS, the full pathname of that +executable is available in @code{argv[0]}. This value can be passed +directly to @code{scm_find_impl_file} (@pxref{File-System Habitat}). + +@noindent +In order to find the habitat for a unix program, we first need to know +the full pathname for the associated executable file. + +@deftypefun char *dld_find_executable (const char *@var{command}) +@code{dld_find_executable} returns the absolute path name of the file +that would be executed if @var{command} were given as a command. It +looks up the environment variable @var{PATH}, searches in each of the +directory listed for @var{command}, and returns the absolute path name +for the first occurrence. Thus, it is advisable to invoke +@code{dld_init} as: + +@example +main (int argc, char **argv) +@{ + @dots{} + if (dld_init (dld_find_executable (argv[0]))) @{ + @dots{} + @} + @dots{} +@} +@end example + +@quotation +@strong{Note:} If the current process is executed using the +@code{execve} call without passing the correct path name as argument 0, +@code{dld_find_executable (argv[0]) } will also fail to locate the +executable file. +@end quotation + +@code{dld_find_executable} returns zero if @code{command} is not found +in any of the directories listed in @code{PATH}. +@end deftypefun + +@node Script Support, , Executable Pathname, Program Self-Knowledge +@subsection Script Support + +@noindent +Source code for these C functions is in the file @file{script.c}. +@ref{Shell Scripts} for a description of script argument processing. + +@noindent +@code{script_find_executable} is only defined on unix systems. + +@deftypefun char *script_find_executable (const char *@var{name}) +@code{script_find_executable} returns the path name of the +executable which will is invoked by the script file @var{name}; +@var{name} if it is a binary executable (not a script); or 0 if +@var{name} does not exist or is not executable. +@end deftypefun + +@deftypefun char **script_process_argv(int @var{argc}; char **@var{argv}) +Given an @dfn{main} style argument vector @var{argv} and the number of +arguments, @var{argc}, @code{script_process_argv} returns a newly +allocated argument vector in which the second line of the script being +invoked is substituted for the corresponding meta-argument. +@tindex meta-argument + +If the script does not have a meta-argument, or if the file named by the +argument following a meta-argument cannot be opened for reading, then 0 +is returned. + +@code{script_process_argv} correctly processes argument vectors of +nested script invocations. +@end deftypefun + +@deftypefun int script_count_argv(char **@var{argv}) +Returns the number of argument strings in @var{argv}. +@end deftypefun + + +@node Improvements To Make, , Program Self-Knowledge, The Implementation @section Improvements To Make @itemize @bullet @@ -6609,11 +7258,6 @@ with a frame which calls the contin just created. This in combination with checking stack depth could also be used to allow stacks deeper than 64K on the IBM PC. @item -lookupcar in @file{eval.c} should @emph{not} memoize (to @code{ILOC}s) -when it retrieves environments deeper or longer than 4095. The values -can still be retrieved (albeit slowly), but an @code{ILOC} should not be -made. The @code{MEMOIZE_LOCALS} flag could then be flushed. -@item The @code{must-} or @code{make-} routines need some sort of C macros or conditionalization so that they check: @@ -6632,8 +7276,12 @@ is also used for allocating heap segments, which do not have the @code{must_malloc()} should be tested for speed impact. @end itemize -@node Finishing Dynamic Linking, , Improvements To Make, The Implementation -@section Finishing Dynamic Linking +@menu +* Finishing Dynamic Linking:: +@end menu + +@node Finishing Dynamic Linking, , Improvements To Make, Improvements To Make +@subsection Finishing Dynamic Linking @noindent Scott Schwartz <schwartz@@galapagos.cse.psu.edu> suggests: One way to @@ -6903,7 +7551,7 @@ This is an alphabetical list of all the global variables in SCM. @node Type Index, , Variable Index, Top @unnumbered Type Index -This is an alphabetical list of all the data types in SCM. +This is an alphabetical list of data types and feature names in SCM. @printindex tp diff --git a/scm4e3.scmconfig.patch b/scm4e3.scmconfig.patch deleted file mode 100644 index ff7dc48..0000000 --- a/scm4e3.scmconfig.patch +++ /dev/null @@ -1,60 +0,0 @@ -diff -c temp/scm/findexec.c temp/nscm/findexec.c -*** temp/scm/findexec.c Sun Mar 17 23:16:26 1996 ---- temp/nscm/findexec.c Thu Mar 21 08:51:27 1996 -*************** -*** 37,46 **** - filename. A new copy of the complete path name of that file is - returned. This new string may be disposed by free() later on. */ - - #include <sys/file.h> - #include <sys/param.h> -! #include <strings.h> -! #ifdef linux - # include <stdlib.h> - # include <sys/stat.h> - # include <unistd.h> /* for X_OK define */ ---- 37,47 ---- - filename. A new copy of the complete path name of that file is - returned. This new string may be disposed by free() later on. */ - -+ #include "scm.h" -+ - #include <sys/file.h> - #include <sys/param.h> -! #if defined(linux) || defined(__svr4__) - # include <stdlib.h> - # include <sys/stat.h> - # include <unistd.h> /* for X_OK define */ -*************** -*** 116,122 **** - if (*p) p++; - - if (name[0] == '.' && name[1] == 0) -! getwd(name); - - else if (name[0]=='~' && name[1]==0 && getenv("HOME")) - strcpy(name, getenv("HOME")); ---- 117,123 ---- - if (*p) p++; - - if (name[0] == '.' && name[1] == 0) -! getcwd(name, MAXPATHLEN); - - else if (name[0]=='~' && name[1]==0 && getenv("HOME")) - strcpy(name, getenv("HOME")); -diff -c temp/scm/scmfig.h temp/nscm/scmfig.h -*** temp/scm/scmfig.h Fri Sep 22 22:29:00 1995 ---- temp/nscm/scmfig.h Wed Mar 20 23:47:15 1996 -*************** -*** 50,55 **** ---- 50,59 ---- - # include <strings.h> - # endif - -+ # ifndef HAVE_GETCWD -+ # define getcwd(S,L) getwd(S) -+ # endif -+ - #else /* HAVE_CONFIG_H */ - - # ifdef sequent diff --git a/scmconfig.h.in b/scmconfig.h.in deleted file mode 100644 index 5fb6d27..0000000 --- a/scmconfig.h.in +++ /dev/null @@ -1,69 +0,0 @@ -/* scmconfig.h.in. Generated automatically from configure.in by autoheader. */ - -/* Define if on AIX 3. - System headers sometimes define this. - We just want to avoid a redefinition error message. */ -#ifndef _ALL_SOURCE -#undef _ALL_SOURCE -#endif - -/* Define to empty if the keyword does not work. */ -#undef const - -/* Define if on MINIX. */ -#undef _MINIX - -/* Define if your C compiler doesn't accept -c and -o together. */ -#undef NO_MINUS_C_MINUS_O - -/* Define if the system does not provide POSIX.1 features except - with this defined. */ -#undef _POSIX_1_SOURCE - -/* Define if you need to in order for stat and other things to work. */ -#undef _POSIX_SOURCE - -/* Define as the return type of signal handlers (int or void). */ -#undef RETSIGTYPE - -/* Define if you have the ANSI C header files. */ -#undef STDC_HEADERS - -/* Define if you can safely include both <sys/time.h> and <time.h>. */ -#undef TIME_WITH_SYS_TIME - -/* Define if you have ftime. */ -#undef HAVE_FTIME - -/* Define if you have getcwd. */ -#undef HAVE_GETCWD - -/* Define if you have times. */ -#undef HAVE_TIMES - -/* Define if you have the <limits.h> header file. */ -#undef HAVE_LIMITS_H - -/* Define if you have the <memory.h> header file. */ -#undef HAVE_MEMORY_H - -/* Define if you have the <string.h> header file. */ -#undef HAVE_STRING_H - -/* Define if you have the <sys/time.h> header file. */ -#undef HAVE_SYS_TIME_H - -/* Define if you have the <sys/timeb.h> header file. */ -#undef HAVE_SYS_TIMEB_H - -/* Define if you have the <sys/times.h> header file. */ -#undef HAVE_SYS_TIMES_H - -/* Define if you have the <sys/types.h> header file. */ -#undef HAVE_SYS_TYPES_H - -/* Define if you have the <time.h> header file. */ -#undef HAVE_TIME_H - -/* Define if you have the <unistd.h> header file. */ -#undef HAVE_UNISTD_H @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -54,6 +54,10 @@ # define getcwd(S,L) getwd(S) # endif +# ifdef __amigados__ +# define STDC_HEADERS +# endif + #else /* HAVE_CONFIG_H */ # ifdef sequent @@ -167,12 +171,6 @@ rgx.c init_rgx(); regcomp and regexec. */ # define GC_FREE_SEGMENTS # endif -/* MEMOIZE_LOCALS will speed up most local variable references. You - will need to remove this and recompile eval.c if you use very large or - deep environments (more than 4095 bound variables in one procedure)*/ - -# define MEMOIZE_LOCALS - /* #define CHEAP_CONTINUATIONS */ /* #define TICKS */ @@ -197,6 +195,11 @@ rgx.c init_rgx(); regcomp and regexec. */ /* #define CAREFUL_INTS */ +/* Define MACRO if you want C level support for hygienic and referentially + transparent macros. */ + +/* #define MACRO */ + /* STDC_HEADERS indicates that the include file names are the same as ANSI C. For most modern systems this is the case. */ @@ -205,6 +208,13 @@ rgx.c init_rgx(); regcomp and regexec. */ # define __STDC__ # endif +/* added by Denys Duchier */ +# ifndef SVR4 +# ifdef __svr4__ +# define SVR4 +# endif +# endif + # ifdef __STDC__ # ifndef __HIGHC__ /* overly fussy compiler */ # define USE_ANSI_PROTOTYPES @@ -358,6 +368,12 @@ rgx.c init_rgx(); regcomp and regexec. */ # endif #endif +#ifdef __GNUC__ +# define FENCE asm volatile ("") +#else +# define FENCE /**/ +#endif + #ifdef NON_PREEMPTIVE # define DEFER_INTS /**/ # ifdef TICKS @@ -370,15 +386,13 @@ rgx.c init_rgx(); regcomp and regexec. */ # define ALLOW_INTS POLL #else # ifdef CAREFUL_INTS -# define DEFER_INTS {if (ints_disabled) \ - fputs("ints already disabled\n", stderr); \ - ints_disabled = 1;} -# define ALLOW_INTS {if (!ints_disabled) \ - fputs("ints already enabled\n", stderr); \ - ints_disabled = 0;CHECK_INTS} +# define DEFER_INTS \ +{FENCE;if (ints_disabled) ints_viol(!0);else ints_disabled = !0;FENCE;} +# define ALLOW_INTS \ +{FENCE;if (!ints_disabled) ints_viol(0);else ints_disabled = 0;FENCE;CHECK_INTS} # else -# define DEFER_INTS {ints_disabled = 1;} -# define ALLOW_INTS {ints_disabled = 0;CHECK_INTS} +# define DEFER_INTS {FENCE;ints_disabled = !0;FENCE;} +# define ALLOW_INTS {FENCE;ints_disabled = 0;FENCE;CHECK_INTS} # endif # ifdef TICKS # define CHECK_INTS {if (sig_deferred) han_sig();if (alrm_deferred) han_alrm();\ diff --git a/script.c b/script.c new file mode 100644 index 0000000..e1a63f1 --- /dev/null +++ b/script.c @@ -0,0 +1,384 @@ +/* Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + +/* "script.c" argv tricks for `#!' scripts. + Author: Aubrey Jaffer */ + +#include <ctype.h> +#include "scm.h" + +#ifdef __IBMC__ +# include <io.h> +#endif /* def __IBMC__ */ + +#ifdef linux +# include <unistd.h> /* for X_OK define */ +#endif /* def linux */ +#ifdef __svr4__ +# include <unistd.h> /* for X_OK define */ +#else +# ifdef __sgi__ +# include <unistd.h> /* for X_OK define */ +# endif /* def __sgi__ */ +#endif /* def __svr4__ */ + +/* Concatentate str2 onto str1 at position n and return concatenated + string if file exists; 0 otherwise. */ + +char *scm_cat_path(str1, str2, n) + char *str1; + const char *str2; + long n; +{ + if (!n) n = strlen(str2); + if (str1) + { + long len = strlen(str1); + str1 = (char *)realloc(str1, (sizet)(len + n + 1)); + if (!str1) return 0L; + strncat(str1 + len, str2, n); + return str1; + } + str1 = (char *)malloc((sizet)(n + 1)); + if (!str1) return 0L; + str1[0] = 0; + strncat(str1, str2, n); + return str1; +} + +char *scm_try_path(path) + char *path; +{ + FILE *f; + /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */ + if (!path) return 0L; + SYSCALL(f = fopen(path, "r");); + if (f) { + fclose(f); + return path; + } + free(path); + return 0L; +} + +char *scm_sep_init_try(path, sep, initname) + char *path; + const char *sep, *initname; +{ + if (path) path = scm_cat_path(path, sep, 0L); + if (path) path = scm_cat_path(path, initname, 0L); + return scm_try_path(path); +} + +#ifndef LINE_INCREMENTORS +# define LINE_INCREMENTORS '\n' +# ifdef MSDOS +# define WHITE_SPACES ' ':case '\t':case '\r':case '\f':case 26 +# else +# define WHITE_SPACES ' ':case '\t':case '\r':case '\f' +# endif /* def MSDOS */ +#endif /* ndef LINE_INCREMENTORS */ + +#ifndef MAXPATHLEN +# define MAXPATHLEN 80 +#endif /* ndef MAXPATHLEN */ +#ifndef X_OK +# define X_OK 1 +#endif /* ndef X_OK */ + +#ifdef unix +# include <stdio.h> + +char *script_find_executable(name) + const char *name; +{ + char tbuf[MAXPATHLEN]; + int i = 0; + FILE *f; + + /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */ + if (access(name, X_OK)) return 0L; + f = fopen(name, "r"); + if (!f) return 0L; + if ((fgetc(f)=='#') && (fgetc(f)=='!')) { + while (1) switch (tbuf[i++] = fgetc(f)) { + case /*WHITE_SPACES*/ ' ':case '\t':case '\r':case '\f': + case EOF: + tbuf[--i] = 0; + fclose(f); + return scm_cat_path(0L, tbuf, 0L); + } + } + fclose(f); + return scm_cat_path(0L, name, 0L); +} +#endif /* unix */ + +#ifdef MSDOS + +# define DEFAULT_PATH "C:\\DOS" +# define PATH_DELIMITER ';' +# define ABSOLUTE_FILENAME_P(fname) ((fname[0] == '\\') \ + || (fname[0] && (fname[1] == ':'))) + +char *dld_find_executable(file) + const char *file; +{ + /* fprintf(stderr, "dld_find_executable %s -> %s\n", file, scm_cat_path(0L, file, 0L)); fflush(stderr); */ + return scm_cat_path(0L, file, 0L); +} +#endif /* def MSDOS */ + +/* Given dld_find_executable()'s best guess for the pathname of this + executable, find (and verify the existence of) initname in the + implementation-vicinity of this program. Returns a newly allocated + string if successful, 0 if not */ + +char *scm_find_impl_file(exec_path, generic_name, initname, sep) + char *exec_path; + const char *generic_name, *initname, *sep; +{ + char *sepptr = strrchr(exec_path, sep[0]); + char *extptr = exec_path + strlen(exec_path); + char *path = 0; + /* fprintf(stderr, "dld_find_e %s\n", exec_path); fflush(stderr); */ + if (sepptr) { + long sepind = sepptr - exec_path + 1L; + + /* In case exec_path is in the source directory, look first in + exec_path's directory. */ + path = scm_cat_path(0L, exec_path, sepind - 1L); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + +#ifdef MSDOS + if (!strcmp(extptr - 4, ".exe") || !strcmp(extptr - 4, ".com") || + !strcmp(extptr - 4, ".EXE") || !strcmp(extptr - 4, ".COM")) + extptr = extptr - 4; +#endif /* def MSDOS */ + + if (generic_name && + !strncmp(exec_path + sepind, generic_name, extptr - exec_path)) + generic_name = 0; + + /* If exec_path is in directory "exe" or "bin": */ + path = scm_cat_path(0L, exec_path, sepind - 1L); + sepptr = path + sepind - 4; + if (!strcmp(sepptr, "exe") || !strcmp(sepptr, "bin") || + !strcmp(sepptr, "EXE") || !strcmp(sepptr, "BIN")) { + char *peer; + + /* Look for initname in peer directory "lib". */ + if (path) { + strncpy(sepptr, "lib", 3); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + } + + /* Look for initname in peer directories "lib" and "src" in + subdirectory with the name of the executable (sans any type + extension like .EXE). */ + for(peer="lib";!0;peer="src") { + path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L); + if (path) { + strncpy(path + sepind - 4, peer, 3); + path[extptr - exec_path] = 0; + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + } + if (!strcmp(peer,"src")) break; + } + + if (generic_name) { + + /* Look for initname in peer directories "lib" and "src" in + subdirectory with the generic name. */ + for(peer="lib";!0;peer="src") { + path = scm_cat_path(0L, exec_path, sepind); + if (path) { + strncpy(path + sepind - 4, "lib", 3); + path = scm_cat_path(path, generic_name, 0L); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + } + if (!strcmp(peer,"src")) break; + }}} + +#ifdef MSDOS + if (strlen(extptr)) { + /* If exec_path has type extension, look in a subdirectory with + the name of the executable sans the executable file's type + extension. */ + path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + + if (generic_name) { + + /* Also look in generic_name subdirectory. */ + path = scm_cat_path(0L, exec_path, sepind); + if (path) path = scm_cat_path(path, generic_name, 0L); + path = scm_sep_init_try(path, sep, initname); + if (path) return path; + }} +#endif /* def MSDOS */ + } + else { + + /* We don't have a parse-able exec_path. The only path to try is + just initname. */ + path = scm_cat_path(0L, initname, 0L); + if (path) path = scm_try_path(path); + if (path) return path; + } + return 0L; +} + +char *script_read_arg(f) + FILE *f; +{ + sizet tlen = 1; + int tind = 0, qted = 0, chr; + char *tbuf = (char *)malloc((1 + tlen) * sizeof(char)); + if (!tbuf) return 0L; + while (1) switch (chr = getc(f)) { + case WHITE_SPACES: + continue; + case LINE_INCREMENTORS: + case EOF: + free(tbuf); + return 0L; + default: + goto morearg; + } +morearg: + while (1) { + switch (tbuf[tind++] = chr) { + case WHITE_SPACES: + case LINE_INCREMENTORS: + if (qted) break; + case EOF: goto endarg; + case '!': + if (qted) break; + switch (chr = getc(f)) { + case '#': + if (1==tind) return 0L; + goto endarg; + default: tbuf[tind++] = chr; break; + } + break; + case '"': qted = !qted; tind--; break; + case '\\': + switch (tbuf[tind - 1] = getc(f)) { + case '\n': --tind; break; + case 'n': tbuf[tind - 1] = '\n'; break; + case 'r': tbuf[tind - 1] = '\r'; break; + case 't': tbuf[tind - 1] = '\t'; break; + case 'b': tbuf[tind - 1] = '\b'; break; + /* case '0': tbuf[tind - 1] = '\0'; break; */ + default:; + } + default:; + } + if (tind >= tlen) { + tbuf = (char *)realloc(tbuf, (1 + (2 * tlen)) * sizeof(char)); + if (!tbuf) return 0L; + tlen = 2 * tlen; + } + chr = getc(f); + } +endarg: + tbuf[--tind] = 0; + return tbuf; +} + +int script_meta_arg_P(arg) + char *arg; +{ + if ('\\' != arg[0]) return 0L; +#ifdef MSDOS + return !arg[1]; +#else + switch (arg[1]) { + case 0: + case '%': + case WHITE_SPACES: return !0; + default: return 0L;} +#endif +} + +char **script_process_argv(argc, argv) + int argc; + char **argv; +{ + int nargc = argc, argi = 1, nargi = 1; + char *narg, **nargv; + if (!(argc > 2 && script_meta_arg_P(argv[1]))) return 0L; + if (!(nargv = (char **)malloc((1 + nargc) * sizeof(char*)))) return 0L; + nargv[0] = argv[0]; + while (((argi+1) < argc) && (script_meta_arg_P(argv[argi]))) { + FILE *f = fopen(argv[++argi], "r"); + if (f) { + nargc--; /* to compensate for replacement of '\\' */ + while (1) switch (getc(f)) { + case EOF: return 0L; + default: continue; + case '\n': goto found_args; + } + found_args: while ((narg = script_read_arg(f))) + if (!(nargv = (char **)realloc(nargv, (1 + ++nargc) * sizeof(char*)))) + return 0L; + else nargv[nargi++] = narg; + fclose(f); + nargv[nargi++] = argv[argi++]; + } + } + while (argi <= argc) nargv[nargi++] = argv[argi++]; + return nargv; +} + +int script_count_argv(argv) + char **argv; +{ + int argc = 0; + while (argv[argc]) argc++; + return argc; +} @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -47,16 +47,16 @@ #ifdef PROT386 /*in 386 protected mode we must only adjust the offset */ -#define CELL_UP(p) MK_FP(FP_SEG(p), ~7&(FP_OFF(p)+7)) -#define CELL_DN(p) MK_FP(FP_SEG(p), ~7&FP_OFF(p)) +# define CELL_UP(p) MK_FP(FP_SEG(p), ~7&(FP_OFF(p)+7)) +# define CELL_DN(p) MK_FP(FP_SEG(p), ~7&FP_OFF(p)) #else -#ifdef _UNICOS -#define CELL_UP(p) (CELLPTR)(~1L & ((long)(p)+1L)) -#define CELL_DN(p) (CELLPTR)(~1L & (long)(p)) -#else -#define CELL_UP(p) (CELLPTR)(~(sizeof(cell)-1L) & ((long)(p)+sizeof(cell)-1L)) -#define CELL_DN(p) (CELLPTR)(~(sizeof(cell)-1L) & (long)(p)) -#endif /* UNICOS */ +# ifdef _UNICOS +# define CELL_UP(p) (CELLPTR)(~1L & ((long)(p)+1L)) +# define CELL_DN(p) (CELLPTR)(~1L & (long)(p)) +# else +# define CELL_UP(p) (CELLPTR)(~(sizeof(cell)-1L) & ((long)(p)+sizeof(cell)-1L)) +# define CELL_DN(p) (CELLPTR)(~(sizeof(cell)-1L) & (long)(p)) +# endif /* UNICOS */ #endif /* PROT386 */ /* These are parameters for controlling memory allocation. The heap @@ -85,13 +85,13 @@ #define INIT_HEAP_SIZE (25000L*sizeof(cell)) #define MIN_HEAP_SEG_SIZE (2000L*sizeof(cell)) #ifdef _QC -#define HEAP_SEG_SIZE 32400L -#else -#ifdef sequent -#define HEAP_SEG_SIZE (7000L*sizeof(cell)) +# define HEAP_SEG_SIZE 32400L #else -#define HEAP_SEG_SIZE (8100L*sizeof(cell)) -#endif +# ifdef sequent +# define HEAP_SEG_SIZE (7000L*sizeof(cell)) +# else +# define HEAP_SEG_SIZE (8100L*sizeof(cell)) +# endif #endif #define EXPHEAP(heap_size) (heap_size*2) #define INIT_MALLOC_LIMIT 100000 @@ -117,6 +117,6 @@ void dowinds P((SCM to, long delta)); #include "continue.h" /* See scm.h for definition of P */ -void mark_locations P((STACKITEM x [], sizet n )); +void mark_locations P((STACKITEM x[], sizet n )); void scm_dynthrow P((CONTINUATION *cont, SCM val)); #define s_cont (ISYMCHARS(IM_CONT)+20) @@ -52,9 +52,17 @@ #include <netinet/in.h> #include <netdb.h> #include <arpa/inet.h> +/* added by Denys Duchier: for bzero */ +#ifdef sun +# include <strings.h> +#endif #ifndef STDC_HEADERS int close P((int fd)); +#else /* added by Denys Duchier */ +# ifdef SVR4 +# include <unistd.h> +# endif #endif /* STDC_HEADERS */ static char s_inetaddr[] = "inet:string->address"; @@ -1265,11 +1265,11 @@ SCM string(chrs) SCM chrs; { SCM res; - register char *data; + register unsigned char *data; long i = ilength(chrs); ASSERT(i >= 0, chrs, ARG1, s_string); res = makstr(i); - data = CHARS(res); + data = UCHARS(res); for(;NNULLP(chrs);chrs = CDR(chrs)) { ASSERT(ICHRP(CAR(chrs)), chrs, ARG1, s_string); *data++ = ICHR(CAR(chrs)); @@ -1280,12 +1280,12 @@ SCM make_string(k, chr) SCM k, chr; { SCM res; - register char *dst; + register unsigned char *dst; register long i; ASSERT(INUMP(k) && (k >= 0), k, ARG1, s_make_string); i = INUM(k); res = makstr(i); - dst = CHARS(res); + dst = UCHARS(res); if (!UNBNDP(chr)) { ASSERT(ICHRP(chr), chr, ARG2, s_make_string); for(i--;i >= 0;i--) dst[i] = ICHR(chr); @@ -1304,7 +1304,7 @@ SCM st_ref(str, k) ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_ref); ASSERT(INUMP(k), k, ARG2, s_st_ref); ASSERT(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_ref); - return MAKICHR(CHARS(str)[INUM(k)]); + return MAKICHR(UCHARS(str)[INUM(k)]); } SCM st_set(str, k, chr) SCM str, k, chr; @@ -1313,20 +1313,20 @@ SCM st_set(str, k, chr) ASSERT(INUMP(k), k, ARG2, s_st_set); ASSERT(ICHRP(chr), chr, ARG3, s_st_set); ASSERT(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_set); - CHARS(str)[INUM(k)] = ICHR(chr); + UCHARS(str)[INUM(k)] = ICHR(chr); return UNSPECIFIED; } SCM st_equal(s1, s2) SCM s1, s2; { register sizet i; - register char *c1, *c2; + register unsigned char *c1, *c2; ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_equal); ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_equal); i = LENGTH(s2); if (LENGTH(s1) != i) return BOOL_F; - c1 = CHARS(s1); - c2 = CHARS(s2); + c1 = UCHARS(s1); + c2 = UCHARS(s2); while(0 != i--) if(*c1++ != *c2++) return BOOL_F; return BOOL_T; } @@ -1433,7 +1433,7 @@ SCM st_append(args) SCM res; register long i = 0; register SCM l, s; - register char *data; + register unsigned char *data; for(l = args;NIMP(l);) { ASSERT(CONSP(l), l, ARGn, s_st_append); s = CAR(l); @@ -1443,10 +1443,10 @@ SCM st_append(args) } ASSERT(NULLP(l), args, ARGn, s_st_append); res = makstr(i); - data = CHARS(res); + data = UCHARS(res); for(l = args;NIMP(l);l = CDR(l)) { s = CAR(l); - for(i = 0;i<LENGTH(s);i++) *data++ = CHARS(s)[i]; + for(i = 0;i<LENGTH(s);i++) *data++ = UCHARS(s)[i]; } return res; } @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -68,7 +68,7 @@ void igc P((char *what, STACKITEM *stackbase)); char *mktemp P((char *template)); #endif -static void gc_sweep P((void)); +static void gc_sweep P((int contin_bad)); char s_nogrow[] = "could not grow", s_heap[] = "heap", s_hplims[] = "hplims"; @@ -141,8 +141,8 @@ SCM open_file(filename, modes) SETSTREAM(port, f); if (BUF0 & (CAR(port) = tc16_fport | mode_bits(CHARS(modes)))) i_setbuf0(port); - ALLOW_INTS; } + ALLOW_INTS; return port; } @@ -565,9 +565,9 @@ void add_final(final) return; } -char s_obunhash[] = "object-unhash"; +char s_obunhash[] = "object-unhash", s_gc[] = "gc"; static iproc subr0s[] = { - {"gc", gc}, + {s_gc, gc}, {"tmpnam", ltmpnam}, {0, 0}}; @@ -883,7 +883,7 @@ void dowinds(to, delta) } } -/* Remember that setjmp needs to be called after scm_make_cont */ +/* Remember that setjump needs to be called after scm_make_cont */ SCM scm_make_cont() { @@ -951,10 +951,13 @@ SCM obunhash(obj) #endif ASSERT(INUMP(obj), obj, ARG1, s_obunhash); obj = SRS(obj, 1) & ~1L; - comm: +comm: if IMP(obj) return obj; if NCELLP(obj) return BOOL_F; - { /* code is adapted from mark_locations */ + { + /* This code is adapted from mark_locations() in "sys.c" and + scm_cell_p() in "rope.c", which means that changes to these + routines must be coordinated. */ register CELLPTR ptr = (CELLPTR)SCM2PTR(obj); register sizet i = 0, j = hplim_ind; do { @@ -1295,7 +1298,7 @@ SCM gc_for_newcell() } static char s_bad_type[] = "unknown type in "; -jmp_buf save_regs_gc_mark; +jump_buf save_regs_gc_mark; void mark_locations P((STACKITEM x[], sizet n)); static void mark_syms P((SCM v)); static void mark_sym_values P((SCM v)); @@ -1315,7 +1318,8 @@ void igc(what, stackbase) int j = num_protects; long oheap_size = heap_size; gc_start(what); - ++errjmp_bad; + if (++errjmp_bad > 1) + wta(MAKINUM(errjmp_bad), "gc called from within ", s_gc); /* By marking symhash first, we provide the best immunity from accidental references. In order to accidentally protect a symbol, a pointer will have to point directly at the symbol (as @@ -1329,8 +1333,8 @@ void igc(what, stackbase) #endif if (stackbase) { FLUSH_REGISTER_WINDOWS; - /* This assumes that all registers are saved into the jmp_buf */ - setjmp(save_regs_gc_mark); + /* This assumes that all registers are saved into the jump_buf */ + setjump(save_regs_gc_mark); mark_locations((STACKITEM *) save_regs_gc_mark, (sizet) (sizeof(STACKITEM) - 1 + sizeof save_regs_gc_mark) / sizeof(STACKITEM)); @@ -1354,9 +1358,10 @@ void igc(what, stackbase) #endif } } - while(j--) gc_mark(sys_protects[j]); + while(j--) + gc_mark(sys_protects[j]); sweep_symhash(symhash); - gc_sweep(); + gc_sweep(!stackbase); --errjmp_bad; gc_end(); if (oheap_size != heap_size) { @@ -1376,7 +1381,7 @@ void free_storage() gc_mark(def_inp); /* don't want to close stdin */ gc_mark(def_outp); /* don't want to close stdout */ gc_mark(def_errp); /* don't want to close stderr */ - gc_sweep(); + gc_sweep(0); rootcont = BOOL_F; while (hplim_ind) { /* free heap segments */ hplim_ind -= 2; @@ -1507,6 +1512,12 @@ void gc_mark(p) } } +/* mark_locations() marks a location pointed to by x[0:n] only if + `x[m]' is cell-aligned and points into a valid heap segment. This + code is duplicated by obunhash() in "sys.c" and scm_cell_p() in + "rope.c", which means that changes to these routines must be + coordinated. */ + void mark_locations(x, n) STACKITEM x[]; sizet n; @@ -1532,7 +1543,8 @@ void mark_locations(x, n) #define HUGE_LENGTH(x) (LENGTH_MAX==LENGTH(x) ? *((long *)VELTS(x)) : LENGTH(x)) -static void gc_sweep() +static void gc_sweep(contin_bad) + int contin_bad; { register CELLPTR ptr; #ifdef POINTERS_MUNGED @@ -1599,10 +1611,17 @@ static void gc_sweep() m += LENGTH(scmptr)+1; goto freechars; case tc7_contin: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if GC8MARKP(scmptr) { + if (contin_bad && CONT(scmptr)->length) { + warn("uncollected ", (char *)0); + iprin1(scmptr, cur_errp, 1); + lputc('\n', cur_errp); + lfflush(cur_errp); + } + goto c8mrkcontinue; + } m += LENGTH(scmptr)*sizeof(STACKITEM) + sizeof(CONTINUATION); -/* free_continuation(CONT(scmptr)); */ - goto freechars; + free_continuation(CONT(scmptr)); break; /* goto freechars; */ case tc7_ssymbol: if GC8MARKP(scmptr) goto c8mrkcontinue; /* Do not free storage because tc7_ssymbol means scmptr's @@ -1708,15 +1727,18 @@ static void mark_syms(v) /* If this bucket has already been marked, then something is wrong. */ ASSERT(!GCMARKP(al), al, s_bad_type, s_gc_sym); x = CAR(al); - SETGCMARK(al); + SETGCMARK(al); /* Do mark bucket list */ ASSERT(!GCMARKP(x), x, s_bad_type, s_gc_sym); if (UNDEFINED==CDR(x) && tc7_msymbol==TYP7(CAR(x))) goto used; /* Don't mark symbol. */ SETGC8MARK(CAR(x)); used: - SETGCMARK(x); /* Do mark value cell. */ + /* SETGCMARK(x) */; /* Don't mark value cell. */ + /* We used to mark the value cell, but value cells get returned + by calls to intern(). This caused a rare GC leak which only + showed up in large programs. */ } - SETGC8MARK(v); /* Mark bucket list. */ + SETGC8MARK(v); /* Mark bucket vector. */ } /* mark_symhash marks the values of hash table V. */ @@ -1744,8 +1766,10 @@ static void sweep_symhash(v) lloc = &(VELTS(v)[k]); while NIMP(al = (*lloc & ~1L)) { x = CAR(al); - if GC8MARKP(CAR(x)) + if GC8MARKP(CAR(x)) { lloc = &(CDR(al)); + SETGCMARK(x); + } else { *lloc = CDR(al); CLRGCMARK(al); /* bucket pair to be collected by gc_sweep */ @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -79,6 +79,10 @@ # ifndef GO32 # include <sys/timeb.h> # endif +# else +# ifdef __amigados__ +# include <sys/timeb.h> +# endif # endif # endif @@ -387,3 +391,18 @@ void init_time() if (!my_base) my_base = mytime(); init_iprocs(subr0s, tc7_subr_0); } +#ifdef freebsd +# include <sys/types.h> +# include <sys/time.h> +# include <sys/timeb.h> +int ftime(time_buffer) + struct timeb *time_buffer; +{ + struct timezone t_z; struct timeval t_v; + if (gettimeofday(&t_v, &t_z) < 0) return -1; + time_buffer->timezone = t_z.tz_minuteswest; + time_buffer->dstflag = t_z.tz_dsttime; + time_buffer->millitm = t_v.tv_usec / 1000; + time_buffer->time = t_v.tv_sec; + return 0;} +#endif diff --git a/unexalpha.c b/unexalpha.c new file mode 100644 index 0000000..2adfd1f --- /dev/null +++ b/unexalpha.c @@ -0,0 +1,495 @@ +/* Unexec for DEC alpha. schoepf@sc.ZIB-Berlin.DE (Rainer Schoepf). + + Copyright (C) 1994 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +#include <config.h> +#include <sys/types.h> +#include <sys/file.h> +#include <sys/stat.h> +#include <sys/mman.h> +#include <stdio.h> +#include <varargs.h> +#include <filehdr.h> +#include <aouthdr.h> +#include <scnhdr.h> +#include <syms.h> +#ifndef __linux__ +# include <reloc.h> +# include <elf_abi.h> +#endif + +static void fatal_unexec (); +static void mark_x (); + +#define READ(_fd, _buffer, _size, _error_message, _error_arg) \ + errno = EEOF; \ + if (read (_fd, _buffer, _size) != _size) \ + fatal_unexec (_error_message, _error_arg); + +#define WRITE(_fd, _buffer, _size, _error_message, _error_arg) \ + if (write (_fd, _buffer, _size) != _size) \ + fatal_unexec (_error_message, _error_arg); + +#define SEEK(_fd, _position, _error_message, _error_arg) \ + errno = EEOF; \ + if (lseek (_fd, _position, L_SET) != _position) \ + fatal_unexec (_error_message, _error_arg); + +extern int errno; +extern char *strerror (); + +void *sbrk (); + +#define EEOF -1 + +static struct scnhdr *text_section; +static struct scnhdr *rel_dyn_section; +static struct scnhdr *dynstr_section; +static struct scnhdr *dynsym_section; +static struct scnhdr *init_section; +static struct scnhdr *finit_section; +static struct scnhdr *rdata_section; +static struct scnhdr *rconst_section; +static struct scnhdr *data_section; +static struct scnhdr *pdata_section; +static struct scnhdr *xdata_section; +static struct scnhdr *got_section; +static struct scnhdr *lit8_section; +static struct scnhdr *lit4_section; +static struct scnhdr *sdata_section; +static struct scnhdr *sbss_section; +static struct scnhdr *bss_section; + +static struct scnhdr old_data_scnhdr; + +static unsigned long Brk; + +struct headers { + struct filehdr fhdr; + struct aouthdr aout; + struct scnhdr section[_MIPS_NSCNS_MAX]; +}; + + + +/* Define name of label for entry point for the dumped executable. */ + +#ifndef DEFAULT_ENTRY_ADDRESS +#define DEFAULT_ENTRY_ADDRESS __start +#endif + +unexec (new_name, a_name, data_start, bss_start, entry_address) + char *new_name, *a_name; + unsigned long data_start, bss_start, entry_address; +{ + int new, old; + char * oldptr; + struct headers ohdr, nhdr; + struct stat stat; + long pagesize, brk; + long newsyms, symrel; + int nread; + int i; + long vaddr, scnptr; +#define BUFSIZE 8192 + char buffer[BUFSIZE]; + + if ((old = open (a_name, O_RDONLY)) < 0) + fatal_unexec ("opening %s", a_name); + + new = creat (new_name, 0666); + if (new < 0) fatal_unexec ("creating %s", new_name); + + if ((fstat (old, &stat) == -1)) + fatal_unexec ("fstat %s", a_name); + + oldptr = (char *)mmap (0, stat.st_size, PROT_READ, MAP_FILE|MAP_SHARED, old, 0); + + if (oldptr == (char *)-1) + fatal_unexec ("mmap %s", a_name); + + close (old); + + /* This is a copy of the a.out header of the original executable */ + + ohdr = (*(struct headers *)oldptr); + + /* This is where we build the new header from the in-memory copy */ + + nhdr = *((struct headers *)TEXT_START); + + /* First do some consistency checks */ + + if (nhdr.fhdr.f_magic != ALPHAMAGIC + && nhdr.fhdr.f_magic != ALPHAUMAGIC) + { + fprintf (stderr, "unexec: input file magic number is %x, not %x or %x.\n", + nhdr.fhdr.f_magic, ALPHAMAGIC, ALPHAUMAGIC); + exit (1); + } + + if (nhdr.fhdr.f_opthdr != sizeof (nhdr.aout)) + { + fprintf (stderr, "unexec: input a.out header is %d bytes, not %d.\n", + nhdr.fhdr.f_opthdr, sizeof (nhdr.aout)); + exit (1); + } + if (nhdr.aout.magic != ZMAGIC) + { + fprintf (stderr, "unexec: input file a.out magic number is %o, not %o.\n", + nhdr.aout.magic, ZMAGIC); + exit (1); + } + + + /* Now check the existence of certain header section and grab + their addresses. */ + +#define CHECK_SCNHDR(ptr, name, flags) \ + ptr = NULL; \ + for (i = 0; i < nhdr.fhdr.f_nscns && !ptr; i++) \ + if (strncmp (nhdr.section[i].s_name, name, 8) == 0) \ + { \ + if (nhdr.section[i].s_flags != flags) \ + fprintf (stderr, "unexec: %x flags (%x expected) in %s section.\n", \ + nhdr.section[i].s_flags, flags, name); \ + ptr = nhdr.section + i; \ + } \ + + CHECK_SCNHDR (text_section, _TEXT, STYP_TEXT); + CHECK_SCNHDR (init_section, _INIT, STYP_INIT); +#ifdef _REL_DYN + CHECK_SCNHDR (rel_dyn_section, _REL_DYN, STYP_REL_DYN); +#endif /* _REL_DYN */ +#ifdef _DYNSYM + CHECK_SCNHDR (dynsym_section, _DYNSYM, STYP_DYNSYM); +#endif /* _REL_DYN */ +#ifdef _DYNSTR + CHECK_SCNHDR (dynstr_section, _DYNSTR, STYP_DYNSTR); +#endif /* _REL_DYN */ +#ifdef _FINI + CHECK_SCNHDR (finit_section, _FINI, STYP_FINI); +#endif /* _FINI */ + CHECK_SCNHDR (rdata_section, _RDATA, STYP_RDATA); +#ifdef _RCONST + CHECK_SCNHDR (rconst_section, _RCONST, STYP_RCONST); +#endif +#ifdef _PDATA + CHECK_SCNHDR (pdata_section, _PDATA, STYP_PDATA); +#endif _PDATA +#ifdef _GOT + CHECK_SCNHDR (got_section, _GOT, STYP_GOT); +#endif _GOT + CHECK_SCNHDR (data_section, _DATA, STYP_DATA); +#ifdef _XDATA + CHECK_SCNHDR (xdata_section, _XDATA, STYP_XDATA); +#endif /* _XDATA */ +#ifdef _LIT8 + CHECK_SCNHDR (lit8_section, _LIT8, STYP_LIT8); + CHECK_SCNHDR (lit4_section, _LIT4, STYP_LIT4); +#endif /* _LIT8 */ + CHECK_SCNHDR (sdata_section, _SDATA, STYP_SDATA); + CHECK_SCNHDR (sbss_section, _SBSS, STYP_SBSS); + CHECK_SCNHDR (bss_section, _BSS, STYP_BSS); + + + pagesize = getpagesize (); + brk = (((long) (sbrk (0))) + pagesize - 1) & (-pagesize); + + /* Remember the current break */ + + Brk = brk; + + bcopy (data_section, &old_data_scnhdr, sizeof (old_data_scnhdr)); + + nhdr.aout.dsize = brk - DATA_START; + nhdr.aout.bsize = 0; + if (entry_address == 0) + { + extern DEFAULT_ENTRY_ADDRESS (); + nhdr.aout.entry = (unsigned long)DEFAULT_ENTRY_ADDRESS; + } + else + nhdr.aout.entry = entry_address; + + nhdr.aout.bss_start = nhdr.aout.data_start + nhdr.aout.dsize; + + if (rdata_section != NULL) + { + rdata_section->s_size = data_start - DATA_START; + + /* Adjust start and virtual addresses of rdata_section, too. */ + rdata_section->s_vaddr = DATA_START; + rdata_section->s_paddr = DATA_START; + rdata_section->s_scnptr = text_section->s_scnptr + nhdr.aout.tsize; + } + + data_section->s_vaddr = data_start; + data_section->s_paddr = data_start; + data_section->s_size = brk - data_start; + + if (rdata_section != NULL) + { + data_section->s_scnptr = rdata_section->s_scnptr + rdata_section->s_size; + } + + vaddr = data_section->s_vaddr + data_section->s_size; + scnptr = data_section->s_scnptr + data_section->s_size; + if (lit8_section != NULL) + { + lit8_section->s_vaddr = vaddr; + lit8_section->s_paddr = vaddr; + lit8_section->s_size = 0; + lit8_section->s_scnptr = scnptr; + } + if (lit4_section != NULL) + { + lit4_section->s_vaddr = vaddr; + lit4_section->s_paddr = vaddr; + lit4_section->s_size = 0; + lit4_section->s_scnptr = scnptr; + } + if (sdata_section != NULL) + { + sdata_section->s_vaddr = vaddr; + sdata_section->s_paddr = vaddr; + sdata_section->s_size = 0; + sdata_section->s_scnptr = scnptr; + } +#ifdef _XDATA + if (xdata_section != NULL) + { + xdata_section->s_vaddr = vaddr; + xdata_section->s_paddr = vaddr; + xdata_section->s_size = 0; + xdata_section->s_scnptr = scnptr; + } +#endif +#ifdef _GOT + if (got_section != NULL) + { + bcopy (got_section, buffer, sizeof (struct scnhdr)); + + got_section->s_vaddr = vaddr; + got_section->s_paddr = vaddr; + got_section->s_size = 0; + got_section->s_scnptr = scnptr; + } +#endif /*_GOT */ + if (sbss_section != NULL) + { + sbss_section->s_vaddr = vaddr; + sbss_section->s_paddr = vaddr; + sbss_section->s_size = 0; + sbss_section->s_scnptr = scnptr; + } + if (bss_section != NULL) + { + bss_section->s_vaddr = vaddr; + bss_section->s_paddr = vaddr; + bss_section->s_size = 0; + bss_section->s_scnptr = scnptr; + } + + WRITE (new, (char *)TEXT_START, nhdr.aout.tsize, + "writing text section to %s", new_name); + WRITE (new, (char *)DATA_START, nhdr.aout.dsize, + "writing data section to %s", new_name); + +#ifdef _GOT +#define old_got_section ((struct scnhdr *)buffer) + + if (got_section != NULL) + { + SEEK (new, old_got_section->s_scnptr, + "seeking to start of got_section in %s", new_name); + WRITE (new, oldptr + old_got_section->s_scnptr, old_got_section->s_size, + "writing new got_section of %s", new_name); + SEEK (new, nhdr.aout.tsize + nhdr.aout.dsize, + "seeking to end of data section of %s", new_name); + } + +#undef old_got_section +#endif + + /* + * Construct new symbol table header + */ + + bcopy (oldptr + nhdr.fhdr.f_symptr, buffer, cbHDRR); + +#define symhdr ((pHDRR)buffer) + newsyms = nhdr.aout.tsize + nhdr.aout.dsize; + symrel = newsyms - nhdr.fhdr.f_symptr; + nhdr.fhdr.f_symptr = newsyms; + symhdr->cbLineOffset += symrel; + symhdr->cbDnOffset += symrel; + symhdr->cbPdOffset += symrel; + symhdr->cbSymOffset += symrel; + symhdr->cbOptOffset += symrel; + symhdr->cbAuxOffset += symrel; + symhdr->cbSsOffset += symrel; + symhdr->cbSsExtOffset += symrel; + symhdr->cbFdOffset += symrel; + symhdr->cbRfdOffset += symrel; + symhdr->cbExtOffset += symrel; + + WRITE (new, buffer, cbHDRR, "writing symbol table header of %s", new_name); + + /* + * Copy the symbol table and line numbers + */ + WRITE (new, oldptr + ohdr.fhdr.f_symptr + cbHDRR, + stat.st_size - ohdr.fhdr.f_symptr - cbHDRR, + "writing symbol table of %s", new_name); + +#ifndef __linux__ + update_dynamic_symbols (oldptr, new_name, new, nhdr.aout); +#endif + +#undef symhdr + + SEEK (new, 0, "seeking to start of header in %s", new_name); + WRITE (new, &nhdr, sizeof (nhdr), + "writing header of %s", new_name); + + close (old); + close (new); + mark_x (new_name); +} + + + + +#ifndef __linux__ + +update_dynamic_symbols (old, new_name, new, aout) + char *old; /* Pointer to old executable */ + char *new_name; /* Name of new executable */ + int new; /* File descriptor for new executable */ + struct aouthdr aout; /* a.out info from the file header */ +{ + typedef struct dynrel_info { + char * addr; + unsigned type:8; + unsigned index:24; + unsigned info:8; + unsigned pad:8; + } dr_info; + + int nsyms = rel_dyn_section->s_size / sizeof (struct dynrel_info); + int i; + dr_info * rd_base = (dr_info *) (old + rel_dyn_section->s_scnptr); + Elf32_Sym * ds_base = (Elf32_Sym *) (old + dynsym_section->s_scnptr); + + for (i = 0; i < nsyms; i++) { + register Elf32_Sym x; + + if (rd_base[i].index == 0) + continue; + + x = ds_base[rd_base[i].index]; + +#if 0 + fprintf (stderr, "Object inspected: %s, addr = %lx, shndx = %x", + old + dynstr_section->s_scnptr + x.st_name, rd_base[i].addr, x.st_shndx); +#endif + + + if ((ELF32_ST_BIND (x.st_info) == STB_GLOBAL) + && (x.st_shndx == 0) + /* && (x.st_value == NULL) */ + ) { + /* OK, this is probably a reference to an object in a shared + library, so copy the old value. This is done in several steps: + 1. reladdr is the address of the location in question relative to + the start of the data section, + 2. oldref is the addr is the mapped in temacs executable, + 3. newref is the address of the location in question in the + undumped executable, + 4. len is the size of the object reference in bytes -- + currently only 4 (long) and 8 (quad) are supported. + */ + register unsigned long reladdr = rd_base[i].addr - old_data_scnhdr.s_vaddr; + char * oldref = old + old_data_scnhdr.s_scnptr + reladdr; + unsigned long newref = aout.tsize + reladdr; + int len; + +#if 0 + fprintf (stderr, "...relocated\n"); +#endif + + if (rd_base[i].type == R_REFLONG) + len = 4; + else if (rd_base[i].type == R_REFQUAD) + len = 8; + else + fatal_unexec ("unrecognized relocation type in .dyn.rel section (symbol #%d)", i); + + SEEK (new, newref, "seeking to dynamic symbol in %s", new_name); + WRITE (new, oldref, len, "writing old dynrel info in %s", new_name); + } + +#if 0 + else + fprintf (stderr, "...not relocated\n"); +#endif + + } + +} + +#endif /* !__linux__ */ + + +/* + * mark_x + * + * After successfully building the new a.out, mark it executable + */ + +static void +mark_x (name) + char *name; +{ + struct stat sbuf; + int um = umask (777); + umask (um); + if (stat (name, &sbuf) < 0) + fatal_unexec ("getting protection on %s", name); + sbuf.st_mode |= 0111 & ~um; + if (chmod (name, sbuf.st_mode) < 0) + fatal_unexec ("setting protection on %s", name); +} + +static void +fatal_unexec (s, arg) + char *s; + char *arg; +{ + if (errno == EEOF) + fputs ("unexec: unexpected end of file, ", stderr); + else + fprintf (stderr, "unexec: %s, ", strerror (errno)); + fprintf (stderr, s, arg); + fputs (".\n", stderr); + exit (1); +} diff --git a/unexhp9k800.c b/unexhp9k800.c new file mode 100644 index 0000000..f33340c --- /dev/null +++ b/unexhp9k800.c @@ -0,0 +1,319 @@ +/* Unexec for HP 9000 Series 800 machines. + Bob Desinger <hpsemc!bd@hplabs.hp.com> + + Note that the GNU project considers support for HP operation a + peripheral activity which should not be allowed to divert effort + from development of the GNU system. Changes in this code will be + installed when users send them in, but aside from that we don't + plan to think about it, or about whether other Emacs maintenance + might break it. + + + Unexec creates a copy of the old a.out file, and replaces the old data + area with the current data area. When the new file is executed, the + process will see the same data structures and data values that the + original process had when unexec was called. + + Unlike other versions of unexec, this one copies symbol table and + debug information to the new a.out file. Thus, the new a.out file + may be debugged with symbolic debuggers. + + If you fix any bugs in this, I'd like to incorporate your fixes. + Send them to uunet!hpda!hpsemc!jmorris or jmorris%hpsemc@hplabs.HP.COM. + + CAVEATS: + This routine saves the current value of all static and external + variables. This means that any data structure that needs to be + initialized must be explicitly reset. Variables will not have their + expected default values. + + Unfortunately, the HP-UX signal handler has internal initialization + flags which are not explicitly reset. Thus, for signals to work in + conjunction with this routine, the following code must executed when + the new process starts up. + + void _sigreturn (); + ... + sigsetreturn (_sigreturn); +*/ + +#include <stdio.h> +#include <fcntl.h> +#include <errno.h> + +#include <a.out.h> + +#ifdef emacs +#include <config.h> +#endif + +#ifdef HPUX_USE_SHLIBS +#include <dl.h> +#endif + +/* brk value to restore, stored as a global. + This is really used only if we used shared libraries. */ +static long brk_on_dump = 0; + +/* Called from main, if we use shared libraries. */ +int +run_time_remap (ignored) + char *ignored; +{ + brk ((char *) brk_on_dump); +} + +#undef roundup +#define roundup(x,n) (((x) + ((n) - 1)) & ~((n) - 1)) /* n is power of 2 */ +#define min(x,y) (((x) < (y)) ? (x) : (y)) + + +/* Create a new a.out file, same as old but with current data space */ + +unexec (new_name, old_name, new_end_of_text, dummy1, dummy2) + char new_name[]; /* name of the new a.out file to be created */ + char old_name[]; /* name of the old a.out file */ + char *new_end_of_text; /* ptr to new edata/etext; NOT USED YET */ + int dummy1, dummy2; /* not used by emacs */ +{ + int old, new; + int old_size, new_size; + struct header hdr; + struct som_exec_auxhdr auxhdr; + long i; + + /* For the greatest flexibility, should create a temporary file in + the same directory as the new file. When everything is complete, + rename the temp file to the new name. + This way, a program could update its own a.out file even while + it is still executing. If problems occur, everything is still + intact. NOT implemented. */ + + /* Open the input and output a.out files */ + old = open (old_name, O_RDONLY); + if (old < 0) + { perror (old_name); exit (1); } + new = open (new_name, O_CREAT|O_RDWR|O_TRUNC, 0777); + if (new < 0) + { perror (new_name); exit (1); } + + /* Read the old headers */ + read_header (old, &hdr, &auxhdr); + + brk_on_dump = (long) sbrk (0); + + /* Decide how large the new and old data areas are */ + old_size = auxhdr.exec_dsize; + /* I suspect these two statements are separate + to avoid a compiler bug in hpux version 8. */ + i = (long) sbrk (0); + new_size = i - auxhdr.exec_dmem; + + /* Copy the old file to the new, up to the data space */ + lseek (old, 0, 0); + copy_file (old, new, auxhdr.exec_dfile); + + /* Skip the old data segment and write a new one */ + lseek (old, old_size, 1); + save_data_space (new, &hdr, &auxhdr, new_size); + + /* Copy the rest of the file */ + copy_rest (old, new); + + /* Update file pointers since we probably changed size of data area */ + update_file_ptrs (new, &hdr, &auxhdr, auxhdr.exec_dfile, new_size-old_size); + + /* Save the modified header */ + write_header (new, &hdr, &auxhdr); + + /* Close the binary file */ + close (old); + close (new); + return 0; +} + +/* Save current data space in the file, update header. */ + +save_data_space (file, hdr, auxhdr, size) + int file; + struct header *hdr; + struct som_exec_auxhdr *auxhdr; + int size; +{ + /* Write the entire data space out to the file */ + if (write (file, auxhdr->exec_dmem, size) != size) + { perror ("Can't save new data space"); exit (1); } + + /* Update the header to reflect the new data size */ + auxhdr->exec_dsize = size; + auxhdr->exec_bsize = 0; +} + +/* Update the values of file pointers when something is inserted. */ + +update_file_ptrs (file, hdr, auxhdr, location, offset) + int file; + struct header *hdr; + struct som_exec_auxhdr *auxhdr; + unsigned int location; + int offset; +{ + struct subspace_dictionary_record subspace; + int i; + + /* Increase the overall size of the module */ + hdr->som_length += offset; + + /* Update the various file pointers in the header */ +#define update(ptr) if (ptr > location) ptr = ptr + offset + update (hdr->aux_header_location); + update (hdr->space_strings_location); + update (hdr->init_array_location); + update (hdr->compiler_location); + update (hdr->symbol_location); + update (hdr->fixup_request_location); + update (hdr->symbol_strings_location); + update (hdr->unloadable_sp_location); + update (auxhdr->exec_tfile); + update (auxhdr->exec_dfile); + + /* Do for each subspace dictionary entry */ + lseek (file, hdr->subspace_location, 0); + for (i = 0; i < hdr->subspace_total; i++) + { + if (read (file, &subspace, sizeof (subspace)) != sizeof (subspace)) + { perror ("Can't read subspace record"); exit (1); } + + /* If subspace has a file location, update it */ + if (subspace.initialization_length > 0 + && subspace.file_loc_init_value > location) + { + subspace.file_loc_init_value += offset; + lseek (file, -sizeof (subspace), 1); + if (write (file, &subspace, sizeof (subspace)) != sizeof (subspace)) + { perror ("Can't update subspace record"); exit (1); } + } + } + + /* Do for each initialization pointer record */ + /* (I don't think it applies to executable files, only relocatables) */ +#undef update +} + +/* Read in the header records from an a.out file. */ + +read_header (file, hdr, auxhdr) + int file; + struct header *hdr; + struct som_exec_auxhdr *auxhdr; +{ + + /* Read the header in */ + lseek (file, 0, 0); + if (read (file, hdr, sizeof (*hdr)) != sizeof (*hdr)) + { perror ("Couldn't read header from a.out file"); exit (1); } + + if (hdr->a_magic != EXEC_MAGIC && hdr->a_magic != SHARE_MAGIC + && hdr->a_magic != DEMAND_MAGIC) + { + fprintf (stderr, "a.out file doesn't have legal magic number\n"); + exit (1); + } + + lseek (file, hdr->aux_header_location, 0); + if (read (file, auxhdr, sizeof (*auxhdr)) != sizeof (*auxhdr)) + { + perror ("Couldn't read auxiliary header from a.out file"); + exit (1); + } +} + +/* Write out the header records into an a.out file. */ + +write_header (file, hdr, auxhdr) + int file; + struct header *hdr; + struct som_exec_auxhdr *auxhdr; +{ + /* Update the checksum */ + hdr->checksum = calculate_checksum (hdr); + + /* Write the header back into the a.out file */ + lseek (file, 0, 0); + if (write (file, hdr, sizeof (*hdr)) != sizeof (*hdr)) + { perror ("Couldn't write header to a.out file"); exit (1); } + lseek (file, hdr->aux_header_location, 0); + if (write (file, auxhdr, sizeof (*auxhdr)) != sizeof (*auxhdr)) + { perror ("Couldn't write auxiliary header to a.out file"); exit (1); } +} + +/* Calculate the checksum of a SOM header record. */ + +calculate_checksum (hdr) + struct header *hdr; +{ + int checksum, i, *ptr; + + checksum = 0; ptr = (int *) hdr; + + for (i = 0; i < sizeof (*hdr) / sizeof (int) - 1; i++) + checksum ^= ptr[i]; + + return (checksum); +} + +/* Copy size bytes from the old file to the new one. */ + +copy_file (old, new, size) + int new, old; + int size; +{ + int len; + int buffer[8192]; /* word aligned will be faster */ + + for (; size > 0; size -= len) + { + len = min (size, sizeof (buffer)); + if (read (old, buffer, len) != len) + { perror ("Read failure on a.out file"); exit (1); } + if (write (new, buffer, len) != len) + { perror ("Write failure in a.out file"); exit (1); } + } +} + +/* Copy the rest of the file, up to EOF. */ + +copy_rest (old, new) + int new, old; +{ + int buffer[4096]; + int len; + + /* Copy bytes until end of file or error */ + while ((len = read (old, buffer, sizeof (buffer))) > 0) + if (write (new, buffer, len) != len) break; + + if (len != 0) + { perror ("Unable to copy the rest of the file"); exit (1); } +} + +#ifdef DEBUG +display_header (hdr, auxhdr) + struct header *hdr; + struct som_exec_auxhdr *auxhdr; +{ + /* Display the header information (debug) */ + printf ("\n\nFILE HEADER\n"); + printf ("magic number %d \n", hdr->a_magic); + printf ("text loc %.8x size %d \n", auxhdr->exec_tmem, auxhdr->exec_tsize); + printf ("data loc %.8x size %d \n", auxhdr->exec_dmem, auxhdr->exec_dsize); + printf ("entry %x \n", auxhdr->exec_entry); + printf ("Bss segment size %u\n", auxhdr->exec_bsize); + printf ("\n"); + printf ("data file loc %d size %d\n", + auxhdr->exec_dfile, auxhdr->exec_dsize); + printf ("som_length %d\n", hdr->som_length); + printf ("unloadable sploc %d size %d\n", + hdr->unloadable_sp_location, hdr->unloadable_sp_size); +} +#endif /* DEBUG */ diff --git a/unexsunos4.c b/unexsunos4.c new file mode 100644 index 0000000..bdc2033 --- /dev/null +++ b/unexsunos4.c @@ -0,0 +1,378 @@ +/* Unexec for Sunos 4 using shared libraries. + Copyright (C) 1990, 1994 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Contributed by Viktor Dukhovni. */ +/* + * Unexec for Berkeley a.out format + SUNOS shared libraries + * The unexeced executable contains the __DYNAMIC area from the + * original text file, and then the rest of data + bss + malloced area of + * the current process. (The __DYNAMIC area is at the top of the process + * data segment, we use "data_start" defined externally to mark the start + * of the "real" data segment.) + * + * For programs that want to remap some of the data segment read only + * a run_time_remap is provided. This attempts to remap largest area starting + * and ending on page boundaries between "data_start" and "bndry" + * For this it to figure out where the text file is located. A path search + * is attempted after trying argv[0] and if all fails we simply do not remap + * + * One feature of run_time_remap () is mandatory: reseting the break. + * + * Note that we can no longer map data into the text segment, as this causes + * the __DYNAMIC struct to become read only, breaking the runtime loader. + * Thus we no longer need to mess with a private crt0.c, the standard one + * will do just fine, since environ can live in the writable area between + * __DYNAMIC and data_start, just make sure that pre-crt0.o (the name + * is somewhat abused here) is loaded first! + * + */ +#include <sys/param.h> +#include <sys/mman.h> +#include <sys/file.h> +#include <sys/stat.h> +#include <string.h> +#include <stdio.h> +#include <a.out.h> + +/* Do this after the above #include's in case a configuration file wants + to define things for this file based on what <a.out.h> defines. */ +#ifdef emacs +#include <config.h> +#endif + +#if defined (SUNOS4) || defined (__FreeBSD__) || defined (__NetBSD__) +#define UNDO_RELOCATION +#endif + +#ifdef UNDO_RELOCATION +#include <link.h> +#endif + +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif + +/* NetBSD needs this bit, but SunOS does not have it. */ +#ifndef MAP_FILE +#define MAP_FILE 0 +#endif + + +/* + * for programs other than emacs + * define data_start + initialized here, and make sure + * this object is loaded first! + * emacs will define these elsewhere, and load the object containing + * data_start (pre-crt0.o or firstfile.o?) first! + * The custom crt0.o *must not* be loaded! + */ +#ifndef emacs + static int data_start = 0; + static int initialized = 0; +#else + extern int initialized; + extern unsigned data_start; + extern int pureptr; +#endif + +extern char *getenv (); +static unsigned brk_value; +static struct exec nhdr; +static int rd_only_len; +static long cookie; + + +unexec (new_name, a_name, bndry, bss_start, entry) + char *new_name, *a_name; + unsigned bndry, bss_start, entry; +{ + int fd, new; + char *old; + struct exec ohdr; /* Allocate on the stack, not needed in the next life */ + struct stat stat; + + if ((fd = open (a_name, O_RDONLY)) < 0) + { + fprintf (stderr, "%s: open: ", a_name); + perror (a_name); + exit (1); + } + if ((new = open (new_name, O_WRONLY | O_CREAT, 0666)) == -1) + { + fprintf (stderr, "%s: open: ", a_name); + perror (new_name); + exit (1); + } + + if ((fstat (fd, &stat) == -1)) + { + fprintf (stderr, "%s: ", a_name); + perror ("fstat"); + exit (1); + } + + old = (char *)mmap (0, stat.st_size, PROT_READ, MAP_FILE|MAP_SHARED, fd, 0); + if (old == (char *)-1) + { + fprintf (stderr, "%s: ", a_name); + perror ("mmap"); + exit (1); + } + close (fd); + + nhdr = ohdr = (*(struct exec *)old); + + + /* + * Remember a magic cookie so we know we've got the right binary + * when remapping. + */ + cookie = time (0); + + /* Save the break, it is reset to &_end (by ld.so?). */ + brk_value = (unsigned) sbrk (0); + + /* + * Round up data start to a page boundary (Lose if not a 2 power!) + */ + data_start = ((((int)&data_start) - 1) & ~(N_PAGSIZ (nhdr) - 1)) + N_PAGSIZ (nhdr); + + /* + * Round down read only pages to a multiple of the page size + */ + if (bndry) + rd_only_len = ((int)bndry & ~(N_PAGSIZ (nhdr) - 1)) - data_start; + +#ifndef emacs + /* Have to do this some time before dumping the data */ + initialized = 1; +#endif + + /* Handle new data and bss sizes and optional new entry point. + No one actually uses bss_start and entry, but tradition compels + one to support them. + Could complain if bss_start > brk_value, + but the caller is *supposed* to know what she is doing. */ + nhdr.a_data = (bss_start ? bss_start : brk_value) - N_DATADDR (nhdr); + nhdr.a_bss = bss_start ? brk_value - bss_start : 0; + if (entry) + nhdr.a_entry = entry; + + /* + * Write out the text segment with new header + * Dynamic executables are ZMAGIC with N_TXTOFF==0 and the header + * part of the text segment, but no need to rely on this. + * So write the TEXT first, then go back replace the header. + * Doing it in the other order is less general! + */ + lseek (new, N_TXTOFF (nhdr), L_SET); + write (new, old + N_TXTOFF (ohdr), N_TXTOFF (ohdr) + ohdr.a_text); + lseek (new, 0L, L_SET); + write (new, &nhdr, sizeof (nhdr)); + + /* + * Write out the head of the old data segment from the file not + * from core, this has the unresolved __DYNAMIC relocation data + * we need to reload + */ + lseek (new, N_DATOFF (nhdr), L_SET); + write (new, old + N_DATOFF (ohdr), (int)&data_start - N_DATADDR (ohdr)); + + /* + * Copy the rest of the data from core + */ + write (new, &data_start, N_BSSADDR (nhdr) - (int)&data_start); + + /* + * Copy the symbol table and line numbers + */ + lseek (new, N_TRELOFF (nhdr), L_SET); + write (new, old + N_TRELOFF (ohdr), stat.st_size - N_TRELOFF (ohdr)); + + /* Some other BSD systems use this file. + We don't know whether this change is right for them. */ +#ifdef UNDO_RELOCATION + /* Undo the relocations done at startup by ld.so. + It will do these relocations again when we start the dumped Emacs. + Doing them twice gives incorrect results. */ + { + unsigned long daddr = N_DATADDR (ohdr); + unsigned long rel, erel; +#ifdef SUNOS4 +#ifdef SUNOS4_SHARED_LIBRARIES + extern struct link_dynamic _DYNAMIC; + + /* SunOS4.x's ld_rel is relative to N_TXTADDR. */ + if (!ohdr.a_dynamic) + /* This was statically linked. */ + rel = erel = 0; + else if (_DYNAMIC.ld_version < 2) + { + rel = _DYNAMIC.ld_un.ld_1->ld_rel + N_TXTADDR (ohdr); + erel = _DYNAMIC.ld_un.ld_1->ld_hash + N_TXTADDR (ohdr); + } + else + { + rel = _DYNAMIC.ld_un.ld_2->ld_rel + N_TXTADDR (ohdr); + erel = _DYNAMIC.ld_un.ld_2->ld_hash + N_TXTADDR (ohdr); + } +#else /* not SUNOS4_SHARED_LIBRARIES */ + rel = erel = 0; +#endif /* not SUNOS4_SHARED_LIBRARIES */ +#ifdef sparc +#define REL_INFO_TYPE struct reloc_info_sparc +#else +#define REL_INFO_TYPE struct relocation_info +#endif /* sparc */ +#define REL_TARGET_ADDRESS(r) (((REL_INFO_TYPE *)(r))->r_address) +#endif /* SUNOS4 */ +#if defined (__FreeBSD__) || defined (__NetBSD__) + extern struct _dynamic _DYNAMIC; + + /* FreeBSD's LD_REL is a virtual address itself. */ + rel = LD_REL (&_DYNAMIC); + erel = rel + LD_RELSZ (&_DYNAMIC); +#define REL_INFO_TYPE struct relocation_info +#define REL_TARGET_ADDRESS(r) (((REL_INFO_TYPE *)(r))->r_address) +#endif + + for (; rel < erel; rel += sizeof (REL_INFO_TYPE)) + { + /* This is the virtual address where ld.so will do relocation. */ + unsigned long target = REL_TARGET_ADDRESS (rel); + /* This is the offset in the data segment. */ + unsigned long segoffset = target - daddr; + + /* If it is located below data_start, we have to do nothing here, + because the old data has been already written to the location. */ + if (target < (unsigned long)&data_start) + continue; + + lseek (new, N_DATOFF (nhdr) + segoffset, L_SET); + write (new, old + N_DATOFF (ohdr) + segoffset, sizeof (unsigned long)); + } + } +#endif /* UNDO_RELOCATION */ + + fchmod (new, 0755); +} + +void +run_time_remap (progname) + char *progname; +{ + char aout[MAXPATHLEN]; + register char *path, *p; + + /* Just in case */ + if (!initialized) + return; + + /* Restore the break */ + brk ((char *) brk_value); + + /* If nothing to remap: we are done! */ + if (rd_only_len == 0) + return; + + /* + * Attempt to find the executable + * First try argv[0], will almost always succeed as shells tend to give + * the full path from the hash list rather than using execvp () + */ + if (is_it (progname)) + return; + + /* + * If argv[0] is a full path and does not exist, not much sense in + * searching further + */ + if (strchr (progname, '/')) + return; + + /* + * Try to search for argv[0] on the PATH + */ + path = getenv ("PATH"); + if (path == NULL) + return; + + while (*path) + { + /* copy through ':' or end */ + for (p = aout; *p = *path; ++p, ++path) + if (*p == ':') + { + ++path; /* move past ':' */ + break; + } + *p++ = '/'; + strcpy (p, progname); + /* + * aout is a candidate full path name + */ + if (is_it (aout)) + return; + } +} + +is_it (filename) + char *filename; +{ + int fd; + long filenames_cookie; + struct exec hdr; + + /* + * Open an executable and check for a valid header! + * Can't bcmp the header with what we had, it may have been stripped! + * so we may save looking at non executables with the same name, mostly + * directories. + */ + fd = open (filename, O_RDONLY); + if (fd != -1) + { + if (read (fd, &hdr, sizeof (hdr)) == sizeof (hdr) + && !N_BADMAG (hdr) && N_DATOFF (hdr) == N_DATOFF (nhdr) + && N_TRELOFF (hdr) == N_TRELOFF (nhdr)) + { + /* compare cookies */ + lseek (fd, N_DATOFF (hdr) + (int)&cookie - N_DATADDR (hdr), L_SET); + read (fd, &filenames_cookie, sizeof (filenames_cookie)); + if (filenames_cookie == cookie) + { /* Eureka */ + + /* + * Do the mapping + * The PROT_EXEC may not be needed, but it is safer this way. + * should the shared library decide to indirect through + * addresses in the data segment not part of __DYNAMIC + */ + mmap ((char *) data_start, rd_only_len, PROT_READ | PROT_EXEC, + MAP_FILE | MAP_SHARED | MAP_FIXED, fd, + N_DATOFF (hdr) + data_start - N_DATADDR (hdr)); + close (fd); + return 1; + } + } + close (fd); + } + return 0; +} @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -1761,6 +1761,10 @@ static void rapr1(ra, j, k, port, writing) lputc(CHARS(ra)[j], port); break; case tc7_uvect: + if (errjmp_bad) { + ipruk("uvect", ra, port); + break; + } if (n-- > 0) iprin1(ulong2num(VELTS(ra)[j]), port, writing); for (j += inc; n-- > 0; j += inc) { lputc(' ', port); @@ -49,6 +49,7 @@ /* #include <sys/wait.h> */ #include <sys/stat.h> + SCM stat2scm P((struct stat *stat_temp)); #ifndef STDC_HEADERS @@ -57,6 +58,10 @@ SCM stat2scm P((struct stat *stat_temp)); int readlink P((const char *path, char *buf, sizet bufsiz)); int acct P((const char *filename)); int nice P((int inc)); +#else /* added by Denys Duchier: for acct, etc... */ +# ifdef SVR4 +# include <unistd.h> +# endif #endif /* STDC_HEADERS */ /* Only the superuser can successfully execute mknod and acct */ |