From 1edcb9b62a1a520eddae8403c19d841c9b18737f Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:24 -0800 Subject: Import Upstream version 5b3 --- .gdbinit | 96 ++ ANNOUNCE | 195 +-- COPYING | 7 +- ChangeLog | 410 +++++- Init.scm | 184 ++- Link.scm | 149 +- Macro.scm | 292 ++++ Makefile | 116 +- Makefile.in | 462 ------ README | 47 +- README.unix | 182 --- Transcen.scm | 2 +- acconfig-1.5.h | 22 - bench.scm | 42 + build.bat | 2 +- build.scm | 702 ++++++--- configure | 849 ----------- configure.in | 33 - continue.c | 35 +- continue.h | 33 +- dynl.c | 35 +- ecrt0.c | 10 + eval.c | 574 ++++++-- findexec.c | 32 +- gmalloc.c | 10 + install-sh | 238 --- ioext.c | 10 +- mkimpcat.scm | 221 +++ mkinstalldirs | 35 - patchlvl.h | 2 +- posix.c | 8 +- ramap.c | 2 + record.c | 15 +- repl.c | 230 +-- rgx.c | 54 +- rope.c | 31 +- sc2.c | 2 +- scl.c | 26 +- scm.c | 236 +-- scm.h | 57 +- scm.texi | 3780 ++++++++++++++++++++++++++++-------------------- scm4e3.scmconfig.patch | 60 - scmconfig.h.in | 69 - scmfig.h | 44 +- script.c | 384 +++++ setjump.h | 34 +- socket.c | 8 + subr.c | 24 +- sys.c | 70 +- time.c | 21 +- unexalpha.c | 495 +++++++ unexhp9k800.c | 319 ++++ unexsunos4.c | 378 +++++ unif.c | 6 +- unix.c | 5 + 55 files changed, 6688 insertions(+), 4697 deletions(-) create mode 100644 .gdbinit create mode 100644 Macro.scm delete mode 100644 Makefile.in delete mode 100644 README.unix delete mode 100644 acconfig-1.5.h delete mode 100755 configure delete mode 100644 configure.in delete mode 100644 install-sh create mode 100644 mkimpcat.scm delete mode 100755 mkinstalldirs delete mode 100644 scm4e3.scmconfig.patch delete mode 100644 scmconfig.h.in create mode 100644 script.c create mode 100644 unexalpha.c create mode 100644 unexhp9k800.c create mode 100644 unexsunos4.c 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 diff --git a/ANNOUNCE b/ANNOUNCE index 0edea3c..770a9cc 100644 --- a/ANNOUNCE +++ b/ANNOUNCE @@ -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 : - - * 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 - - * 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 - - * 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 + + * unexhp9k800.c: added HP-UX unexec support. + +Sun Sep 28 14:48:10 1997 Radey Shouman + + * 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 diff --git a/COPYING b/COPYING index a43ea21..60549be 100644 --- a/COPYING +++ b/COPYING @@ -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. diff --git a/ChangeLog b/ChangeLog index e689bb5..6f847a3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,365 @@ +Sun Nov 16 13:43:21 1997 Aubrey Jaffer + + * 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 + + * 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 + + * 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 + + * Init.scm (home-vicinity): added. Used to find "ScmInit.scm". + +Sat Oct 25 23:05:43 1997 Aubrey Jaffer + + * 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 + + * 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 + + * 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 + + * 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 + + * unexhp9k800.c: added HP-UX unexec support. + +Mon Sep 29 15:18:37 1997 Aubrey Jaffer + + * 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 + + * scm.h (const): defined to comment for hpux native cc. + +Sun Sep 28 14:48:10 1997 Radey Shouman + + * ramap.c (array_imap): Fixed for zero-rank arrays arguments. + +Fri Sep 19 23:23:46 EDT 1997 Aubrey Jaffer + + * patchlvl.h (SCMVERSION): Bumped from 5b1 to 5b2. + +Fri Sep 19 23:17:48 1997 Aubrey Jaffer + + * 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 + + * build.scm (build): Changed sun to sunos; This gives automatic + platform from uname. + +Wed Jul 2 14:25:52 1997 Anthony Green + + * 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 + + * 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 + + * mkimpcat.scm: updated for shared-library wb. + +Mon May 19 18:12:33 1997 Aubrey Jaffer + + * dynl.c (l_dyn_main_call): added for SUN_DL. + +Sat May 17 23:21:05 1997 Aubrey Jaffer + + * 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 + + * patchlvl.h (SCMVERSION): Bumped from 5b0 to 5b1. + +Sat May 10 21:08:41 1997 Aubrey Jaffer + + * mkimpcat.scm: moved from Init.scm, macro feature now properly + listed. + +Thu Apr 17 15:16:56 1997 Denys Duchier + + * 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 + + * Init.scm (print-args): syntax added. + +Mon Apr 28 20:24:47 1997 Aubrey Jaffer + + * 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 can now appear at end of lists and files. + +Fri Apr 25 22:52:20 1997 Aubrey Jaffer + + * scl.c (istr2flo): supplied missing IMP test before INEXP test. + +Fri Mar 21 08:44:52 1997 Aubrey Jaffer + + * Transcen.scm (log10): defined to $log10. + + * scl.c: added $log10. + +Thu Mar 20 21:09:19 1997 Aubrey Jaffer + + * 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 + + * 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 + + * 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 + + * patchlvl.h (SCMVERSION): Bumped from 5a0 to 5a1. + +Mon Mar 3 20:09:43 1997 Radey Shouman + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * ugsetjmp.s: Created for Ultrix-VAX port. + +Mon Feb 3 08:55:43 1997 Aubrey Jaffer + + * repl.c (read_token): `#' no longer terminates tokens + (identifiers and numbers). + +Sun Feb 2 17:42:50 1997 Aubrey Jaffer + + * 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 + + * patchlvl.h (SCMVERSION): Bumped from 4e6 to 5a0. + +Sat Jan 25 19:48:19 1997 Radey Shouman + + * 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 + + * 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 . + +Mon Dec 2 20:40:40 1996 Radey Shouman + + * 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 + + * build.scm (build): Added scm-srcdir to support compilation of + SCM source while not cd'd to SCM directory. -I added + to all builds (to pick up scm.h, etc.). + +Sat Nov 30 20:53:03 1996 Lorens Younes + + * findexec.c, scmfig.h, time.c: __amigados__ (gcc on amiga) + support added. + Mon Nov 18 22:56:11 1996 Aubrey Jaffer * patchlvl.h (SCMVERSION): 4e6 released. @@ -43,12 +405,12 @@ Sat Nov 2 09:24:50 EST 1996 maximum entropy 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 Mon Oct 28 11:39:30 1996 Aubrey Jaffer * 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 * 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 Mon Oct 21 21:49:20 1996 Aubrey Jaffer * 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 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 @@ -223,7 +585,7 @@ Tue Apr 9 19:46:21 1996 Aubrey Jaffer * 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 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 @@ -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 - * 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). diff --git a/Init.scm b/Init.scm index 758c407..35575e9 100644 --- a/Init.scm +++ b/Init.scm @@ -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) diff --git a/Link.scm b/Link.scm index ad88e47..a141e54 100644 --- a/Link.scm +++ b/Link.scm @@ -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: (