From fd5f104f287427fee885583bc398c137674e6af0 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Fri, 3 Mar 2017 00:56:40 -0800 Subject: New upstream version 5f2 --- .gdbinit | 0 ANNOUNCE | 200 +-- COPYING | 0 COPYING.LESSER | 0 ChangeLog | 588 +++++++++ Idiffer.scm | 0 Iedline.scm | 0 Init5e5.scm | 1619 ------------------------ Init5f2.scm | 1611 ++++++++++++++++++++++++ Link.scm | 10 +- Macexp.scm | 10 +- Macro.scm | 0 Makefile | 785 ++++++------ QUICKREF | 0 README | 996 ++++++++++++--- Transcen.scm | 0 Tscript.scm | 0 Xlibscm.info | 38 +- Xlibscm.texi | 2 +- bench.scm | 0 build | 18 +- build.scm | 114 +- byte.c | 0 bytenumb.c | 13 +- compile.scm | 2 +- configure | 377 ++++++ continue-ia64.S | 0 continue.c | 0 continue.h | 3 + crs.c | 3 +- debug.c | 0 differ.c | 109 +- disarm.scm | 0 dynl.c | 4 +- ecrt0.c | 0 edline.c | 0 eval.c | 53 +- example.scm | 0 fdl.texi | 80 +- features.txi | 4 + findexec.c | 11 +- get-contoffset-ia64.c | 0 gmalloc.c | 0 grtest.scm | 82 -- gsubr.c | 0 hobbit.info | 114 +- hobbit.scm | 11 +- hobbit.texi | 12 +- inc2scm | 4 +- indexes.texi | 0 ioext.c | 64 +- keysymdef.scm | 136 ++- lastfile.c | 51 + macosx-config.h | 1175 ++++++++++++++++++ mkimpcat.scm | 42 +- patchlvl.h | 4 +- pi.c | 0 pi.scm | 0 platform.txi | 0 posix.c | 0 pre-crt0.c | 0 r4rstest.scm | 51 +- ramap.c | 2 +- record.c | 29 +- repl.c | 39 +- requires.scm | 0 rgx.c | 4 +- rope.c | 40 +- rwb-isam.scm | 78 +- sc2.c | 0 scl.c | 898 +++++++++----- scm.1 | 10 +- scm.c | 23 +- scm.doc | 74 +- scm.h | 115 +- scm.info | 3260 +++++++++++++++++++++++++++---------------------- scm.nsi | 12 +- scm.spec | 80 +- scm.texi | 1542 ++++++++++++++--------- scmfig.h | 78 +- scmhob.h | 8 +- scmhob.scm | 0 scmmain.c | 2 +- script.c | 0 setjump.h | 0 setjump.mar | 0 setjump.s | 0 socket.c | 0 split.scm | 0 subr.c | 471 ++++--- syntest1.scm | 0 syntest2.scm | 0 sys.c | 90 +- time.c | 40 +- turtle | 20 - turtlegr.c | 1298 -------------------- ugsetjump.s | 0 unexalpha.c | 0 unexec.c | 0 unexelf.c | 0 unexhp9k800.c | 0 unexmacosx.c | 1226 +++++++++++++++++++ unexsgi.c | 0 unexsunos4.c | 0 unif.c | 31 +- unix.c | 0 version.txi | 4 +- wbtab.scm | 78 +- x.c | 6 +- x.h | 0 x11.scm | 107 +- xatoms.scm | 0 xevent.h | 0 xevent.scm | 0 xgen.scm | 4 +- 115 files changed, 11174 insertions(+), 6891 deletions(-) mode change 100644 => 100755 .gdbinit mode change 100644 => 100755 COPYING mode change 100644 => 100755 COPYING.LESSER mode change 100644 => 100755 Idiffer.scm mode change 100644 => 100755 Iedline.scm delete mode 100644 Init5e5.scm create mode 100644 Init5f2.scm mode change 100644 => 100755 Link.scm mode change 100644 => 100755 Macexp.scm mode change 100644 => 100755 Macro.scm mode change 100644 => 100755 Makefile mode change 100644 => 100755 QUICKREF mode change 100644 => 100755 README mode change 100644 => 100755 Transcen.scm mode change 100644 => 100755 Tscript.scm mode change 100644 => 100755 Xlibscm.info mode change 100644 => 100755 Xlibscm.texi mode change 100644 => 100755 bench.scm mode change 100644 => 100755 build.scm mode change 100644 => 100755 byte.c mode change 100644 => 100755 bytenumb.c create mode 100755 configure mode change 100644 => 100755 continue-ia64.S mode change 100644 => 100755 continue.c mode change 100644 => 100755 continue.h mode change 100644 => 100755 crs.c mode change 100644 => 100755 debug.c mode change 100644 => 100755 differ.c mode change 100644 => 100755 disarm.scm mode change 100644 => 100755 dynl.c mode change 100644 => 100755 ecrt0.c mode change 100644 => 100755 edline.c mode change 100644 => 100755 eval.c mode change 100644 => 100755 example.scm mode change 100644 => 100755 fdl.texi mode change 100644 => 100755 features.txi mode change 100644 => 100755 findexec.c mode change 100644 => 100755 get-contoffset-ia64.c mode change 100644 => 100755 gmalloc.c delete mode 100644 grtest.scm mode change 100644 => 100755 gsubr.c mode change 100644 => 100755 hobbit.info mode change 100644 => 100755 hobbit.scm mode change 100644 => 100755 hobbit.texi mode change 100644 => 100755 indexes.texi mode change 100644 => 100755 ioext.c mode change 100644 => 100755 keysymdef.scm create mode 100755 lastfile.c create mode 100755 macosx-config.h mode change 100644 => 100755 mkimpcat.scm mode change 100644 => 100755 pi.c mode change 100644 => 100755 pi.scm mode change 100644 => 100755 platform.txi mode change 100644 => 100755 posix.c mode change 100644 => 100755 pre-crt0.c mode change 100644 => 100755 r4rstest.scm mode change 100644 => 100755 ramap.c mode change 100644 => 100755 record.c mode change 100644 => 100755 repl.c mode change 100644 => 100755 requires.scm mode change 100644 => 100755 rgx.c mode change 100644 => 100755 rope.c mode change 100644 => 100755 rwb-isam.scm mode change 100644 => 100755 sc2.c mode change 100644 => 100755 scm.1 mode change 100644 => 100755 scm.c mode change 100644 => 100755 scm.doc mode change 100644 => 100755 scm.h mode change 100644 => 100755 scm.info mode change 100644 => 100755 scm.texi mode change 100644 => 100755 scmfig.h mode change 100644 => 100755 scmhob.h mode change 100644 => 100755 scmhob.scm mode change 100644 => 100755 scmmain.c mode change 100644 => 100755 script.c mode change 100644 => 100755 setjump.h mode change 100644 => 100755 setjump.mar mode change 100644 => 100755 setjump.s mode change 100644 => 100755 socket.c mode change 100644 => 100755 split.scm mode change 100644 => 100755 subr.c mode change 100644 => 100755 syntest1.scm mode change 100644 => 100755 syntest2.scm mode change 100644 => 100755 sys.c mode change 100644 => 100755 time.c delete mode 100644 turtle delete mode 100644 turtlegr.c mode change 100644 => 100755 ugsetjump.s mode change 100644 => 100755 unexalpha.c mode change 100644 => 100755 unexec.c mode change 100644 => 100755 unexelf.c mode change 100644 => 100755 unexhp9k800.c create mode 100755 unexmacosx.c mode change 100644 => 100755 unexsgi.c mode change 100644 => 100755 unexsunos4.c mode change 100644 => 100755 unif.c mode change 100644 => 100755 unix.c mode change 100644 => 100755 version.txi mode change 100644 => 100755 wbtab.scm mode change 100644 => 100755 x.c mode change 100644 => 100755 x.h mode change 100644 => 100755 xatoms.scm mode change 100644 => 100755 xevent.h mode change 100644 => 100755 xevent.scm diff --git a/.gdbinit b/.gdbinit old mode 100644 new mode 100755 diff --git a/ANNOUNCE b/ANNOUNCE index 422222e..9833930 100644 --- a/ANNOUNCE +++ b/ANNOUNCE @@ -1,4 +1,4 @@ -This message announces the availability of Scheme release scm-5e5. +This message announces the availability of Scheme release scm-5f2. SCM conforms to Revised^5 Report on the Algorithmic Language Scheme and the IEEE P1178 specification. SCM is written in C and runs under @@ -11,184 +11,104 @@ under the GNU Lesser General Public License (LGPL). Documentation and distributions in several formats are linked from SCM's home page: - http://swiss.csail.mit.edu/~jaffer/SCM + Links to distributions of SCM and related softwares are at the end of this message. -=-=- -scm-5e5 news: - -* SCM is now a GNU package. -* SCM license is now LGPLv3. -* Documentation changed to GNU Free Documentation License. -* scm-discuss email group - http://lists.gnu.org/mailman/listinfo/scm-discuss - - From Radey Shouman - - * repl.c (isymnames): Add name for IM_EVAL_VALUES. - Fix igc prototype, avert warning. - - * eval.c (scm_eval_values, ceval_1): Catch VALUES arity errors - in top-level repl evaluations. Eg (list (values 1 2)) now - throws an error even when typed to repl. - - * scm.h (IM_EVAL_VALUES): Add isym for use by scm_eval_values. - - From Bob Schumaker - - * macos-config.h, unexmacosx.c, lastfile.c: - Added from Emacs for MacOS (darwin). - - * build.scm (C-libraries): Added dump and dlll darwin entries. - (make-dll-archive, compile-dll-c-files): Added Darwin tagets. - (manifest): Added entries for "macos-config.h" and "lastfile.c". - - * Makefile (all): Make x.so only if /usr/X11R6/lib exists. - (install, installlib): test -d is not needed with mkdir -p. - - From Aubrey Jaffer - - * build, Makefile, scm.spec: Put "-" between "scm" and version. - - * unexelf.c, unexmacosx.c, unexsgi.c, unexsunos4.c, gmalloc.c, - lastfile.c, macos-config.h, r4rstest.scm, syntest2.scm, - unexalpha.c, unexec.c, !#.c, build, build.scm, ecrt0.c, - findexec.c, bench.scm: - Changed license to GPL version 3. - - * Transcen.scm, Tscript.scm, unif.c, unix.c, x.c, xgen.scm, - subr.c, sys.c, time.c, scm.texi, script.c, setjump.h, socket.c, - split.scm, scm.c, scm.h, scmfig.h, scmhob.h, scmhob.scm, - scmmain.c, repl.c, rgx.c, rope.c, sc2.c, scl.c, Macro.scm, - Makefile, mkimpcat.scm, pi.c, pi.scm, posix.c, ramap.c, - record.c, Iedline.scm, Init5e4.scm, Link.scm, Macexp.scm, - inc2scm, ioext.c, Idiffer.scm, gsubr.c, hobbit.scm, .gdbinit, - differ.c, disarm.scm, dynl.c, edline.c, eval.c, - get-contoffset-ia64.c, byte.c, bytenumb.c, compile.scm, - continue-ia64.S, continue.c, continue.h, crs.c, debug.c: - Changed license to LGPL version 3. - - * Tscript.scm: Handle EOF. - - * byte.c (bytes-append, bytes->string, string->bytes): Added. - - * scm.nsi: Create shortcuts at installation; removed SCM.lnk. - (MUI_ICON): Set to "SCM.ico". - - * scm.nsi (Uninstall): Delete tmp1, tmp2, and tmp3, - scmlit.exe, implcat, and slibcat when uninstalling. - - * Makefile ($(htmldir)Xlibscm_toc.html) - ($(htmldir)hobbit_toc.html): Add SCM.ico. - (all): Make differ.so. - (libscm.a, db.so, bytenumb.so, differ.so, myturtle, x.so): Depend - on scm.h and scmfig.h. - - * scm.h, repl.c: Made ints_disabled VOLATILE. - - * ANNOUNCE: Culled and reorganized URLs. - - * ioext.c (directory-for-each): Require 'filename, not 'glob. - - * Init5e4.scm (slib:features): Added srfi-96. - - * scm.c (init_scm): The streams when the program was dumped need - to be reset at initialization. - - * Makefile (Checklit, Check): Added case-sensitive checks. - - * repl.c (scm_lreadr): Made case-insensitive for character names. - - * keysymdef.scm, x11.scm: X Window System Version 7.1.1 - Release Date: 12 May 2006 - X Protocol Version 11, Revision 0, Release 7.1.1 +scm-5f2 news: + +scm-5f2 improves the speed of floating-point I/O. Details at + + + * scl.c (int2dbl, pmantexp2dbl): Recycle temporary bignums. + (pmantexp2dbl): Handle exponents smaller than -324. + (pmantexp2dbl): Optimized. Added bigrecy(quo). + (pmantexp2dbl): call int2dbl() instead of num2dbl(). + (pdbl2str, pmantexp2dbl): Use powers-of-5 table instead of powers-of-10. + (strrecy, pdbl2str): Recycle temporary string used in number->string + conversion. + (scm_intexpt): Call bigrecy only when #ifdef BIGDIG. + (bigrecy): Added procedure to recycle bignums. + (int2dbl, scm_intexpt, divide, difference, big2str) + (pdbl2str, mantexp2dbl, pmantexp2dbl, int2dbl): Recycle temporary bignums. + (pdbl2str): Replaced call to int2dbl() with scm_intlength(). + * r4rstest.scm (test-bignum): Added tests for GCD and LCM. + * sys.c (sysptob): Added sysflush (for sys_errp). Fixed exit when + verbose > 3. + * subr.c (scm_bitwise_bit_count, scm_logcount, scm_intlength) + (big2inum): Recycle temporary bignums. + * scm.c (process_signals): Reenabled lfflush(sys_errp). + * scm.texi: TeXinfo-5 now disallows text between @defunx lines. + (Internal State): Added "(gc #t)". + +From: Marc Espie + + * time.c: OpenBSD is phasing out old interfaces such as ftime and + the timeb data structure. This change should allow things to work + in a saner way on any system that uses gettimeofday(). -=-=- SCM source is available from: - http://swiss.csail.mit.edu/ftpdir/scm/scm-5e5.zip - swiss.csail.mit.edu:/pub/scm/scm-5e5.zip - http://swiss.csail.mit.edu/ftpdir/scm/scm-5e5-1.src.rpm - swiss.csail.mit.edu:/pub/scm/scm-5e5-1.src.rpm -Also available as i386 binary RPM: - http://swiss.csail.mit.edu/ftpdir/scm/scm-5e5-1.i386.rpm - swiss.csail.mit.edu:/pub/scm/scm-5e5-1.i386.rpm + + +Also available as binary RPMs: + + Also available as i386 MS-Windows installer: - http://swiss.csail.mit.edu/ftpdir/scm/slib-3b1-1.exe - swiss.csail.mit.edu:/pub/scm/slib-3b1-1.exe + SLIB is a portable Scheme library which SCM uses: - http://swiss.csail.mit.edu/ftpdir/scm/slib-3b1.zip - swiss.csail.mit.edu:/pub/scm/slib-3b1.zip + Also available as RPM: - http://swiss.csail.mit.edu/ftpdir/scm/slib-3b1-1.noarch.rpm - swiss.csail.mit.edu:/pub/scm/slib-3b1-1.noarch.rpm + Also available as MS-Windows installer: - http://swiss.csail.mit.edu/ftpdir/scm/slib-3b1-1.exe - swiss.csail.mit.edu:/pub/scm/slib-3b1-1.exe + JACAL is a symbolic math system written in Scheme: - http://swiss.csail.mit.edu/ftpdir/scm/jacal-1b9.zip - swiss.csail.mit.edu:/pub/scm/jacal-1b9.zip + Also available as RPM: - http://swiss.csail.mit.edu/ftpdir/scm/jacal-1b9-1.noarch.rpm - swiss.csail.mit.edu:/pub/scm/jacal-1b9-1.noarch.rpm + Also available as MS-Windows installer: - http://swiss.csail.mit.edu/ftpdir/scm/jacal-1b9-1.exe - swiss.csail.mit.edu:/pub/scm/jacal-1b9-1.exe + WB is a disk based, sorted associative array (B-tree) library for SCM. Using WB, large databases can be created and managed from SCM. - http://swiss.csail.mit.edu/ftpdir/scm/wb-2a2.zip - swiss.csail.mit.edu:/pub/scm/wb-2a2.zip - http://swiss.csail.mit.edu/ftpdir/scm/wb-2a2-1.src.rpm - swiss.csail.mit.edu:/pub/scm/wb-2a2-1.src.rpm -Also available as i386 binary RPM: - http://swiss.csail.mit.edu/ftpdir/scm/wb-2a2-1.i386.rpm - swiss.csail.mit.edu:/pub/scm/wb-2a2-1.i386.rpm + + +Also available as binary RPMs: + + FreeSnell is a program to compute optical properties of multilayer thin-film coatings: - http://swiss.csail.mit.edu/ftpdir/scm/FreeSnell-1b7.zip - swiss.csail.mit.edu:/pub/scm/FreeSnell-1b7.zip + Also available as MS-Windows installer: - http://swiss.csail.mit.edu/ftpdir/scm/FreeSnell-1b7-1.exe - swiss.csail.mit.edu:/pub/scm/FreeSnell-1b7-1.exe + SIMSYNCH is a digital logic simulation system written in SCM. - http://swiss.csail.mit.edu/ftpdir/scm/synch-1c3.zip - swiss.csail.mit.edu:/pub/scm/synch-1c3.zip + XSCM is a X windows interface package which works with SCM: - http://swiss.csail.mit.edu/ftpdir/scm/xscm-2.01.tar.gz - swiss.csail.mit.edu:/pub/scm/xscm-2.01.tar.gz + TURTLSCM is a turtle graphics package which works with SCM on MS-DOS or X11 machines: - http://swiss.csail.mit.edu/ftpdir/scm/turtlegr.tar.gz - swiss.csail.mit.edu:/pub/scm/turtlegr.tar.gz + #! implements "#!" (POSIX) shell-scripts for MS-DOS batch files. - http://swiss.csail.mit.edu/ftpdir/scm/sharpbang.zip - swiss.csail.mit.edu:/pub/scm/sharpbang.zip - http://swiss.csail.mit.edu/ftpdir/scm/#!.zip - swiss.csail.mit.edu:/pub/scm/#!.zip + + SLIB-PSD is a portable debugger for Scheme (requires emacs editor): - http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz - swiss.csail.mit.edu:/pub/scm/slib-psd1-3.tar.gz - -SMG-SCM is an SMG interface package which works with SCM on VMS. - http://swiss.csail.mit.edu/ftpdir/scm/smg-scm2a1.zip - swiss.csail.mit.edu:/pub/scm/smg-scm2a1.zip + MacSCM is a Macintosh applications building package which works with SCM (similar to XSCM). - http://swiss.csail.mit.edu/ftpdir/scm/macscm.tar.Z - swiss.csail.mit.edu:/pub/scm/macscm.tar.Z + Programs for printing and viewing TexInfo documentation (which SCM has) come with GNU Emacs or can be obtained via ftp from: - ftp://ftp.gnu.org/pub/gnu/texinfo/texinfo-4.8.tar.gz + diff --git a/COPYING b/COPYING old mode 100644 new mode 100755 diff --git a/COPYING.LESSER b/COPYING.LESSER old mode 100644 new mode 100755 diff --git a/ChangeLog b/ChangeLog index 1555342..d125dfb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,591 @@ +2015-01-14 Aubrey Jaffer + + * patchlvl.h (SCMVERSION): Bumped from 5f1 to 5f2. + +2015-01-03 Aubrey Jaffer + + * scl.c (int2dbl, pmantexp2dbl): Recycle temporary bignums. + +2014-11-27 Aubrey Jaffer + + * scl.c (pdbl2str, pmantexp2dbl): Cleaned up code. + +2014-11-22 Aubrey Jaffer + + * scl.c (pmantexp2dbl): Handle exponents smaller than -324. + (pmantexp2dbl): Optimized. Added bigrecy(quo). + (pdbl2str, pmantexp2dbl): Uses powers-of-5. + +2014-11-21 Aubrey Jaffer + + * scl.c (pmantexp2dbl): call int2dbl() instead of num2dbl(). + (pdbl2str): Use powers-of-5 table instead of powers-of-10. + (pdbl2str): e2 > 0 prints out extra digit; reverting. + +2014-05-04 Aubrey Jaffer + + * scl.c (strrecy, pdbl2str): Recycle temporary string used in + number->string conversion. + (scm_intexpt): Call bigrecy only when #ifdef BIGDIG. + +2014-05-02 Aubrey Jaffer + + * subr.c (scm_bitwise_bit_count, scm_logcount, scm_intlength) + (big2inum): Recycle temporary bignums. + + * scl.c (int2dbl, scm_intexpt, divide, difference, big2str) + (pdbl2str): Recycle temporary bignums. + +2014-04-27 Aubrey Jaffer + + * scl.c (bigrecy): Added procedure to recycle bignums. + (mantexp2dbl, pmantexp2dbl, int2dbl): Recycle temporary bignums. + + * r4rstest.scm (test-bignum): Added tests for GCD and LCM. + +2014-04-24 Aubrey Jaffer + + * sys.c (sysptob): Added sysflush (for sys_errp). Fixed exit when + verbose > 3. + + * scm.c (process_signals): Reenabled lfflush(sys_errp). + +2014-04-21 Aubrey Jaffer + + * scm.texi (Internal State): Added "(gc #t)". + +2014-04-07 Aubrey Jaffer + + * scl.c (pdbl2str): Replaced call to int2dbl() with scm_intlength(). + +2014-02-17 Aubrey Jaffer + + * scm.texi: TeXinfo-5 now disallows text between @defunx lines. + +2014-02-08 From: Marc Espie + + * time.c: OpenBSD is phasing out old interfaces such as ftime and + the timeb data structure. This should allow things to work in a + saner way on any system that uses gettimeofday(). + +2013-05-08 Aubrey Jaffer + + * patchlvl.h (SCMVERSION): Bumped from 5e7 to 5f1. + +2013-04-14 Aubrey Jaffer + + * r4rstest.scm (test-inexact-printing): Added float-rw-range-test + to check that all powers of 10 in the range of IEEE doubles are + read-write-invariant and their strings are short. + +2013-04-13 Aubrey Jaffer + + * scl.c (pmantexp2dbl): Renamed from imantexp2dbl and radically + simplified (because bex < 0). + +2013-04-12 Aubrey Jaffer + + * scl.c (scm_intexpt): Fixed (integer-expt 2 -1074). + (dbl2big): Was returning unnormalized bignums. + +2013-04-10 Aubrey Jaffer + + * scl.c (llog2): Use with bignums also. + +2013-04-06 Aubrey Jaffer + + * scmfig.h (BIGDIG): Enable 32-bit BIGDIGs. + + * subr.c (scm_big_ash): Workaround left-shifting unsigned int by + 32-bits in gcc -O0 bug. + + * scl.c: Removed debugging printf()s. + + * dynl.c, eval.c, repl.c, scmmain.c (scm_verbose): Replaced uses + of `verbose' alias. + +2013-03-31 Aubrey Jaffer + + * scmfig.h: Rearranged to enable detection of int size. + + * subr.c (scm_bitfield, scm_ash): Don't reuse SCM variables as longs. + +2013-03-30 Aubrey Jaffer + + * scl.c (ilong2str): Renamed from iint2str(). + (pdbl2str): No longer assumes that ulong is larger than double. + + * subr.c (divbigdig): Return type changed to UBIGLONG. + +2013-03-24 Aubrey Jaffer + + * scm.h (iuint2str): Added declaration. + + * scmfig.h (UBIGLONG, SBIGLONG): Added in preparation for 32-bit + BIDIG. + + * bytenumb.c (scm_bytes_to_integer, scm_integer_to_bytes): Use + UBIGLONG for integers holding 2 BIGDIGs. + + * scl.c (int2dbl): Only accumulate dbl_mant_dig worth of BIGDIGs. + (dbl2big, int2dbl): Use ldexp() instead of multiplication by BIGRAD. + (pdbl2str): Use unsigned int2str conversion. + (istr2int): Changed radix from long to int. + + * subr.c (divbigbig): Implements core of scm_round_quotient(). + (divbigbig): Round correctly when x is shorter than y. + (scm_copy_big_ash1): Abstracted repeated code from divbigbig(). + (scm_big_ash, big2inum, long2big, addbig, mulbig) + (divbigdig, divbigint, divbigbig): Use UBIGLONG and SBIGLONG for + integers holding 2 BIGDIGs. + +2013-03-17 Aubrey Jaffer + + * subr.c (scm_round_quotient): Round toward even. + +2013-03-14 Aubrey Jaffer + + * scl.c (imantexp2dbl): Added to check that conversion to decimal + is accurate. + (pdbl2str): Uses smallest number of digits! + + * subr.c (scm_round_quotient): Abstracted from decimal conversion + code and int2dbl(). + +2013-03-10 Aubrey Jaffer + + * scl.c (int2dbl): Renamed from big2dbl. + (inex_divintbig): Renamed from inex_divbigbig. + (big2scaldbl): Removed for not returning unnormalized doubles. + (divide, inex_divintbig): Can now return unnormalized doubles. + +2013-03-09 Aubrey Jaffer + + * Makefile (scm4, scm5, dscm5): Don't ignore (readback) errors. + + * scl.c (mantexp2dbl, big2dbl): Comment out checks for rounding + evenness making a difference. + + * r4rstest.scm (test-inexact): Changed 4.0 to f4.0. + + * scl.c (mantexp2dbl): Reading now accurate for negative + exponents. Only one readback error remains: 699.99999999998702e18 + (big2dbl): Turned out to need explicit rounding -- all are fixed! + +2013-02-20 Aubrey Jaffer + + * scl.c (pdbl2str): Does engineering notation now. + +2013-02-18 Aubrey Jaffer + + * scl.c (pdbl2str): Replaced with homegrown version. + (pdbl2str): Fixed nasty range error around 2.^53. + Still failing 12 readback tests; too many digits output. + +2013-02-07 Aubrey Jaffer + + * r4rstest.scm (test-inexact-printing): Output both original and + readback value. + + * scl.c (pdbl2str): Implements "Printing Floating-Point Numbers + Quickly and Accurately" by Robert G. Burger and R. Kent Dybvig. + 1.000000000000001 doesn't seem right. + +2013-01-24 Aubrey Jaffer + + * scl.c (dbl_prec, apx_log10, lpow10): Moved adjacent to + pdbl2str(), which is their only use. + +2013-01-23 Aubrey Jaffer + + * scl.c (scm_cintlog): Fixed eqv reference in scmlit build. + +2013-01-21 Aubrey Jaffer + + * scl.c (scm_next_dfloat): Removed (skipped codes). + (pdbl2str): Split from idbl2str() in preparation for improved + printing of floats. + +2013-01-14 Aubrey Jaffer + + * scl.c (scm_intlog, integer-log): Ported to C. + * (ceiling-integer-log): Ported to C for use in printing floats. + +2013-01-02 Aubrey Jaffer + + * scl.c (mantexp2dbl): Fixed reading of small magnitude numbers; + seem to be no missing codes from ieee-double->bytes. + +2013-01-01 Aubrey Jaffer + + * scl.c (istr2flo): Convert '#' to '0' in mantissa string. + (mantexp2dbl): Fixed reading of large magnitude numbers! + (dbl2big): Don't loop forever on infinite arguments. + +2012-12-29 Aubrey Jaffer + + * scl.c (mantexp2dbl): Separated mantissa conversion and scaling + from istr2flo(). + +2012-12-27 Aubrey Jaffer + + * bytenumb.c (get_bytes): Fixed bytes-length checking. + +2012-12-18 Aubrey Jaffer + + * Makefile: Removed turtlegr files from distribution because + copyright isn't assigned to FSF. + + * findexec.c: Copyright was assigned to FSF. + +2012-08-16 Aubrey Jaffer + + * eval.c (m_body): Reverse letrec bindings (and internal defines) + to produce LETREC* behavior. + +2012-04-10 Aubrey Jaffer + + * Makefile (upgnu): Added target to upload to ftp.gnu.org. + +2012-01-11 Aubrey Jaffer + + * Init5e7.scm (integer->list): Negative k not allowed. + +2011-12-27 Aubrey Jaffer + + * Makefile (catfiles): Create catalogs at end of install and + remove in uninstall. + +2011-12-25 Aubrey Jaffer + + * Makefile (install-lib): Install $(wbfiles) if -f wbscm.so. + +2011-12-23 Aubrey Jaffer + + * Makefile (install-lib): Install "build" as program. + +2011-11-24 Aubrey Jaffer + + * scm.texi (Testing): Moved between "Problems Linking" and + "Problems Starting". + +2011-11-20 Aubrey Jaffer + + * Makefile (install-lib): Make installation of libscm.a optional. + + * scm.texi (Distributions, GNU configure and make): Added text + suggested by John Gabriele. + +2011-11-15 Aubrey Jaffer + + * lastfile.c: Fixed typo ("macosx-config.h"). + +2011-11-12 Aubrey Jaffer + + * scm.texi, README (Installing SCM): Reorganized and expanded. + + * Makefile (SETARCH): Use for disabling OS-X dump-time ASLR. + (udscm*.opt scm*.opt): Refactored dependencies. + +2011-11-06 Aubrey Jaffer + + * Makefile (alld5, all5): Clever sub-targets of all. + + * scm.texi (Building Using Make): Added subsection. + +2011-10-26 Aubrey Jaffer + + * scm.texi (Installing SCM): Reorganized in response to + suggestions from John Gabriele. + +2011-10-25 Aubrey Jaffer + + * scm.texi (Installing SCM): Reorganized. + Updated email addresses. + + * Makefile (configure.usage): Added. + +2011-09-04 Aubrey Jaffer + + * scl.c (inf2str): Ouput +nan.0 for NaN. + (istr2flo): Parse [-+]nan.0. + +2011-08-18 Aubrey Jaffer + + * scl.c (istr2flo): 1e-1 ==> 100.0e-3; 1f-1 ==> 100.00000149011612e-3 + +2011-08-05 Aubrey Jaffer + + * unexmacosx.c: Added Emacs dump code for OS-X. + + * x11.scm: Updated for X Server 1.9.0. + +2011-06-15 Aubrey Jaffer + + * scm.texi (I/O-Extensions): Added DIRECTORY*-FOR-EACH. + +2011-03-11 Aubrey Jaffer + + * scmfig.h (__APPLE__): Include unistd.h. + +2010-10-17 Aubrey Jaffer + + * scl.c (scm_bigdblcomp): Fixed type of argument to frexp(). + + * findexec.c (dld_find_executable): Handle getcwd() failure. + + * sys.c (ltmpnam): Handle tmpnam() failure. + + * unif.c (list->uniform-array): Fixed rank check. + +2010-10-13 Aubrey Jaffer + + * scm.h (tc7_VfixN64, tc7_VfixZ64): Added. + + * scm.texi (Data Type Representations): Allocated codes for + tc7_VfixN64 and tc7_VfixZ64. + +2010-08-21 Aubrey Jaffer + + * differ.c (I32): Workaround for A:fixZ32b actually being 64.bit + on __x86_64. + + * rope.c (scm_addr, scm_base_addr): Changed return type to void*. + +2010-07-17 Aubrey Jaffer + + * scm.texi (Conventional Arrays): @exdent wide examples. + + * Makefile (scm5, scm4): Fail if check fails. + + * scl.c (inf2str): Use strcpy() instead of explicity copying. + +2010-06-29 Aubrey Jaffer + + * patchlvl.h (SCMVERSION): Bumped from 5e6 to 5e7. + + * Makefile (winscm5.opt): Use wb-no-threads. + + * build.scm (wb-no-threads): wb feature for mingw. + + * hobbit.texi (Compiling And Linking): Fixed \" quoting in @example. + + * Makefile, scm.spec: Fixed RPM build. + +2010-06-19 Aubrey Jaffer + + * Makefile: INSTALL_INFO = ginstall-info. + +2010-06-02 Aubrey Jaffer + + * configure: Improved portability of trailing / detection. + + * Makefile (db.so): Added $(wbfiles) dependency. + +2010-05-22 Aubrey Jaffer + + * configure (ac_default_prefix): Was lacking trailing /. + +2010-04-27 Aubrey Jaffer + + * Makefile (db.so): Recompile if any ../wb/c/*.c changes. + (tagfiles): Don't include documentation sources twice. + (x.h): CPROTO no longer available; "x.h" is in CVS. + +2010-03-31 Aubrey Jaffer + + * ioext.c (copy-file): Added. + +2010-03-16 Aubrey Jaffer + + * hobbit.texi (Compiling And Linking): Fixed quoting in example + compile commands for MS-DOS prompt. + +2010-02-23 Aubrey Jaffer + + * Makefile (Makefile): Runs ./configure to create config.status. + +2010-02-13 Aubrey Jaffer + + * Makefile: Reorganized per . + +2010-02-04 Aubrey Jaffer + + * configure: GNU-style configuration for installation creates + config.status, which is included by Makefile. + +2010-01-27 Aubrey Jaffer + + * scm.texi (Numeric): Added infinite?, finite?, exact-round, + exact-floor, exact-ceiling, and exact-truncate. + +2009-12-27 Aubrey Jaffer + + * scm.texi (Bit Vectors): Fixed doc for bit-set*!. + +2009-10-21 Aubrey Jaffer + + * ioext.c (init_ioext): Added directory*-for-each. + +2009-10-05 Aubrey Jaffer + + * build.scm (wb): Added c-lib pthread. + (C-libraries): pthread added. + + * Makefile (db.so): Corrected for new WB file organization. + +2009-09-14 Radey Shouman + + * Macexp.scm (macro:expand-syntax): Fix non-pretty case. + Fully expand identifier macros. + + * eval.c (scm_macroexpand1): Properly handle identifier macros. + (macroexp1): Fixed for the case of the first argument an + identifier -- used to return a list headed by #@quote. + (ceval_1): Fixed argument number check for nullary procedures -- + used to incorrectly call scm_dynthrow. + +2009-08-29 Aubrey Jaffer + + * dynl.c (l_dyn_main_call): Added cast to eliminate gcc warning. + + * sys.c (free_storage): Removed late call to lfflush() which + caused segfault in fc9. + + * mkimpcat.scm (in-wb-vicinity): is "../wb/c/". + +2009-08-26 Aubrey Jaffer + + * sys.c (gc_mark): For tcs_cons_nimcar, do one CDR lookahead for + mark. + +2009-08-02 Aubrey Jaffer + + * patchlvl.h (SCMVERSION): Bumped from 5e5 to 5e6. + +2009-07-14 Aubrey Jaffer + + * ioext.c (make-directory): Fixed umask (to #o022). + +2009-03-21 Aubrey Jaffer + + * scl.c (scm_bigdblcomp): Fixed comparison with infinities. + (scm_max, scm_min): Renamed from lmax, lmin. + (bigdblop): Fixed division by 0 and infinities. + (bigdblop): Fixed case: (/ (+ 1 most-positive-fixnum) 1e-165) + +2008-12-14 Aubrey Jaffer + + * r4rstest.scm (6 5 5): Added exact-integer division tests. + +2008-12-13 Aubrey Jaffer + + * r4rstest.scm (6 9): Added (procedure? /). + (4 2 4): Added test for test clause without expressions. + +2008-11-15 Aubrey Jaffer + + * build.scm (build:command): Comment interfered with make-build-cgi. + +2008-08-06 Aubrey Jaffer + + * rope.c (scm_gc_protect): Don't check if already protected; for + large Hobbit compiles that is an O(N^2) process. + + * hobbit.scm (make-initialization-function!): Sets no_symhash_gc. + + * sys.c, scm.h (no_symhash_gc): Added for Hobbit-produced code. + + * Link.scm (link:link): Added calls to load:pre and load:post. + + * mkimpcat.scm (add-links): Added "hobbit.so". + + * Init5e5.scm (load:pre, load:post): Take operation argument for + use with both loading and linking. + +2008-08-06 Martin Ward + + * hobbit.scm (*c-keywords*): Added system, random, and exit. + (*char-replacements*): Added backslash. + +2008-07-27 Thomas Bushnell BSG + + * build.scm (linux-ia64, build-continue-ia64): Include + continue-ia64.o in .a libraries. + +2008-07-05 Aubrey Jaffer + + * scm.texi (SCM Session): Added description of getenv (extension). + + * scm.c (scm_getenv): Renamed from lgetenv; with no arguments, + returns names and values of all the environment variables as an + association-list. + +2008-06-29 Aubrey Jaffer + + * sys.c (sfwrite, sfputs): Added "const" to first argument + declaration. + +2008-06-15 Aubrey Jaffer + + * scm.nsi: Added "Tscript.scm". + +2008-05-14 Aubrey Jaffer + + * repl.c (wait_for_input): Removed restriction to input-ports. + + * record.c (recprin1): Don't print field values unless + SCM_SHOW_RECORD_FIELDS; allows suffix-trees to print. + +2008-05-13 Radey Shouman + + * scm.c (ignore_signals): Added volatile assignment to + prevent scmable_signal function from being optimized + away - relevant only to windows builds. + +2008-03-11 Aubrey Jaffer + + * scl.c (istr2flo): +/, +/0, and 234/ are no longer numbers. + + * sys.c (scm_portp): Added SLIB prerequisite. + +2008-02-25 Aubrey Jaffer + + * inc2scm, xgen.scm: Changed first line to invoke ./scmlit. + +2008-02-19 Aubrey Jaffer + + * continue.h (STACK_GROWS_UP): if __hppa__. + + * scm.texi (Automatic C Preprocessor Definitions): Added __hppa__ + +2008-02-18 Aubrey Jaffer + + * mkimpcat.scm (add-source): Look for file with scheme-suffix. + + * Makefile (xevent.h xevent.scm xatoms.scm): + (x11.scm, keysymdef.scm): Don't source include files from DESTDIR. + +2008-02-14 Aubrey Jaffer + + * build.scm (compile-dll-c-files, compile-c-files): Added missing + '(include-spec "-I" parms)'. + +2008-02-13 Aubrey Jaffer + + * Makefile (lsdfiles): Removed duplicate "Iedline.scm". + +2008-02-10 Aubrey Jaffer + + * Makefile (texifiles): Moved definition before use. + + * build.scm (compile-dll-c-files, make-dll-archive): + MACOSX_DEPLOYMENT_TARGET=10.3 + + * Makefile (all): Don't make db.so. + (lsdfiles): Removed WB files. + (afiles): Removed $(wbfiles). + 2008-02-01 Aubrey Jaffer * patchlvl.h (SCMVERSION): Bumped from 5e4 to 5e5. diff --git a/Idiffer.scm b/Idiffer.scm old mode 100644 new mode 100755 diff --git a/Iedline.scm b/Iedline.scm old mode 100644 new mode 100755 diff --git a/Init5e5.scm b/Init5e5.scm deleted file mode 100644 index 2899689..0000000 --- a/Init5e5.scm +++ /dev/null @@ -1,1619 +0,0 @@ -;;;; "Init.scm", Scheme initialization code for SCM. -;; Copyright (C) 1991-2008 Free Software Foundation, Inc. -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU Lesser General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, 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 -;; Lesser General Public License for more details. -;; -;; You should have received a copy of the GNU Lesser General Public -;; License along with this program. If not, see -;; . - -;;; Author: Aubrey Jaffer. - -(define (scheme-implementation-type) 'scm) -(define (scheme-implementation-version) "5e5") -(define (scheme-implementation-home-page) - "http://swiss.csail.mit.edu/~jaffer/SCM") - -;@ -(define in-vicinity string-append) -;@ -(define (user-vicinity) - (case (software-type) - ((vms) "[.]") - (else ""))) -;@ -(define vicinity:suffix? - (let ((suffi - (case (software-type) - ((amiga) '(#\: #\/)) - ((macos thinkc) '(#\:)) - ((ms-dos windows atarist os/2) '(#\\ #\/)) - ((nosve) '(#\: #\.)) - ((unix coherent plan9) '(#\/)) - ((vms) '(#\: #\])) - (else - (slib:warn "require.scm" 'unknown 'software-type (software-type)) - "/")))) - (lambda (chr) (and (memv chr suffi) #t)))) -;@ -(define (pathname->vicinity pathname) - (let loop ((i (- (string-length pathname) 1))) - (cond ((negative? i) "") - ((vicinity:suffix? (string-ref pathname i)) - (substring pathname 0 (+ i 1))) - (else (loop (- i 1)))))) -(define (program-vicinity) - (if *load-pathname* - (pathname->vicinity *load-pathname*) - (slib:error 'program-vicinity " called; use slib:load to load"))) -;@ -(define sub-vicinity - (case (software-type) - ((vms) (lambda - (vic name) - (let ((l (string-length vic))) - (if (or (zero? (string-length vic)) - (not (char=? #\] (string-ref vic (- l 1))))) - (string-append vic "[" name "]") - (string-append (substring vic 0 (- l 1)) - "." name "]"))))) - (else (let ((*vicinity-suffix* - (case (software-type) - ((nosve) ".") - ((macos thinkc) ":") - ((ms-dos windows atarist os/2) "\\") - ((unix coherent plan9 amiga) "/")))) - (lambda (vic name) - (string-append vic name *vicinity-suffix*)))))) -;@ -(define (make-vicinity ) ) -;@ -(define with-load-pathname - (let ((exchange - (lambda (new) - (let ((old *load-pathname*)) - (set! *load-pathname* new) - old)))) - (lambda (path thunk) - (let ((old #f)) - (dynamic-wind - (lambda () (set! old (exchange path))) - thunk - (lambda () (exchange old))))))) - -(define slib:features - (append '(ed getenv tmpnam abort transcript with-file - ieee-p1178 rev4-report rev4-optional-procedures - hash object-hash delay dynamic-wind fluid-let - multiarg-apply multiarg/and- logical defmacro - string-port source current-time sharp:semi - math-integer ;math-real and srfi-94 provided in "Transcen.scm" - vicinity srfi-59 srfi-96 srfi-23 - srfi-60) ;logical - (if (defined? *features*) *features* slib:features))) -(if (defined? *features*) (set! *features* slib:features)) - -(define eval - (let ((@eval @eval) - (@copy-tree @copy-tree)) - (lambda (x) (@eval (@copy-tree x))))) - -(define (exec-self) - (require 'i/o-extensions) - (execv (execpath) (if *script* - (cons (car (program-arguments)) - (cons "\\" - (member *script* (program-arguments)))) - (program-arguments)))) - -(define (display-file file . port) - (call-with-input-file file - (lambda (inport) - (do ((c (read-char inport) (read-char inport))) - ((eof-object? c)) - (apply write-char c port))))) -(define (terms) - (display-file (in-vicinity (implementation-vicinity) "COPYING"))) - -;;; Read integer up to first non-digit -(define (read:try-number port . ic) - (define chr0 (char->integer #\0)) - (let loop ((arg (and (not (null? ic)) (- (char->integer (car ic)) chr0)))) - (let ((c (peek-char port))) - (cond ((eof-object? c) #f) - ((char-numeric? c) - (loop (+ (* 10 (or arg 0)) - (- (char->integer (read-char port)) chr0)))) - (else arg))))) - -(define (read-array-type port) - (define (bomb pc wid) - (error 'array 'syntax? (symbol-append "#" rank "A" pc wid))) - (case (char-downcase (peek-char port)) - ((#\:) (read-char port) - (let ((typ (let loop ((arg '())) - (if (= 4 (length arg)) - (string->symbol (list->string (reverse arg))) - (let ((c (read-char port))) - (and (not (eof-object? c)) - (loop (cons (char-downcase c) arg)))))))) - (define wid (and typ (not (eq? 'bool typ)) (read:try-number port))) - (define (check-suffix chrs) - (define chr (read-char port)) - (if (and (char? chr) (not (memv (char-downcase chr) chrs))) - (error 'array-type? (symbol-append ":" typ wid chr)))) - (define prot (assq typ '((floc (128 . +64.0i) - (64 . +64.0i) - (32 . +32.0i) - (16 . +32.0i)) - (flor (128 . 64.0) - (64 . 64.0) - (32 . 32.0) - (16 . 32.0)) - (fixz (64 . -64) - (32 . -32) - (16 . -16) - (8 . -8)) - (fixn (64 . 64) - (32 . 32) - (16 . 16) - (8 . 8)) - (char . #\a) - (bool . #t)))) - (if prot (set! prot (cdr prot))) - (cond ((pair? prot) - (set! prot (assv wid (cdr prot))) - (if (pair? prot) (set! prot (cdr prot))) - (if wid (check-suffix (if (and (inexact? prot) (real? prot)) - '(#\b #\d) - '(#\b))))) - (prot) - (else (check-suffix '()))) - prot)) - ((#\\) (read-char port) #\a) - ((#\t) (read-char port) #t) - ((#\c #\r) (let* ((pc (read-char port)) (wid (read:try-number port))) - (case wid - ((64 32) (case pc - ((#\c) (* +i wid)) - (else (exact->inexact wid)))) - (else (bomb pc wid))))) - ((#\s #\u) (let* ((pc (read-char port)) (wid (read:try-number port))) - (case (or wid (peek-char port)) - ((32 16 8) (case pc - ((#\s) (- wid)) - (else wid))) - (else (bomb pc wid))))) - (else #f))) - -;;; We come into read:array with number or #f for RANK. -(define (read:array rank dims port) - (define (make-it rank dims typ) - (list->uniform-array (cond (rank) - ((null? dims) 1) - (else (length dims))) - typ - (read port))) - (let loop ((dims dims)) - (define dim (read:try-number port)) - (if dim - (loop (cons dim dims)) - (case (peek-char port) - ((#\*) (read-char port) (loop dims)) - ((#\: #\\ #\t #\c #\r #\s #\u #\T #\C #\R #\S #\U) - (make-it rank dims (read-array-type port))) - (else - (make-it rank dims #f)))))) - -;;; read-macros valid for LOAD and READ. -(define (read:sharp c port reader) ; ignore reader - (case c - ;; Used in "implcat" and "slibcat" - ((#\+) (if (slib:provided? (read port)) - (read port) - (begin (read port) (if #f #f)))) - ;; Used in "implcat" and "slibcat" - ((#\-) (if (slib:provided? (read port)) - (begin (read port) (if #f #f)) - (read port))) - ((#\a #\A) (read:array #f '() port)) - ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) - (let* ((num (read:try-number port c)) - (chr (peek-char port))) - (case chr - ((#\a #\A) (read-char port) - (read:array num '() port)) - ((#\*) (read-char port) - (read:array #f (list num) port)) - (else - (read:array 1 (list num) port)) - ;;(else (error 'sharp 'syntax? (symbol-append "#" num chr))) - ))) - (else (error "unknown # object" c)))) - -;;; read-macros valid only in LOAD. -(define (load:sharp c port reader) ;reader used only for #. - (case c - ((#\') (read port)) - ((#\.) (eval (reader port))) - ((#\!) (let skip ((metarg? #f)) - (let ((c (read-char port))) - (case c - ((#\newline) (if metarg? (skip #t))) - ((#\\) (skip #t)) - ((#\!) (cond ((eqv? #\# (peek-char port)) - (read-char port) - (if #f #f)) - (else (skip metarg?)))) - (else (if (char? c) (skip metarg?) c)))))) - ;; Make #; convert the rest of the line to a (comment ...) form. - ;; "build.scm" uses this. - ((#\;) (let skip-semi () - (cond ((eqv? #\; (peek-char port)) - (read-char port) - (skip-semi)) - (else (require 'line-i/o) - `(comment ,(read-line port)))))) - ((#\?) (case (read port) - ((line) (port-line port)) - ((column) (port-column port)) - ((file) (port-filename port)) - (else #f))) - (else (read:sharp c port read)))) - -;;; We can assume TOK has at least 2 characters. -(define char:sharp - (letrec ((numeric-1 - (lambda (tok radix) - (numeric (substring tok 1 (string-length tok)) radix))) - (numeric - (lambda (tok radix) - (cond ((string->number tok radix) => integer->char)))) - (compose - (lambda (modifier tok) - (and (char=? #\- (string-ref tok 1)) - (if (= 3 (string-length tok)) - (modifier (string-ref tok 2)) - (let ((c (char:sharp - (substring tok 2 (string-length tok))))) - (and c (modifier c))))))) - (control - (lambda (c) - (and (char? c) - (if (eqv? c #\?) - (integer->char 127) - (integer->char (logand #o237 (char->integer c))))))) - (meta - (lambda (c) - (and (char? c) - (integer->char (logior 128 (char->integer c))))))) - (lambda (tok) - (case (string-ref tok 0) - ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7) (numeric tok 8)) - ((#\O #\o) (numeric-1 tok 8)) - ((#\D #\d) (numeric-1 tok 10)) - ((#\X #\x) (numeric-1 tok 16)) - ((#\C #\c) (compose control tok)) - ((#\^) (and (= 2 (string-length tok)) (control (string-ref tok 1)))) - ((#\M #\m) (compose meta tok)))))) - -;;;; Function used to accumulate comments before a definition. -(define comment - (let ((*accumulated-comments* '())) - (lambda args - (cond ((null? args) - (let ((ans - (apply string-append - (map (lambda (comment) - (string-append (or comment "") "\n")) - (reverse *accumulated-comments*))))) - (set! *accumulated-comments* '()) - (if (equal? "" ans) - "no-comment" ;#f - (substring ans 0 (+ -1 (string-length ans)))))) - (else (set! *accumulated-comments* - (append (reverse args) *accumulated-comments*))))))) - -(define : ':) ;for /bin/sh hack. -(define !#(if #f #f)) ;for scsh hack. - -;;;; Here are some Revised^2 Scheme functions: -(define 1+ (let ((+ +)) (lambda (n) (+ n 1)))) -(define -1+ (let ((+ +)) (lambda (n) (+ n -1)))) -(define 1- -1+) -(define ? >) -(define >=? >=) -(define t #t) -(define nil #f) -(define identity cr) - -(cond ((defined? defsyntax) -(defsyntax define-syntax (the-macro defsyntax))) - (else -(define defsyntax define) -(define the-macro identity))) -(defsyntax sequence (the-macro begin)) -(define copy-tree @copy-tree) - -;;; VMS does something strange when output is sent to both -;;; CURRENT-OUTPUT-PORT and CURRENT-ERROR-PORT. -(case (software-type) ((vms) (set-current-error-port (current-output-port)))) - -;;; OPEN_READ, OPEN_WRITE, and OPEN_BOTH are used to request the proper -;;; mode to open files in. MS-DOS does carriage return - newline -;;; translation if not opened in `b' mode. - -(define open_read (case (software-type) - ((ms-dos windows atarist) 'rb) - (else 'r))) -(define open_write (case (software-type) - ((ms-dos windows) 'wbc) - ((atarist) 'wb) - (else 'w))) -(define open_both (case (software-type) - ((ms-dos windows) 'r+bc) - ((atarist) 'r+b) - (else 'r+))) -(define ((make-moder str) mode) - (if (symbol? mode) - (string->symbol (string-append (symbol->string mode) str)) - (string-append mode str))) -(define _ionbf (make-moder "0")) -(define _tracked (make-moder "?")) -(define _exclusive (make-moder "x")) - -(define could-not-open #f) - -(define (open-output-file str) - (or (open-file str open_write) - (and (procedure? could-not-open) (could-not-open) #f) - (error "OPEN-OUTPUT-FILE couldn't open file " str))) -(define (open-input-file str) - (or (open-file str open_read) - (and (procedure? could-not-open) (could-not-open) #f) - (error "OPEN-INPUT-FILE couldn't open file " str))) - -(define (string-index str chr) - (define len (string-length str)) - (do ((pos 0 (+ 1 pos))) - ((or (>= pos len) (char=? chr (string-ref str pos))) - (and (< pos len) pos)))) - -(if (not (defined? try-create-file)) -(define (try-create-file str modes . perms) - (if (symbol? modes) (set! modes (symbol->string modes))) - (let ((idx (string-index modes #\x))) - (cond ((slib:in-catalog? 'i/o-extensions) - (require 'i/o-extensions) - (apply try-create-file str modes perms)) - ((not idx) - (warn "not exclusive modes?" modes str) - (try-open-file str modes)) - (else (set! modes (string-append (substring modes 0 idx) - (substring modes (+ 1 idx) - (string-length modes)))) - (cond ((not (string-index modes #\w)) - (warn 'try-create-file "not writing?" modes str) - (try-open-file str modes)) - (else - (cond ((and (not (null? perms)) - (not (eqv? #o666 (car perms)))) - (warn "perms?" (car perms) str))) - (cond ((file-exists? str) #f) - (else (try-open-file str modes)))))))))) - -(if (not (defined? file-position)) -(define (file-position . args) #f)) -(if (not (defined? file-set-position)) -(define file-set-position file-position)) - -(define close-input-port close-port) -(define close-output-port close-port) - -(define (call-with-open-ports . ports) - (define proc (car ports)) - (cond ((procedure? proc) (set! ports (cdr ports))) - (else (set! ports (reverse ports)) - (set! proc (car ports)) - (set! ports (reverse (cdr ports))))) - (let ((ans (apply proc ports))) - (for-each close-port ports) - ans)) - -(define (call-with-input-file str proc) - (call-with-open-ports (open-input-file str) proc)) - -(define (call-with-output-file str proc) - (call-with-open-ports (open-output-file str) proc)) - -(define (with-input-from-port port thunk) - (dynamic-wind (lambda () (set! port (set-current-input-port port))) - thunk - (lambda () (set! port (set-current-input-port port))))) - -(define (with-output-to-port port thunk) - (dynamic-wind (lambda () (set! port (set-current-output-port port))) - thunk - (lambda () (set! port (set-current-output-port port))))) - -(define (with-error-to-port port thunk) - (dynamic-wind (lambda () (set! port (set-current-error-port port))) - thunk - (lambda () (set! port (set-current-error-port port))))) - -(define (with-input-from-file file thunk) - (let* ((nport (open-input-file file)) - (ans (with-input-from-port nport thunk))) - (close-port nport) - ans)) - -(define (with-output-to-file file thunk) - (let* ((nport (open-output-file file)) - (ans (with-output-to-port nport thunk))) - (close-port nport) - ans)) - -(define (with-error-to-file file thunk) - (let* ((nport (open-output-file file)) - (ans (with-error-to-port nport thunk))) - (close-port nport) - ans)) - -(define (call-with-outputs thunk proc) - (define stdout #f) - (define stderr #f) - (define status #f) - (set! stdout - (call-with-output-string - (lambda (stdout) - (set! stderr - (call-with-output-string - (lambda (stderr) - (call-with-current-continuation - (lambda (escape) - (dynamic-wind - (lambda () - (set! status #f) - (set! stdout (set-current-output-port stdout)) - (set! stderr (set-current-error-port stderr))) - (lambda () (set! status (list (thunk)))) - (lambda () - (set! stdout (set-current-output-port stdout)) - (set! stderr (set-current-error-port stderr)) - (if (not status) (escape #f)))))))))))) - (apply proc stdout stderr (or status '()))) - -(define browse-url - (case (software-type) - ((unix coherent plan9) - (lambda (url) - (define (try cmd end) (zero? (system (string-append cmd url end)))) - (or (try "netscape-remote -remote 'openURL(" ")'") - (try "netscape -remote 'openURL(" ")'") - (try "netscape '" "'&") - (try "netscape '" "'")))) - (else - (lambda (url) - (slib:warn 'define (software-type) 'case 'of 'browse-url 'in - *load-pathname*))))) - -(define (warn . args) - (define cep (current-error-port)) - (if (defined? print-call-stack) (print-call-stack cep)) - (perror "WARN") - (errno 0) - (display "WARN:" cep) - (for-each (lambda (x) (display #\space cep) (write x cep)) args) - (newline cep) - (force-output cep)) - -(define (error . args) - (define cep (current-error-port)) - (if (defined? print-call-stack) (print-call-stack cep)) - (perror "ERROR") - (errno 0) - (display "ERROR:" cep) - (for-each (lambda (x) (display #\space cep) (write x cep)) args) - (newline cep) - (force-output cep) - (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 #\space)) args) - (newline) - result) -(define (pprint . args) - (define result #f) - (for-each (lambda (x) (set! result x) (pretty-print x)) args) - result) -(define (pp . args) - (for-each pretty-print args) - (if #f #f)) - -(if (not (defined? file-exists?)) -(define (file-exists? str) - (let ((port (open-file str open_read))) - (errno 0) - (and port (close-port port) #t)))) -(define (file-readable? str) - (let ((port (open-file str open_read))) - (errno 0) - (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 +) - -(if (not (defined? ed)) -(define (ed . args) - (system (apply string-append - (or (getenv "EDITOR") "ed") - (map (lambda (s) (string-append " " s)) args))))) - -(if (not (defined? output-port-width)) -(define (output-port-width . arg) 80)) - -(if (not (defined? output-port-height)) -(define (output-port-height . arg) 24)) - -(if (not (defined? last-pair)) -(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l))) - -(define slib:error error) -(define slib:warn warn) -(define slib:tab #\tab) -(define slib:form-feed #\page) -(define slib:eval eval) - -(define (make-exchanger . pair) (lambda (rep) (swap-car! pair rep))) - -;;;; Load. -(define load:indent 0) -(define (load:pre file) - (define cep (current-error-port)) - (cond ((> (verbose) 1) - (display - (string-append ";" (make-string load:indent #\space) "loading " file) - cep) - (set! load:indent (modulo (+ 2 load:indent) 16)) - (newline cep))) - (force-output cep)) - -(define (load:post filesuf) - (define cep (current-error-port)) - (errno 0) - (cond ((> (verbose) 1) - (set! load:indent (modulo (+ -2 load:indent) 16)) - (display (string-append ";" (make-string load:indent #\space) - "done loading " filesuf) - cep) - (newline cep) - (force-output cep)))) - -;;; Here for backward compatibility -(define scheme-file-suffix - (case (software-type) - ((NOSVE) (lambda () "_scm")) - (else (lambda () ".scm")))) - -(define (has-suffix? str suffix) - (let ((sufl (string-length suffix)) - (sl (string-length str))) - (and (> sl sufl) - (string=? (substring str (- sl sufl) sl) suffix)))) - -(define *load-reader* #f) -(define (scm:load file . libs) - (define filesuf file) - (define hss (has-suffix? file (scheme-file-suffix))) - (load:pre file) - (or (and (defined? link:link) (not hss) - (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)) - (fs2 (file-readable? fs))) - (and fs2 (apply link:link fs libs) (set! filesuf fs) #t) - )))) - (and (null? libs) (try-load file *load-reader*)) - ;;HERE is where the suffix gets specified - (and (not hss) (errno 0) ; clean up error from TRY-LOAD above - (set! filesuf (string-append file (scheme-file-suffix))) - (try-load filesuf *load-reader*)) - (and (procedure? could-not-open) (could-not-open) #f) - (begin (set! load:indent 0) - (error "LOAD couldn't find file " file))) - (load:post filesuf)) -(define load scm:load) -(define slib:load load) - -(define (scm:load-source file) - (define sfs (scheme-file-suffix)) - (define filesuf file) - (load:pre file) - (or (and (or (try-load file *load-reader*) - ;;HERE is where the suffix gets specified - (and (not (has-suffix? file sfs)) - (begin (set! filesuf (string-append file sfs)) - (try-load filesuf *load-reader*))))) - (and (procedure? could-not-open) (could-not-open) #f) - (error "LOAD couldn't find file " file)) - (load:post filesuf)) -(define slib:load-source scm:load-source) - -;;; This is the vicinity where this file resides. -(define implementation-vicinity #f) - -;;; (library-vicinity) should be defined to be the pathname of the -;;; directory where files of Scheme library functions reside. -(define library-vicinity #f) - -;;; (home-vicinity) should return the vicinity of the user's HOME -;;; directory, the directory which typically contains files which -;;; customize a computer environment for a user. -(define home-vicinity #f) - -(if (not (defined? getpw)) - (define read-line - (if (defined? read-line) - read-line - (lambda port - (let* ((chr (apply read-char port))) - (if (eof-object? chr) - chr - (do ((chr chr (apply read-char port)) - (clist '() (cons chr clist))) - ((or (eof-object? chr) (char=? #\newline chr)) - (list->string (reverse clist)))))))))) -(if (not (defined? getpw)) - (define string-index - (if (defined? string-index) - string-index - (lambda (str chr) - (define len (string-length str)) - (do ((pos 0 (+ 1 pos))) - ((or (>= pos len) (char=? chr (string-ref str pos))) - (and (< pos len) pos))))))) - -(define (login->home-directory login) - (cond ((defined? getpw) - (let ((pwvect (getpw login))) - (and pwvect (vector-ref pwvect 5)))) - ((not (file-exists? "/etc/passwd")) #f) - (else - (call-with-input-file "/etc/passwd" - (lambda (iprt) - (let tryline () - (define line (read-line iprt)) - (define (get-field) - (define idx (string-index line #\:)) - (and idx - (let ((fld (substring line 0 idx))) - (set! line (substring line (+ 1 idx) - (string-length line))) - fld))) - (cond ((eof-object? line) #f) - ((string-index line #\:) - => (lambda (idx) - (define name (substring line 0 idx)) - (cond ((equal? login name) - (do ((ans (get-field) (get-field)) - (cnt 4 (+ -1 cnt))) - ((or (negative? cnt) (not ans)) ans))) - (else (tryline)))))))))))) - -(define (getlogin) (or (getenv "USER") (getenv "LOGNAME"))) - -;;; If the environment variable SCHEME_LIBRARY_PATH is undefined, use -;;; (implementation-vicinity) as (library-vicinity). "require.scm", -;;; the first file loaded from (library-vicinity), can redirect it. -(define (set-vicinities! init-file) - (set! implementation-vicinity - (let ((vic (substring - init-file - 0 - (- (string-length init-file) - (string-length "Init.scm") - (string-length (scheme-implementation-version)))))) - (lambda () vic))) - (let ((library-path (getenv "SCHEME_LIBRARY_PATH"))) - (if library-path - (set! library-vicinity (lambda () library-path)) - (let ((filename (in-vicinity (implementation-vicinity) "require.scm"))) - (or (try-load filename) - (try-load (in-vicinity (implementation-vicinity) "requires.scm")) - (error "Can't load" filename)) - (if (not library-vicinity) (error "Can't find library-vicinity"))))) - (set! home-vicinity - (let ((home (getenv "HOME"))) - (and (not home) login->home-directory - (let ((login (getlogin))) - (and login (set! home (login->home-directory login))))) - (and home - (case (software-type) - ((unix coherent plan9 ms-dos) ;V7 unix has a / on HOME - (if (not - (eqv? #\/ (string-ref home (+ -1 (string-length home))))) - (set! home (string-append home "/")))))) - (lambda () home)))) -;;; SET-VICINITIES! is also called from BOOT-TAIL -(set-vicinities! *load-pathname*) - -;;;; Initialize SLIB -(load (in-vicinity (library-vicinity) "require")) - -;;; This enables line-numbering for SLIB loads. -(define *slib-load-reader* (and (defined? read-numbered) read-numbered)) - -;;; DO NOT MOVE! SLIB:LOAD-SOURCE and SLIB:LOAD must be defined after -;;; "require.scm" is loaded. -(define (slib:load-source file) - (fluid-let ((*load-reader* *slib-load-reader*)) - (scm:load-source file))) -(define (slib:load file . libs) - (fluid-let ((*load-reader* *slib-load-reader*)) - (apply scm:load file libs))) - -;;; Legacy grease -(if (not (defined? slib:in-catalog?)) - (define slib:in-catalog? require:feature->path)) - -;;; Dynamic link-loading -(cond ((or (defined? dyn:link) - (defined? vms:dynamic-link-call)) - (load (in-vicinity (implementation-vicinity) "Link")))) - -;;; Redefine to ease transition from *features* to slib:features. -(define (provide feature) - (cond ((not (memq feature slib:features)) - (set! slib:features (cons feature slib:features)) - (if (defined? *features*) (set! *features* slib:features))))) - -(cond ((defined? link:link) -(define (slib:load-compiled . args) - (cond ((symbol? (car args)) - (require (car args)) - (apply slib:load-compiled (cdr args))) - ((apply link:link args) - (if (defined? *features*) (set! slib:features *features*))) - (else (error "Couldn't link files " args)))) -(provide 'compiled))) - -;;; Complete the function set for feature STRING-CASE. -(cond - ((defined? string-upcase!) -(define (string-upcase str) (string-upcase! (string-copy str))) -(define (string-downcase str) (string-downcase! (string-copy str))) -(define (string-capitalize str) (string-capitalize! (string-copy str))) -(define string-ci->symbol - (let ((s2cis (if (equal? "x" (symbol->string 'x)) - string-downcase string-upcase))) - (lambda (str) (string->symbol (s2cis str))))) -(define symbol-append - (let ((s2cis (if (equal? "x" (symbol->string 'x)) - string-downcase string-upcase))) - (lambda args - (string->symbol - (apply string-append - (map - (lambda (obj) - (cond ((char? obj) (string obj)) - ((string? obj) (s2cis obj)) - ((number? obj) (s2cis (number->string obj))) - ((symbol? obj) (symbol->string obj)) - ((not obj) "") - (else (error 'wrong-type-to 'symbol-append obj)))) - args)))))) -(define (StudlyCapsExpand nstr . delimitr) - (set! delimitr - (cond ((null? delimitr) "-") - ((char? (car delimitr)) (string (car delimitr))) - (else (car delimitr)))) - (do ((idx (+ -1 (string-length nstr)) (+ -1 idx))) - ((> 1 idx) nstr) - (cond ((and (> idx 1) - (char-upper-case? (string-ref nstr (+ -1 idx))) - (char-lower-case? (string-ref nstr idx))) - (set! nstr - (string-append (substring nstr 0 (+ -1 idx)) - delimitr - (substring nstr (+ -1 idx) - (string-length nstr))))) - ((and (char-lower-case? (string-ref nstr (+ -1 idx))) - (char-upper-case? (string-ref nstr idx))) - (set! nstr - (string-append (substring nstr 0 idx) - delimitr - (substring nstr idx - (string-length nstr)))))))) -(provide 'string-case))) - -;;;; Bit order and lamination - -;;(define (logical:ones deg) (lognot (ash -1 deg))) - -;;; New with SRFI-60 -(define (rotate-bit-field n count start end) - (define width (- end start)) - (set! count (modulo count width)) - (let ((mask (lognot (ash -1 width)))) - (define azn (logand mask (arithmetic-shift n (- start)))) - (logior (arithmetic-shift - (logior (logand mask (arithmetic-shift azn count)) - (arithmetic-shift azn (- count width))) - start) - (logand (lognot (ash mask start)) n)))) -;;; Legacy -;;(define (logical:rotate k count len) (rotate-bit-field k count 0 len)) - -(define (log2-binary-factors n) - (+ -1 (integer-length (logand n (- n))))) - -(define (bit-reverse k n) - (do ((m (if (negative? n) (lognot n) n) (arithmetic-shift m -1)) - (k (+ -1 k) (+ -1 k)) - (rvs 0 (logior (arithmetic-shift rvs 1) (logand 1 m)))) - ((negative? k) (if (negative? n) (lognot rvs) rvs)))) -(define (reverse-bit-field n start end) - (define width (- end start)) - (let ((mask (lognot (ash -1 width)))) - (define zn (logand mask (arithmetic-shift n (- start)))) - (logior (arithmetic-shift (bit-reverse width zn) start) - (logand (lognot (ash mask start)) n)))) - -(define (integer->list k . len) - (if (null? len) - (do ((k k (arithmetic-shift k -1)) - (lst '() (cons (odd? k) lst))) - ((<= k 0) lst)) - (do ((idx (+ -1 (car len)) (+ -1 idx)) - (k k (arithmetic-shift k -1)) - (lst '() (cons (odd? k) lst))) - ((negative? idx) lst)))) - -(define (list->integer bools) - (do ((bs bools (cdr bs)) - (acc 0 (+ acc acc (if (car bs) 1 0)))) - ((null? bs) acc))) -(define (booleans->integer . bools) - (list->integer bools)) - -;;;; SRFI-60 aliases -(define arithmetic-shift ash) -(define bitwise-ior logior) -(define bitwise-xor logxor) -(define bitwise-and logand) -(define bitwise-not lognot) -;;(define bit-count logcount) ;Aliases bit-vector function -;;BITWISE-BIT-COUNT returns negative count for negative inputs. -(define bit-set? logbit?) -(define any-bits-set? logtest) -(define first-set-bit log2-binary-factors) -(define bitwise-merge bitwise-if) - -(define @case-aux - (let ((integer-jump-table 1) - (char-jump-table 2)) - (lambda (keys actions else-action) - (let ((n (length keys))) - (define (every-key pred) - (let test ((keys keys)) - (or (null? keys) - (and (pred (car keys)) (test (cdr keys)))))) - (define (jump-table keys) - (let ((minkey (apply min keys)) - (maxkey (apply max keys))) - (and (< (- maxkey minkey) (* 4 n)) - (let ((actv (make-vector - (+ 2 (- maxkey minkey)) else-action))) - (for-each - (lambda (key action) - (vector-set! actv (+ 1 (- key minkey)) action)) - keys actions) - (list integer-jump-table minkey actv))))) - (cond ((< n 5) #f) - ((every-key integer?) - (jump-table keys)) - ((every-key char?) - (let* ((int-keys (map char->integer keys))) - (cond ((jump-table int-keys) => - (lambda (x) - (cons char-jump-table - (cons (integer->char (cadr x)) - (cddr x))))) - (else #f))))))))) - -;;;defmacro from dorai@cs.rice.edu (heavily hacked by jaffer): -(define *defmacros* '()) -(define (defmacro? m) (and (assq m *defmacros*) #t)) - -(define defmacro:transformer - (lambda (f) - (procedure->memoizing-macro - (lambda (exp env) - (@copy-tree (apply f (remove-line-numbers! (cdr exp)))))))) - -(define defmacro:get-destructuring-bind-pairs - (lambda (s e) - (let loop ((s s) (e e) (r '())) - (cond ((pair? s) - (loop (car s) `(car ,e) - (loop (cdr s) `(cdr ,e) r))) - ((null? s) r) - ((symbol? s) (cons `(,s ,e) r)) - (else (error 'destructuring-bind "illegal syntax")))))) - -(defsyntax destructuring-bind - (let ((destructuring-bind-transformer - (lambda (s x . ff) - (let ((tmp (gentemp))) - `(let ((,tmp ,x)) - (let ,(defmacro:get-destructuring-bind-pairs s tmp) - ,@ff)))))) - (set! *defmacros* - (acons 'destructuring-bind - destructuring-bind-transformer *defmacros*)) - (defmacro:transformer destructuring-bind-transformer))) - -(defsyntax defmacro:simple-defmacro - (let ((defmacro-transformer - (lambda (name parms . body) - `(defsyntax ,name - (let ((transformer (lambda ,parms ,@body))) - (set! *defmacros* (acons ',name transformer *defmacros*)) - (defmacro:transformer transformer)))))) - (set! *defmacros* (acons 'defmacro defmacro-transformer *defmacros*)) - (defmacro:transformer defmacro-transformer))) - -(defmacro:simple-defmacro defmacro (name . body) - (define (expn name pattern body) - (let ((args (gentemp))) - `(defmacro:simple-defmacro ,name ,args - (destructuring-bind ,pattern ,args ,@body)))) - (if (pair? name) - (expn (car name) (cdr name) body) - (expn name (car body) (cdr body)))) - -(define (macroexpand-1 e) - (if (pair? e) (let ((a (car e))) - (cond ((symbol? a) (set! a (assq a *defmacros*)) - (if a (apply (cdr a) (cdr e)) e)) - (else e))) - e)) - -(define (macroexpand e) - (if (pair? e) (let ((a (car e))) - (cond ((symbol? a) - (set! a (assq a *defmacros*)) - (if a (macroexpand (apply (cdr a) (cdr e))) e)) - (else e))) - e)) - -(define gentemp - (let ((*gensym-counter* -1)) - (lambda () - (set! *gensym-counter* (+ *gensym-counter* 1)) - (string->symbol - (string-append "scm:G" (number->string *gensym-counter*)))))) - -(define defmacro:eval slib:eval) -(define defmacro:load load) -;; slib:eval-load definition moved to "slib/require.scm" - -;;;; Autoloads for SLIB procedures. - -(define (trace-all . args) (require 'debug) (apply trace-all args)) -(define (track-all . args) (require 'debug) (apply track-all args)) -(define (stack-all . args) (require 'debug) (apply stack-all args)) -(define (break-all . args) (require 'debug) (apply break-all args)) -(define (pretty-print . args) (require 'pretty-print) (apply pretty-print args)) - -;;; (require 'transcript) would get us SLIB transcript -- not what we want. -(define (transcript-on arg) - (load (in-vicinity (implementation-vicinity) - (string-append "Tscript" (scheme-file-suffix)))) - (transcript-on arg)) -(define (transcript-off) - (error "No transcript active")) - -;;;; Macros. - -;;; Trace gets re-defmacroed when tracef autoloads. -(defmacro trace x (cond ((null? x) '()) (else (require 'trace) `(trace ,@x)))) -(defmacro track x (cond ((null? x) '()) (else (require 'track) `(track ,@x)))) -(defmacro stack x (cond ((null? x) '()) (else (require 'stack) `(stack ,@x)))) -(defmacro break x (cond ((null? x) '()) (else (require 'break) `(break ,@x)))) - -(defmacro defvar (var val) - `(if (not (defined? ,var)) (define ,var ,val))) -(defmacro defconst (name value) - (cond ((list? name) `(defconst ,(car name) (lambda ,(cdr name) ,value))) - (else (cond ((not (slib:eval `(defined? ,name)))) - ((and (symbol? name) (equal? (slib:eval value) - (slib:eval name)))) - (else (error 'trying-to-defconst name - 'to-different-value value))) - `(define ,name ,value)))) -(defmacro qase (key . clauses) - `(case ,key - ,@(map (lambda (clause) - (if (list? (car clause)) - (cons (apply - append - (map (lambda (elt) - (case elt - ((unquote) '(unquote)) - ((unquote-splicing) '(unquote-splicing)) - (else - (eval (list 'quasiquote (list elt)))))) - (car clause))) - (cdr clause)) - clause)) - clauses))) -(defmacro (casev . args) `(qase ,@args)) - -(defmacro fluid-let (clauses . body) - (let ((ids (map car clauses)) - (temp (gentemp)) - (swap (gentemp))) - `(let* ((,temp (list ,@(map cadr clauses))) - (,swap (lambda () (set! ,temp (set! ,ids ,temp))))) - (dynamic-wind - ,swap - (lambda () ,@body) - ,swap)))) - -(define (scm:print-binding sexp frame) - (cond ((not (null? (cdr sexp))) - (display "In") - (for-each (lambda (exp) (display #\space) (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 (car vals)))) - (newline)) - (write (car vars)) (display " = ") (write (car vals)) (display "; "))) - -(define print-args - (procedure->memoizing-macro - (lambda (sexp env) - (define (fix-list frm) - (cond ((pair? frm) (cons (car frm) (fix-list (cdr frm)))) - ((null? frm) '()) - ((symbol? frm) (list frm)) - (else '()))) - (define frm (car env)) - `(scm:print-binding - ',sexp - ,(cond ((symbol? frm) `(list ',frm ,frm)) - ((list? frm) `(list ',frm ,@frm)) - ((pair? frm) - (let ((jlp (fix-list frm))) - `(list ',(if (symbol? (cdr (last-pair frm))) frm jlp) - ,@jlp)))))))) - -(cond - ((defined? stack-trace) - -;;#+breakpoint-error;; remove line to enable breakpointing on calls to ERROR -(define error - (letrec ((oerror error) - (nerror - (lambda args - (dynamic-wind - (lambda () (set! error oerror)) - (lambda () - (define cep (current-error-port)) - (if (defined? print-call-stack) - (print-call-stack cep)) - (perror "ERROR") - (errno 0) - (display "ERROR: " cep) - (if (not (null? args)) - (begin (display (car args) cep) - (for-each (lambda (x) (display #\space cep) (write x cep)) - (cdr args)))) - (newline cep) - (cond ((stack-trace) (newline cep))) - (display " * Breakpoint established: (continue ) to return." cep) - (newline cep) (force-output cep) - (require 'debug) (apply breakpoint args)) - (lambda () (set! error nerror)))))) - nerror)) - -(define (user-interrupt . args) - (define cep (current-error-port)) - (newline cep) - (if (defined? print-call-stack) - (print-call-stack cep)) - (display "ERROR: user interrupt" cep) - (newline cep) - (cond ((stack-trace) (newline cep))) - (display " * Breakpoint established: (continue ) to return." cep) - (newline cep) (force-output cep) - (require 'debug) (apply breakpoint args)) - )) - -(cond ((and (inexact? (string->number "0.0")) (not (defined? exp))) - (or (and (defined? usr:lib) - (usr:lib "m") - (load (in-vicinity (implementation-vicinity) "Transcen") - (usr:lib "m"))) - (load (in-vicinity (implementation-vicinity) "Transcen")))) - (else - (define (infinite? z) #f) - (define finite? number?) - (define inexact->exact identity) - (define exact->inexact identity) - (define round->exact identity) - (define floor->exact identity) - (define ceiling->exact identity) - (define truncate->exact identity) - (define expt integer-expt))) - -(define (numerator q) - (if (not (rational? q)) (error 'numerator q)) - (do ((num q (* 2 num))) - ((integer? num) num))) - -(define (denominator q) - (if (not (rational? q)) (error 'denominator q)) - (do ((num q (* 2 num)) - (den (- q q -1) (* 2 den))) - ((integer? num) den))) -;@ -(define (integer-log base k) - (define (ilog m b k) - (cond ((< k b) k) - (else - (set! n (+ n m)) - (let ((q (ilog (+ m m) (* b b) (quotient k b)))) - (cond ((< q b) q) - (else (set! n (+ m n)) - (quotient q b))))))) - (define n 1) - (define (eigt? k j) (and (exact? k) (integer? k) (> k j))) - (cond ((not (and (eigt? base 1) (eigt? k 0))) - (slib:error 'integer-log base k)) - ((< k base) 0) - (else (ilog 1 base (quotient k base)) n))) - -;;;; http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/math/isqrt/isqrt.txt -;;; Akira Kurihara -;;; School of Mathematics -;;; Japan Women's University -;@ -(define integer-sqrt - (let ((table '#(0 - 1 1 1 - 2 2 2 2 2 - 3 3 3 3 3 3 3 - 4 4 4 4 4 4 4 4 4)) - (square (lambda (x) (* x x)))) - (lambda (n) - (define (isqrt n) - (if (> n 24) - (let* ((len/4 (quotient (- (integer-length n) 1) 4)) - (top (isqrt (ash n (* -2 len/4)))) - (init (ash top len/4)) - (q (quotient n init)) - (iter (quotient (+ init q) 2))) - (cond ((odd? q) iter) - ((< (remainder n init) (square (- iter init))) (- iter 1)) - (else iter))) - (vector-ref table n))) - (if (and (exact? n) (integer? n) (not (negative? n))) - (isqrt n) - (slib:error 'integer-sqrt n))))) - -(if (defined? array?) -(begin - -(define (array-null? array) - (zero? (apply * (map (lambda (bnd) (- 1 (apply - bnd))) - (array-shape array))))) -(define (create-array prot . args) - (if (array-null? prot) - (dimensions->uniform-array args (array-prototype prot)) - (dimensions->uniform-array args (array-prototype prot) - (apply array-ref prot - (map car (array-shape prot)))))) -(define make-array create-array) -(define (list->array rank proto lst) - (list->uniform-array rank (array-prototype proto) lst)) -(define (vector->array vect prototype . dimensions) - (define vdx (vector-length vect)) - (if (not (eqv? vdx (apply * dimensions))) - (slib:error 'vector->array vdx '<> (cons '* dimensions))) - (let ((ra (apply make-array prototype dimensions))) - (define (v2ra dims idxs) - (cond ((null? dims) - (set! vdx (+ -1 vdx)) - (apply array-set! ra (vector-ref vect vdx) (reverse idxs))) - (else - (do ((idx (+ -1 (car dims)) (+ -1 idx))) - ((negative? idx) vect) - (v2ra (cdr dims) (cons idx idxs)))))) - (v2ra dimensions '()) - ra)) -(define (array->vector ra) - (define dims (array-dimensions ra)) - (let* ((vdx (apply * dims)) - (vect (make-vector vdx))) - (define (ra2v dims idxs) - (if (null? dims) - (let ((val (apply array-ref ra (reverse idxs)))) - (set! vdx (+ -1 vdx)) - (vector-set! vect vdx val) - vect) - (do ((idx (+ -1 (car dims)) (+ -1 idx))) - ((negative? idx) vect) - (ra2v (cdr dims) (cons idx idxs))))) - (ra2v dims '()))) -(define (make-uniform-wrapper prot) - (if (string? prot) (set! prot (string->number prot))) - (if prot - (lambda opt (if (null? opt) - (list->uniform-array 1 prot '()) - (list->uniform-array 0 prot (car opt)))) - vector)) -(define Ac64 (make-uniform-wrapper "+64i")) -(define Ac32 (make-uniform-wrapper "+32i")) -(define Ar64 (make-uniform-wrapper "64.")) -(define Ar32 (make-uniform-wrapper "32.")) -(define As64 (make-uniform-wrapper -64)) -(define As32 (make-uniform-wrapper -32)) -(define As16 (make-uniform-wrapper -16)) -(define As8 (make-uniform-wrapper -8)) -(define Au64 (make-uniform-wrapper 64)) -(define Au32 (make-uniform-wrapper 32)) -(define Au16 (make-uniform-wrapper 16)) -(define Au8 (make-uniform-wrapper 8)) -(define At1 (make-uniform-wrapper #t)) - -;;; New SRFI-58 names -;; flonums -(define A:floC128b Ac64) -(define A:floC64b Ac64) -(define A:floC32b Ac32) -(define A:floC16b Ac32) -(define A:floR128b Ar64) -(define A:floR64b Ar64) -(define A:floR32b Ar32) -(define A:floR16b Ar32) -;; decimal flonums -(define A:floQ128d Ar64) -(define A:floQ64d Ar64) -(define A:floQ32d Ar32) -;; fixnums -(define A:fixZ64b As64) -(define A:fixZ32b As32) -(define A:fixZ16b As16) -(define A:fixZ8b As8) -(define A:fixN64b Au64) -(define A:fixN32b Au32) -(define A:fixN16b Au16) -(define A:fixN8b Au8) -(define A:bool At1) - -(define (array-shape a) - (let ((dims (array-dimensions a))) - (if (pair? dims) - (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind)) - dims) - dims))) -(define array=? equal?) -(provide 'srfi-47) -(provide 'srfi-58) -(provide 'srfi-63) -)) - -(define (alarm-interrupt) (alarm 0)) -(if (defined? setitimer) - (begin - (define profile-alarm #f) - (define (profile-alarm-interrupt) (profile-alarm 0)) - (define virtual-alarm #f) - (define (virtual-alarm-interrupt) (virtual-alarm 0)) - (define milli-alarm #f) - (let ((make-alarm - (lambda (sym) - (and (setitimer sym 0 0) ;DJGPP supports only REAL and PROFILE - (lambda (value . interval) - (cadr - (setitimer sym value - (if (pair? interval) (car interval) 0)))))))) - (set! profile-alarm (make-alarm 'profile)) - (set! virtual-alarm (make-alarm 'virtual)) - (set! milli-alarm (make-alarm 'real))))) - -;;;; Initialize statically linked add-ons -(cond ((defined? scm_init_extensions) - (scm_init_extensions) - (if (defined? *features*) (set! slib:features *features*)) - (set! scm_init_extensions #f))) - -;;; Use *argv* instead of (program-arguments), to allow option -;;; processing to be done on it. "ScmInit.scm" must -;;; (set! *argv* (program-arguments)) -;;; if it wants to alter the arguments which BOOT-TAIL processes. -(define *argv* #f) - -(if (not (defined? *syntax-rules*)) - (define *syntax-rules* #f)) -(if (not (defined? *interactive*)) - (define *interactive* #f)) - -(define (boot-tail dumped?) - (cond ((not *argv*) - (set! *argv* (program-arguments)) - (cond (dumped? - (set-vicinities! dumped?) - (verbose (if (and (isatty? (current-input-port)) - (isatty? (current-output-port))) - (if (<= (length *argv*) 1) 2 1) - 0)))) - (cond ((provided? 'getopt) - (set! *optind* 1) - (set! *optarg* #f))))) - -;;; This loads the user's initialization file, or files named in -;;; program arguments. - (or *script* - (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)) - *load-reader*) - (errno 0)) - - ;; Include line numbers in loaded code. - (if (defined? read-numbered) - (set! *load-reader* read-numbered)) - - (cond - ((and (> (length *argv*) 1) (char=? #\- (string-ref (cadr *argv*) 0))) - (require 'getopt) -;;; (else -;;; (define *optind* 1) -;;; (define getopt:opt #f) -;;; (define (getopt optstring) #f)) - - (let* ((simple-opts "muvqibs") - (arg-opts '("a kbytes" "-version" "-help" - "-no-symbol-case-fold" - "no-init-file" "-no-init-file" "p number" - "h feature" "r feature" "d filename" - "f filename" "l filename" - "c string" "e string" "o filename")) - (opts (apply string-append ":" simple-opts - (map (lambda (o) - (string-append (string (string-ref o 0)) ":")) - arg-opts))) - (didsomething #f) - (moreopts #t) - (exe-name (symbol->string (scheme-implementation-type))) - (up-name (apply string (map char-upcase (string->list exe-name))))) - - (define (do-thunk thunk) - (if *interactive* - (thunk) - (let ((complete #f)) - (dynamic-wind - (lambda () #f) - (lambda () - (thunk) - (set! complete #t)) - (lambda () - (if (not complete) (close-port (current-input-port)))))))) - - (define (do-string-arg) - (require 'string-port) - (do-thunk - (lambda () - ((if *syntax-rules* macro:eval eval) - (call-with-input-string - (string-append "(begin " *optarg* ")") - read)))) - (set! didsomething #t)) - - (define (do-load file) - (do-thunk - (lambda () - (cond (*syntax-rules* (require 'macro) (macro:load file)) - (else (load file))))) - (set! didsomething #t)) - - (define (usage preopt opt postopt success?) - (define cep (if success? (current-output-port) (current-error-port))) - (define indent (make-string 6 #\space)) - (define i 3) - (cond ((char? opt) (set! opt (string opt))) - ;;((symbol? opt) (set! opt (symbol->string opt))) - ) - (display (string-append preopt opt postopt) cep) - (newline cep) - (display (string-append "Usage: " - exe-name - " [-a kbytes] [-" simple-opts "]") cep) - (for-each - (lambda (o) - (display (string-append " [-" o "]") cep) - (set! i (+ 1 i)) - (cond ((zero? (modulo i 5)) (newline cep) (display indent cep)))) - (cdr arg-opts)) - (display " [-- | -s | -] [file] [args...]" cep) (newline cep) - (if success? (display success? cep) (quit #f))) - - ;; -a int => ignore (handled by scm_init_from_argv) - ;; -c str => (eval str) - ;; -e str => (eval str) - ;; -d str => (require 'databases) (open-database str) - ;; -f str => (load str) - ;; -l str => (load str) - ;; -r sym => (require sym) - ;; -h sym => (provide sym) - ;; -o str => (dump str) - ;; -p int => (verbose int) - ;; -m => (set! *syntax-rules* #t) - ;; -u => (set! *syntax-rules* #f) - ;; -v => (verbose 3) - ;; -q => (verbose 0) - ;; -i => (set! *interactive* #t) - ;; -b => (set! *interactive* #f) - ;; -s => set argv, don't execute first one - ;; --no-symbol-case-fold => symbols preserve character case - ;; -no-init-file => don't load init file - ;; --no-init-file => don't load init file - ;; --help => print and exit - ;; --version => print and exit - ;; -- => last option - - (let loop ((option (getopt-- opts))) - (case option - ((#\a) - (cond ((> *optind* 3) - (usage "scm: option `-" getopt:opt "' must be first" #f)) - ((or (not (exact? (string->number *optarg*))) - (not (<= 1 (string->number *optarg*) 10000))) - ;; This size limit should match scm.c ^^ - (usage "scm: option `-" getopt:opt - (string-append *optarg* "' unreasonable") #f)))) - ((#\e #\c) (do-string-arg)) ;sh-like - ((#\f #\l) (do-load *optarg*)) ;(set-car! *argv* *optarg*) - ((#\d) (require 'databases) - (open-database *optarg*)) - ((#\o) (require 'dump) - (if (< *optind* (length *argv*)) - (dump *optarg* #t) - (dump *optarg*))) - ((#\r) (do-thunk (lambda () - (if (and (= 1 (string-length *optarg*)) - (char-numeric? (string-ref *optarg* 0))) - (case (string-ref *optarg* 0) - ((#\2) (require 'r2rs)) - ((#\3) (require 'r3rs)) - ((#\4) (require 'r4rs)) - ((#\5) (require 'r5rs) - (set! *syntax-rules* #t)) - (else (require (string->symbol *optarg*)))) - (require (string->symbol *optarg*)))))) - ((#\h) (do-thunk (lambda () (provide (string->symbol *optarg*))))) - ((#\p) (verbose (string->number *optarg*))) - ((#\q) (verbose 0)) - ((#\v) (verbose 3)) - ((#\i) (set! *interactive* #t) ;sh-like - (verbose (max 2 (verbose)))) - ((#\b) (set! didsomething #t) - (set! *interactive* #f)) - ((#\s) (set! moreopts #f) ;sh-like - (set! didsomething #t) - (set! *interactive* #t)) - ((#\m) (set! *syntax-rules* #t)) - ((#\u) (set! *syntax-rules* #f)) - ((#\n) (if (not (string=? "o-init-file" *optarg*)) - (usage "scm: unrecognized option `-n" *optarg* "'" #f))) - ((#\:) (usage "scm: option `-" getopt:opt "' requires an argument" #f)) - ((#\?) (usage "scm: unrecognized option `-" getopt:opt "'" #f)) - ((#f) (set! moreopts #f) ;sh-like - (cond ((and (< *optind* (length *argv*)) - (string=? "-" (list-ref *argv* *optind*))) - (set! *optind* (+ 1 *optind*))))) - (else - (or (cond ((not (string? option)) #f) - ((string-ci=? "no-init-file" option)) - ((string-ci=? "no-symbol-case-fold" option)) - ((string-ci=? "version" option) - (display - (string-append exe-name " " - (scheme-implementation-version) - " -Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. -" - up-name - " may be distributed under the terms of" - " the GNU General Public Licence; -certain other uses are permitted as well." - " For details, see the file `COPYING', -which is included in the " - up-name " distribution. -There is no warranty, to the extent permitted by law. -" - )) - (cond ((execpath) => - (lambda (path) - (display " This executable was loaded from ") - (write path) - (newline)))) - (quit #t)) - ((string-ci=? "help" option) - (usage "This is " - up-name - ", a Scheme interpreter." - (let ((sihp (scheme-implementation-home-page))) - (if sihp - (string-append "Latest info: " sihp " -") - ""))) - (quit #t)) - (else #f)) - (usage "scm: unknown option `--" option "'" #f)))) - - (cond ((and moreopts (< *optind* (length *argv*))) - (loop (getopt-- opts))) - ((< *optind* (length *argv*)) ;No more opts - (set! *argv* (list-tail *argv* *optind*)) - (set! *optind* 1) - (cond ((and (not didsomething) *script*) - (do-load *script*) - (set! *optind* (+ 1 *optind*)))) - (cond ((and (> (verbose) 2) - (not (= (+ -1 *optind*) (length *argv*)))) - (display "scm: extra command arguments unused:" - (current-error-port)) - (for-each (lambda (x) (display (string-append " " x) - (current-error-port))) - (list-tail *argv* (+ -1 *optind*))) - (newline (current-error-port))))) - ((and (not didsomething) (= *optind* (length *argv*))) - (set! *interactive* #t))))) - - (cond ((not *interactive*) (quit)) - ((and *syntax-rules* (not (provided? 'macro))) - (require 'repl) - (require 'macro) - (let* ((oquit quit)) - (set! quit (lambda () (repl:quit))) - (set! exit quit) - (repl:top-level macro:eval) - (oquit)))) - ;;otherwise, fall into natural SCM repl. - ) - (else (errno 0) - (set! *interactive* #t) - (for-each load (cdr (program-arguments)))))) diff --git a/Init5f2.scm b/Init5f2.scm new file mode 100644 index 0000000..02a6137 --- /dev/null +++ b/Init5f2.scm @@ -0,0 +1,1611 @@ +;;;; "Init.scm", Scheme initialization code for SCM. +;; Copyright (C) 1991-2008 Free Software Foundation, Inc. +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Lesser General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, 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 +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this program. If not, see +;; . + +;;; Author: Aubrey Jaffer. + +(define (scheme-implementation-type) 'scm) +(define (scheme-implementation-version) "5f2") +(define (scheme-implementation-home-page) + "http://people.csail.mit.edu/jaffer/SCM") + +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((vms) "[.]") + (else ""))) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((vms) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity ) ) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + +(define slib:features + (append '(ed getenv tmpnam abort transcript with-file + ieee-p1178 rev4-report rev4-optional-procedures + hash object-hash delay dynamic-wind fluid-let + multiarg-apply multiarg/and- logical defmacro + string-port source current-time sharp:semi + math-integer ;math-real and srfi-94 provided in "Transcen.scm" + vicinity srfi-59 srfi-96 srfi-23 + srfi-60) ;logical + (if (defined? *features*) *features* slib:features))) +(if (defined? *features*) (set! *features* slib:features)) + +(define eval + (let ((@eval @eval) + (@copy-tree @copy-tree)) + (lambda (x) (@eval (@copy-tree x))))) + +(define (exec-self) + (require 'i/o-extensions) + (execv (execpath) (if *script* + (cons (car (program-arguments)) + (cons "\\" + (member *script* (program-arguments)))) + (program-arguments)))) + +(define (display-file file . port) + (call-with-input-file file + (lambda (inport) + (do ((c (read-char inport) (read-char inport))) + ((eof-object? c)) + (apply write-char c port))))) +(define (terms) + (display-file (in-vicinity (implementation-vicinity) "COPYING"))) + +;;; Read integer up to first non-digit +(define (read:try-number port . ic) + (define chr0 (char->integer #\0)) + (let loop ((arg (and (not (null? ic)) (- (char->integer (car ic)) chr0)))) + (let ((c (peek-char port))) + (cond ((eof-object? c) #f) + ((char-numeric? c) + (loop (+ (* 10 (or arg 0)) + (- (char->integer (read-char port)) chr0)))) + (else arg))))) + +(define (read-array-type port) + (define (bomb pc wid) + (error 'array 'syntax? (symbol-append "#" rank "A" pc wid))) + (case (char-downcase (peek-char port)) + ((#\:) (read-char port) + (let ((typ (let loop ((arg '())) + (if (= 4 (length arg)) + (string->symbol (list->string (reverse arg))) + (let ((c (read-char port))) + (and (not (eof-object? c)) + (loop (cons (char-downcase c) arg)))))))) + (define wid (and typ (not (eq? 'bool typ)) (read:try-number port))) + (define (check-suffix chrs) + (define chr (read-char port)) + (if (and (char? chr) (not (memv (char-downcase chr) chrs))) + (error 'array-type? (symbol-append ":" typ wid chr)))) + (define prot (assq typ '((floc (128 . +64.0i) + (64 . +64.0i) + (32 . +32.0i) + (16 . +32.0i)) + (flor (128 . 64.0) + (64 . 64.0) + (32 . 32.0) + (16 . 32.0)) + (fixz (64 . -64) + (32 . -32) + (16 . -16) + (8 . -8)) + (fixn (64 . 64) + (32 . 32) + (16 . 16) + (8 . 8)) + (char . #\a) + (bool . #t)))) + (if prot (set! prot (cdr prot))) + (cond ((pair? prot) + (set! prot (assv wid (cdr prot))) + (if (pair? prot) (set! prot (cdr prot))) + (if wid (check-suffix (if (and (inexact? prot) (real? prot)) + '(#\b #\d) + '(#\b))))) + (prot) + (else (check-suffix '()))) + prot)) + ((#\\) (read-char port) #\a) + ((#\t) (read-char port) #t) + ((#\c #\r) (let* ((pc (read-char port)) (wid (read:try-number port))) + (case wid + ((64 32) (case pc + ((#\c) (* +i wid)) + (else (exact->inexact wid)))) + (else (bomb pc wid))))) + ((#\s #\u) (let* ((pc (read-char port)) (wid (read:try-number port))) + (case (or wid (peek-char port)) + ((32 16 8) (case pc + ((#\s) (- wid)) + (else wid))) + (else (bomb pc wid))))) + (else #f))) + +;;; We come into read:array with number or #f for RANK. +(define (read:array rank dims port) + (define (make-it rank dims typ) + (list->uniform-array (cond (rank) + ((null? dims) 1) + (else (length dims))) + typ + (read port))) + (let loop ((dims dims)) + (define dim (read:try-number port)) + (if dim + (loop (cons dim dims)) + (case (peek-char port) + ((#\*) (read-char port) (loop dims)) + ((#\: #\\ #\t #\c #\r #\s #\u #\T #\C #\R #\S #\U) + (make-it rank dims (read-array-type port))) + (else + (make-it rank dims #f)))))) + +;;; read-macros valid for LOAD and READ. +(define (read:sharp c port reader) ; ignore reader + (case c + ;; Used in "implcat" and "slibcat" + ((#\+) (if (slib:provided? (read port)) + (read port) + (begin (read port) (if #f #f)))) + ;; Used in "implcat" and "slibcat" + ((#\-) (if (slib:provided? (read port)) + (begin (read port) (if #f #f)) + (read port))) + ((#\a #\A) (read:array #f '() port)) + ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) + (let* ((num (read:try-number port c)) + (chr (peek-char port))) + (case chr + ((#\a #\A) (read-char port) + (read:array num '() port)) + ((#\*) (read-char port) + (read:array #f (list num) port)) + (else + (read:array 1 (list num) port)) + ;;(else (error 'sharp 'syntax? (symbol-append "#" num chr))) + ))) + (else (error "unknown # object" c)))) + +;;; read-macros valid only in LOAD. +(define (load:sharp c port reader) ;reader used only for #. + (case c + ((#\') (read port)) + ((#\.) (eval (reader port))) + ((#\!) (let skip ((metarg? #f)) + (let ((c (read-char port))) + (case c + ((#\newline) (if metarg? (skip #t))) + ((#\\) (skip #t)) + ((#\!) (cond ((eqv? #\# (peek-char port)) + (read-char port) + (if #f #f)) + (else (skip metarg?)))) + (else (if (char? c) (skip metarg?) c)))))) + ;; Make #; convert the rest of the line to a (comment ...) form. + ;; "build.scm" uses this. + ((#\;) (let skip-semi () + (cond ((eqv? #\; (peek-char port)) + (read-char port) + (skip-semi)) + (else (require 'line-i/o) + `(comment ,(read-line port)))))) + ((#\?) (case (read port) + ((line) (port-line port)) + ((column) (port-column port)) + ((file) (port-filename port)) + (else #f))) + (else (read:sharp c port read)))) + +;;; We can assume TOK has at least 2 characters. +(define char:sharp + (letrec ((numeric-1 + (lambda (tok radix) + (numeric (substring tok 1 (string-length tok)) radix))) + (numeric + (lambda (tok radix) + (cond ((string->number tok radix) => integer->char)))) + (compose + (lambda (modifier tok) + (and (char=? #\- (string-ref tok 1)) + (if (= 3 (string-length tok)) + (modifier (string-ref tok 2)) + (let ((c (char:sharp + (substring tok 2 (string-length tok))))) + (and c (modifier c))))))) + (control + (lambda (c) + (and (char? c) + (if (eqv? c #\?) + (integer->char 127) + (integer->char (logand #o237 (char->integer c))))))) + (meta + (lambda (c) + (and (char? c) + (integer->char (logior 128 (char->integer c))))))) + (lambda (tok) + (case (string-ref tok 0) + ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7) (numeric tok 8)) + ((#\O #\o) (numeric-1 tok 8)) + ((#\D #\d) (numeric-1 tok 10)) + ((#\X #\x) (numeric-1 tok 16)) + ((#\C #\c) (compose control tok)) + ((#\^) (and (= 2 (string-length tok)) (control (string-ref tok 1)))) + ((#\M #\m) (compose meta tok)))))) + +;;;; Function used to accumulate comments before a definition. +(define comment + (let ((*accumulated-comments* '())) + (lambda args + (cond ((null? args) + (let ((ans + (apply string-append + (map (lambda (comment) + (string-append (or comment "") "\n")) + (reverse *accumulated-comments*))))) + (set! *accumulated-comments* '()) + (if (equal? "" ans) + "no-comment" ;#f + (substring ans 0 (+ -1 (string-length ans)))))) + (else (set! *accumulated-comments* + (append (reverse args) *accumulated-comments*))))))) + +(define : ':) ;for /bin/sh hack. +(define !#(if #f #f)) ;for scsh hack. + +;;;; Here are some Revised^2 Scheme functions: +(define 1+ (let ((+ +)) (lambda (n) (+ n 1)))) +(define -1+ (let ((+ +)) (lambda (n) (+ n -1)))) +(define 1- -1+) +(define ? >) +(define >=? >=) +(define t #t) +(define nil #f) +(define identity cr) + +(cond ((defined? defsyntax) +(defsyntax define-syntax (the-macro defsyntax))) + (else +(define defsyntax define) +(define the-macro identity))) +(defsyntax sequence (the-macro begin)) +(define copy-tree @copy-tree) + +;;; VMS does something strange when output is sent to both +;;; CURRENT-OUTPUT-PORT and CURRENT-ERROR-PORT. +(case (software-type) ((vms) (set-current-error-port (current-output-port)))) + +;;; OPEN_READ, OPEN_WRITE, and OPEN_BOTH are used to request the proper +;;; mode to open files in. MS-DOS does carriage return - newline +;;; translation if not opened in `b' mode. + +(define open_read (case (software-type) + ((ms-dos windows atarist) 'rb) + (else 'r))) +(define open_write (case (software-type) + ((ms-dos windows) 'wbc) + ((atarist) 'wb) + (else 'w))) +(define open_both (case (software-type) + ((ms-dos windows) 'r+bc) + ((atarist) 'r+b) + (else 'r+))) +(define ((make-moder str) mode) + (if (symbol? mode) + (string->symbol (string-append (symbol->string mode) str)) + (string-append mode str))) +(define _ionbf (make-moder "0")) +(define _tracked (make-moder "?")) +(define _exclusive (make-moder "x")) + +(define could-not-open #f) + +(define (open-output-file str) + (or (open-file str open_write) + (and (procedure? could-not-open) (could-not-open) #f) + (error "OPEN-OUTPUT-FILE couldn't open file " str))) +(define (open-input-file str) + (or (open-file str open_read) + (and (procedure? could-not-open) (could-not-open) #f) + (error "OPEN-INPUT-FILE couldn't open file " str))) + +(define (string-index str chr) + (define len (string-length str)) + (do ((pos 0 (+ 1 pos))) + ((or (>= pos len) (char=? chr (string-ref str pos))) + (and (< pos len) pos)))) + +(if (not (defined? try-create-file)) +(define (try-create-file str modes . perms) + (if (symbol? modes) (set! modes (symbol->string modes))) + (let ((idx (string-index modes #\x))) + (cond ((slib:in-catalog? 'i/o-extensions) + (require 'i/o-extensions) + (apply try-create-file str modes perms)) + ((not idx) + (warn "not exclusive modes?" modes str) + (try-open-file str modes)) + (else (set! modes (string-append (substring modes 0 idx) + (substring modes (+ 1 idx) + (string-length modes)))) + (cond ((not (string-index modes #\w)) + (warn 'try-create-file "not writing?" modes str) + (try-open-file str modes)) + (else + (cond ((and (not (null? perms)) + (not (eqv? #o666 (car perms)))) + (warn "perms?" (car perms) str))) + (cond ((file-exists? str) #f) + (else (try-open-file str modes)))))))))) + +(if (not (defined? file-position)) +(define (file-position . args) #f)) +(if (not (defined? file-set-position)) +(define file-set-position file-position)) + +(define close-input-port close-port) +(define close-output-port close-port) + +(define (call-with-open-ports . ports) + (define proc (car ports)) + (cond ((procedure? proc) (set! ports (cdr ports))) + (else (set! ports (reverse ports)) + (set! proc (car ports)) + (set! ports (reverse (cdr ports))))) + (let ((ans (apply proc ports))) + (for-each close-port ports) + ans)) + +(define (call-with-input-file str proc) + (call-with-open-ports (open-input-file str) proc)) + +(define (call-with-output-file str proc) + (call-with-open-ports (open-output-file str) proc)) + +(define (with-input-from-port port thunk) + (dynamic-wind (lambda () (set! port (set-current-input-port port))) + thunk + (lambda () (set! port (set-current-input-port port))))) + +(define (with-output-to-port port thunk) + (dynamic-wind (lambda () (set! port (set-current-output-port port))) + thunk + (lambda () (set! port (set-current-output-port port))))) + +(define (with-error-to-port port thunk) + (dynamic-wind (lambda () (set! port (set-current-error-port port))) + thunk + (lambda () (set! port (set-current-error-port port))))) + +(define (with-input-from-file file thunk) + (let* ((nport (open-input-file file)) + (ans (with-input-from-port nport thunk))) + (close-port nport) + ans)) + +(define (with-output-to-file file thunk) + (let* ((nport (open-output-file file)) + (ans (with-output-to-port nport thunk))) + (close-port nport) + ans)) + +(define (with-error-to-file file thunk) + (let* ((nport (open-output-file file)) + (ans (with-error-to-port nport thunk))) + (close-port nport) + ans)) + +(define (call-with-outputs thunk proc) + (define stdout #f) + (define stderr #f) + (define status #f) + (set! stdout + (call-with-output-string + (lambda (stdout) + (set! stderr + (call-with-output-string + (lambda (stderr) + (call-with-current-continuation + (lambda (escape) + (dynamic-wind + (lambda () + (set! status #f) + (set! stdout (set-current-output-port stdout)) + (set! stderr (set-current-error-port stderr))) + (lambda () (set! status (list (thunk)))) + (lambda () + (set! stdout (set-current-output-port stdout)) + (set! stderr (set-current-error-port stderr)) + (if (not status) (escape #f)))))))))))) + (apply proc stdout stderr (or status '()))) + +(define browse-url + (case (software-type) + ((unix coherent plan9) + (lambda (url) + (define (try cmd end) (zero? (system (string-append cmd url end)))) + (or (try "netscape-remote -remote 'openURL(" ")'") + (try "netscape -remote 'openURL(" ")'") + (try "netscape '" "'&") + (try "netscape '" "'")))) + (else + (lambda (url) + (slib:warn 'define (software-type) 'case 'of 'browse-url 'in + *load-pathname*))))) + +(define (warn . args) + (define cep (current-error-port)) + (if (defined? print-call-stack) (print-call-stack cep)) + (perror "WARN") + (errno 0) + (display "WARN:" cep) + (for-each (lambda (x) (display #\space cep) (write x cep)) args) + (newline cep) + (force-output cep)) + +(define (error . args) + (define cep (current-error-port)) + (if (defined? print-call-stack) (print-call-stack cep)) + (perror "ERROR") + (errno 0) + (display "ERROR:" cep) + (for-each (lambda (x) (display #\space cep) (write x cep)) args) + (newline cep) + (force-output cep) + (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 #\space)) args) + (newline) + result) +(define (pprint . args) + (define result #f) + (for-each (lambda (x) (set! result x) (pretty-print x)) args) + result) +(define (pp . args) + (for-each pretty-print args) + (if #f #f)) + +(if (not (defined? file-exists?)) +(define (file-exists? str) + (let ((port (open-file str open_read))) + (errno 0) + (and port (close-port port) #t)))) +(define (file-readable? str) + (let ((port (open-file str open_read))) + (errno 0) + (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 +) + +(if (not (defined? ed)) +(define (ed . args) + (system (apply string-append + (or (getenv "EDITOR") "ed") + (map (lambda (s) (string-append " " s)) args))))) + +(if (not (defined? output-port-width)) +(define (output-port-width . arg) 80)) + +(if (not (defined? output-port-height)) +(define (output-port-height . arg) 24)) + +(if (not (defined? last-pair)) +(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l))) + +(define slib:error error) +(define slib:warn warn) +(define slib:tab #\tab) +(define slib:form-feed #\page) +(define slib:eval eval) + +(define (make-exchanger . pair) (lambda (rep) (swap-car! pair rep))) + +;;;; Load. +(define load:indent 0) +(define (load:pre op file) + (define cep (current-error-port)) + (cond ((> (verbose) 1) + (display + (string-append ";" (make-string load:indent #\space) + (symbol->string op) "ing " file) + cep) + (set! load:indent (modulo (+ 2 load:indent) 16)) + (newline cep))) + (force-output cep)) + +(define (load:post op filesuf) + (define cep (current-error-port)) + (errno 0) + (cond ((> (verbose) 1) + (set! load:indent (modulo (+ -2 load:indent) 16)) + (display (string-append ";" (make-string load:indent #\space) + "done " (symbol->string op) "ing " filesuf) + cep) + (newline cep) + (force-output cep)))) + +;;; Here for backward compatibility +(define scheme-file-suffix + (case (software-type) + ((NOSVE) (lambda () "_scm")) + (else (lambda () ".scm")))) + +(define (has-suffix? str suffix) + (let ((sufl (string-length suffix)) + (sl (string-length str))) + (and (> sl sufl) + (string=? (substring str (- sl sufl) sl) suffix)))) + +(define *load-reader* #f) +(define (scm:load file . libs) + (define filesuf file) + (define hss (has-suffix? file (scheme-file-suffix))) + (load:pre 'load file) + (or (and (defined? link:link) (not hss) + (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)) + (fs2 (file-readable? fs))) + (and fs2 (apply link:link fs libs) (set! filesuf fs) #t) + )))) + (and (null? libs) (try-load file *load-reader*)) + ;;HERE is where the suffix gets specified + (and (not hss) (errno 0) ; clean up error from TRY-LOAD above + (set! filesuf (string-append file (scheme-file-suffix))) + (try-load filesuf *load-reader*)) + (and (procedure? could-not-open) (could-not-open) #f) + (begin (set! load:indent 0) + (error "LOAD couldn't find file " file))) + (load:post 'load filesuf)) +(define load scm:load) +(define slib:load load) + +(define (scm:load-source file) + (define sfs (scheme-file-suffix)) + (define filesuf file) + (load:pre 'load file) + (or (and (or (try-load file *load-reader*) + ;;HERE is where the suffix gets specified + (and (not (has-suffix? file sfs)) + (begin (set! filesuf (string-append file sfs)) + (try-load filesuf *load-reader*))))) + (and (procedure? could-not-open) (could-not-open) #f) + (error "LOAD couldn't find file " file)) + (load:post 'load filesuf)) +(define slib:load-source scm:load-source) + +;;; This is the vicinity where this file resides. +(define implementation-vicinity #f) + +;;; (library-vicinity) should be defined to be the pathname of the +;;; directory where files of Scheme library functions reside. +(define library-vicinity #f) + +;;; (home-vicinity) should return the vicinity of the user's HOME +;;; directory, the directory which typically contains files which +;;; customize a computer environment for a user. +(define home-vicinity #f) + +(if (not (defined? getpw)) + (define read-line + (if (defined? read-line) + read-line + (lambda port + (let* ((chr (apply read-char port))) + (if (eof-object? chr) + chr + (do ((chr chr (apply read-char port)) + (clist '() (cons chr clist))) + ((or (eof-object? chr) (char=? #\newline chr)) + (list->string (reverse clist)))))))))) +(if (not (defined? getpw)) + (define string-index + (if (defined? string-index) + string-index + (lambda (str chr) + (define len (string-length str)) + (do ((pos 0 (+ 1 pos))) + ((or (>= pos len) (char=? chr (string-ref str pos))) + (and (< pos len) pos))))))) + +(define (login->home-directory login) + (cond ((defined? getpw) + (let ((pwvect (getpw login))) + (and pwvect (vector-ref pwvect 5)))) + ((not (file-exists? "/etc/passwd")) #f) + (else + (call-with-input-file "/etc/passwd" + (lambda (iprt) + (let tryline () + (define line (read-line iprt)) + (define (get-field) + (define idx (string-index line #\:)) + (and idx + (let ((fld (substring line 0 idx))) + (set! line (substring line (+ 1 idx) + (string-length line))) + fld))) + (cond ((eof-object? line) #f) + ((string-index line #\:) + => (lambda (idx) + (define name (substring line 0 idx)) + (cond ((equal? login name) + (do ((ans (get-field) (get-field)) + (cnt 4 (+ -1 cnt))) + ((or (negative? cnt) (not ans)) ans))) + (else (tryline)))))))))))) + +(define (getlogin) (or (getenv "USER") (getenv "LOGNAME"))) + +;;; If the environment variable SCHEME_LIBRARY_PATH is undefined, use +;;; (implementation-vicinity) as (library-vicinity). "require.scm", +;;; the first file loaded from (library-vicinity), can redirect it. +(define (set-vicinities! init-file) + (set! implementation-vicinity + (let ((vic (substring + init-file + 0 + (- (string-length init-file) + (string-length "Init.scm") + (string-length (scheme-implementation-version)))))) + (lambda () vic))) + (let ((library-path (getenv "SCHEME_LIBRARY_PATH"))) + (if library-path + (set! library-vicinity (lambda () library-path)) + (let ((filename (in-vicinity (implementation-vicinity) "require.scm"))) + (or (try-load filename) + (try-load (in-vicinity (implementation-vicinity) "requires.scm")) + (error "Can't load" filename)) + (if (not library-vicinity) (error "Can't find library-vicinity"))))) + (set! home-vicinity + (let ((home (getenv "HOME"))) + (and (not home) login->home-directory + (let ((login (getlogin))) + (and login (set! home (login->home-directory login))))) + (and home + (case (software-type) + ((unix coherent plan9 ms-dos) ;V7 unix has a / on HOME + (if (not + (eqv? #\/ (string-ref home (+ -1 (string-length home))))) + (set! home (string-append home "/")))))) + (lambda () home)))) +;;; SET-VICINITIES! is also called from BOOT-TAIL +(set-vicinities! *load-pathname*) + +;;;; Initialize SLIB +(load (in-vicinity (library-vicinity) "require")) + +;;; This enables line-numbering for SLIB loads. +(define *slib-load-reader* (and (defined? read-numbered) read-numbered)) + +;;; DO NOT MOVE! SLIB:LOAD-SOURCE and SLIB:LOAD must be defined after +;;; "require.scm" is loaded. +(define (slib:load-source file) + (fluid-let ((*load-reader* *slib-load-reader*)) + (scm:load-source file))) +(define (slib:load file . libs) + (fluid-let ((*load-reader* *slib-load-reader*)) + (apply scm:load file libs))) + +;;; Legacy grease +(if (not (defined? slib:in-catalog?)) + (define slib:in-catalog? require:feature->path)) + +;;; Dynamic link-loading +(cond ((or (defined? dyn:link) + (defined? vms:dynamic-link-call)) + (load (in-vicinity (implementation-vicinity) "Link")))) + +;;; Redefine to ease transition from *features* to slib:features. +(define (provide feature) + (cond ((not (memq feature slib:features)) + (set! slib:features (cons feature slib:features)) + (if (defined? *features*) (set! *features* slib:features))))) + +(cond ((defined? link:link) +(define (slib:load-compiled . args) + (cond ((symbol? (car args)) + (require (car args)) + (apply slib:load-compiled (cdr args))) + ((apply link:link args) + (if (defined? *features*) (set! slib:features *features*))) + (else (error "Couldn't link files " args)))) +(provide 'compiled))) + +;;; Complete the function set for feature STRING-CASE. +(cond + ((defined? string-upcase!) +(define (string-upcase str) (string-upcase! (string-copy str))) +(define (string-downcase str) (string-downcase! (string-copy str))) +(define (string-capitalize str) (string-capitalize! (string-copy str))) +(define string-ci->symbol + (let ((s2cis (if (equal? "x" (symbol->string 'x)) + string-downcase string-upcase))) + (lambda (str) (string->symbol (s2cis str))))) +(define symbol-append + (let ((s2cis (if (equal? "x" (symbol->string 'x)) + string-downcase string-upcase))) + (lambda args + (string->symbol + (apply string-append + (map + (lambda (obj) + (cond ((char? obj) (string obj)) + ((string? obj) (s2cis obj)) + ((number? obj) (s2cis (number->string obj))) + ((symbol? obj) (symbol->string obj)) + ((not obj) "") + (else (error 'wrong-type-to 'symbol-append obj)))) + args)))))) +(define (StudlyCapsExpand nstr . delimitr) + (set! delimitr + (cond ((null? delimitr) "-") + ((char? (car delimitr)) (string (car delimitr))) + (else (car delimitr)))) + (do ((idx (+ -1 (string-length nstr)) (+ -1 idx))) + ((> 1 idx) nstr) + (cond ((and (> idx 1) + (char-upper-case? (string-ref nstr (+ -1 idx))) + (char-lower-case? (string-ref nstr idx))) + (set! nstr + (string-append (substring nstr 0 (+ -1 idx)) + delimitr + (substring nstr (+ -1 idx) + (string-length nstr))))) + ((and (char-lower-case? (string-ref nstr (+ -1 idx))) + (char-upper-case? (string-ref nstr idx))) + (set! nstr + (string-append (substring nstr 0 idx) + delimitr + (substring nstr idx + (string-length nstr)))))))) +(provide 'string-case))) + +;;;; Bit order and lamination + +;;(define (logical:ones deg) (lognot (ash -1 deg))) + +;;; New with SRFI-60 +(define (rotate-bit-field n count start end) + (define width (- end start)) + (set! count (modulo count width)) + (let ((mask (lognot (ash -1 width)))) + (define azn (logand mask (arithmetic-shift n (- start)))) + (logior (arithmetic-shift + (logior (logand mask (arithmetic-shift azn count)) + (arithmetic-shift azn (- count width))) + start) + (logand (lognot (ash mask start)) n)))) +;;; Legacy +;;(define (logical:rotate k count len) (rotate-bit-field k count 0 len)) + +(define (log2-binary-factors n) + (+ -1 (integer-length (logand n (- n))))) + +(define (bit-reverse k n) + (do ((m (if (negative? n) (lognot n) n) (arithmetic-shift m -1)) + (k (+ -1 k) (+ -1 k)) + (rvs 0 (logior (arithmetic-shift rvs 1) (logand 1 m)))) + ((negative? k) (if (negative? n) (lognot rvs) rvs)))) +(define (reverse-bit-field n start end) + (define width (- end start)) + (let ((mask (lognot (ash -1 width)))) + (define zn (logand mask (arithmetic-shift n (- start)))) + (logior (arithmetic-shift (bit-reverse width zn) start) + (logand (lognot (ash mask start)) n)))) + +(define (integer->list k . len) + (if (negative? k) (slib:error 'integer->list 'negative? k)) + (if (null? len) + (do ((k k (arithmetic-shift k -1)) + (lst '() (cons (odd? k) lst))) + ((<= k 0) lst)) + (do ((idx (+ -1 (car len)) (+ -1 idx)) + (k k (arithmetic-shift k -1)) + (lst '() (cons (odd? k) lst))) + ((negative? idx) lst)))) + +(define (list->integer bools) + (do ((bs bools (cdr bs)) + (acc 0 (+ acc acc (if (car bs) 1 0)))) + ((null? bs) acc))) +(define (booleans->integer . bools) + (list->integer bools)) + +;;;; SRFI-60 aliases +(define arithmetic-shift ash) +(define bitwise-ior logior) +(define bitwise-xor logxor) +(define bitwise-and logand) +(define bitwise-not lognot) +;;(define bit-count logcount) ;Aliases bit-vector function +;;BITWISE-BIT-COUNT returns negative count for negative inputs. +(define bit-set? logbit?) +(define any-bits-set? logtest) +(define first-set-bit log2-binary-factors) +(define bitwise-merge bitwise-if) + +(define @case-aux + (let ((integer-jump-table 1) + (char-jump-table 2)) + (lambda (keys actions else-action) + (let ((n (length keys))) + (define (every-key pred) + (let test ((keys keys)) + (or (null? keys) + (and (pred (car keys)) (test (cdr keys)))))) + (define (jump-table keys) + (let ((minkey (apply min keys)) + (maxkey (apply max keys))) + (and (< (- maxkey minkey) (* 4 n)) + (let ((actv (make-vector + (+ 2 (- maxkey minkey)) else-action))) + (for-each + (lambda (key action) + (vector-set! actv (+ 1 (- key minkey)) action)) + keys actions) + (list integer-jump-table minkey actv))))) + (cond ((< n 5) #f) + ((every-key integer?) + (jump-table keys)) + ((every-key char?) + (let* ((int-keys (map char->integer keys))) + (cond ((jump-table int-keys) => + (lambda (x) + (cons char-jump-table + (cons (integer->char (cadr x)) + (cddr x))))) + (else #f))))))))) + +;;;defmacro from dorai@cs.rice.edu (heavily hacked by jaffer): +(define *defmacros* '()) +(define (defmacro? m) (and (assq m *defmacros*) #t)) + +(define defmacro:transformer + (lambda (f) + (procedure->memoizing-macro + (lambda (exp env) + (@copy-tree (apply f (remove-line-numbers! (cdr exp)))))))) + +(define defmacro:get-destructuring-bind-pairs + (lambda (s e) + (let loop ((s s) (e e) (r '())) + (cond ((pair? s) + (loop (car s) `(car ,e) + (loop (cdr s) `(cdr ,e) r))) + ((null? s) r) + ((symbol? s) (cons `(,s ,e) r)) + (else (error 'destructuring-bind "illegal syntax")))))) + +(defsyntax destructuring-bind + (let ((destructuring-bind-transformer + (lambda (s x . ff) + (let ((tmp (gentemp))) + `(let ((,tmp ,x)) + (let ,(defmacro:get-destructuring-bind-pairs s tmp) + ,@ff)))))) + (set! *defmacros* + (acons 'destructuring-bind + destructuring-bind-transformer *defmacros*)) + (defmacro:transformer destructuring-bind-transformer))) + +(defsyntax defmacro:simple-defmacro + (let ((defmacro-transformer + (lambda (name parms . body) + `(defsyntax ,name + (let ((transformer (lambda ,parms ,@body))) + (set! *defmacros* (acons ',name transformer *defmacros*)) + (defmacro:transformer transformer)))))) + (set! *defmacros* (acons 'defmacro defmacro-transformer *defmacros*)) + (defmacro:transformer defmacro-transformer))) + +(defmacro:simple-defmacro defmacro (name . body) + (define (expn name pattern body) + (let ((args (gentemp))) + `(defmacro:simple-defmacro ,name ,args + (destructuring-bind ,pattern ,args ,@body)))) + (if (pair? name) + (expn (car name) (cdr name) body) + (expn name (car body) (cdr body)))) + +(define (macroexpand-1 e) + (if (pair? e) (let ((a (car e))) + (cond ((symbol? a) (set! a (assq a *defmacros*)) + (if a (apply (cdr a) (cdr e)) e)) + (else e))) + e)) + +(define (macroexpand e) + (if (pair? e) (let ((a (car e))) + (cond ((symbol? a) + (set! a (assq a *defmacros*)) + (if a (macroexpand (apply (cdr a) (cdr e))) e)) + (else e))) + e)) + +(define gentemp + (let ((*gensym-counter* -1)) + (lambda () + (set! *gensym-counter* (+ *gensym-counter* 1)) + (string->symbol + (string-append "scm:G" (number->string *gensym-counter*)))))) + +(define defmacro:eval slib:eval) +(define defmacro:load load) +;; slib:eval-load definition moved to "slib/require.scm" + +;;;; Autoloads for SLIB procedures. + +(define (trace-all . args) (require 'debug) (apply trace-all args)) +(define (track-all . args) (require 'debug) (apply track-all args)) +(define (stack-all . args) (require 'debug) (apply stack-all args)) +(define (break-all . args) (require 'debug) (apply break-all args)) +(define (pretty-print . args) (require 'pretty-print) (apply pretty-print args)) + +;;; (require 'transcript) would get us SLIB transcript -- not what we want. +(define (transcript-on arg) + (load (in-vicinity (implementation-vicinity) + (string-append "Tscript" (scheme-file-suffix)))) + (transcript-on arg)) +(define (transcript-off) + (error "No transcript active")) + +;;;; Macros. + +;;; Trace gets re-defmacroed when tracef autoloads. +(defmacro trace x (cond ((null? x) '()) (else (require 'trace) `(trace ,@x)))) +(defmacro track x (cond ((null? x) '()) (else (require 'track) `(track ,@x)))) +(defmacro stack x (cond ((null? x) '()) (else (require 'stack) `(stack ,@x)))) +(defmacro break x (cond ((null? x) '()) (else (require 'break) `(break ,@x)))) + +(defmacro defvar (var val) + `(if (not (defined? ,var)) (define ,var ,val))) +(defmacro defconst (name value) + (cond ((list? name) `(defconst ,(car name) (lambda ,(cdr name) ,value))) + (else (cond ((not (slib:eval `(defined? ,name)))) + ((and (symbol? name) (equal? (slib:eval value) + (slib:eval name)))) + (else (error 'trying-to-defconst name + 'to-different-value value))) + `(define ,name ,value)))) +(defmacro qase (key . clauses) + `(case ,key + ,@(map (lambda (clause) + (if (list? (car clause)) + (cons (apply + append + (map (lambda (elt) + (case elt + ((unquote) '(unquote)) + ((unquote-splicing) '(unquote-splicing)) + (else + (eval (list 'quasiquote (list elt)))))) + (car clause))) + (cdr clause)) + clause)) + clauses))) +(defmacro (casev . args) `(qase ,@args)) + +(defmacro fluid-let (clauses . body) + (let ((ids (map car clauses)) + (temp (gentemp)) + (swap (gentemp))) + `(let* ((,temp (list ,@(map cadr clauses))) + (,swap (lambda () (set! ,temp (set! ,ids ,temp))))) + (dynamic-wind + ,swap + (lambda () ,@body) + ,swap)))) + +(define (scm:print-binding sexp frame) + (cond ((not (null? (cdr sexp))) + (display "In") + (for-each (lambda (exp) (display #\space) (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 (car vals)))) + (newline)) + (write (car vars)) (display " = ") (write (car vals)) (display "; "))) + +(define print-args + (procedure->memoizing-macro + (lambda (sexp env) + (define (fix-list frm) + (cond ((pair? frm) (cons (car frm) (fix-list (cdr frm)))) + ((null? frm) '()) + ((symbol? frm) (list frm)) + (else '()))) + (define frm (car env)) + `(scm:print-binding + ',sexp + ,(cond ((symbol? frm) `(list ',frm ,frm)) + ((list? frm) `(list ',frm ,@frm)) + ((pair? frm) + (let ((jlp (fix-list frm))) + `(list ',(if (symbol? (cdr (last-pair frm))) frm jlp) + ,@jlp)))))))) + +(cond + ((defined? stack-trace) + +;;#+breakpoint-error;; remove line to enable breakpointing on calls to ERROR +(define error + (letrec ((oerror error) + (nerror + (lambda args + (dynamic-wind + (lambda () (set! error oerror)) + (lambda () + (define cep (current-error-port)) + (if (defined? print-call-stack) + (print-call-stack cep)) + (perror "ERROR") + (errno 0) + (display "ERROR: " cep) + (if (not (null? args)) + (begin (display (car args) cep) + (for-each (lambda (x) (display #\space cep) (write x cep)) + (cdr args)))) + (newline cep) + (cond ((stack-trace) (newline cep))) + (display " * Breakpoint established: (continue ) to return." cep) + (newline cep) (force-output cep) + (require 'debug) (apply breakpoint args)) + (lambda () (set! error nerror)))))) + nerror)) + +(define (user-interrupt . args) + (define cep (current-error-port)) + (newline cep) + (if (defined? print-call-stack) + (print-call-stack cep)) + (display "ERROR: user interrupt" cep) + (newline cep) + (cond ((stack-trace) (newline cep))) + (display " * Breakpoint established: (continue ) to return." cep) + (newline cep) (force-output cep) + (require 'debug) (apply breakpoint args)) + )) + +(cond ((and (inexact? (string->number "0.0")) (not (defined? exp))) + (or (and (defined? usr:lib) + (usr:lib "m") + (load (in-vicinity (implementation-vicinity) "Transcen") + (usr:lib "m"))) + (load (in-vicinity (implementation-vicinity) "Transcen")))) + (else + (define (infinite? z) #f) + (define finite? number?) + (define inexact->exact identity) + (define exact->inexact identity) + (define round->exact identity) + (define floor->exact identity) + (define ceiling->exact identity) + (define truncate->exact identity) + (define expt integer-expt))) + +(define (numerator q) + (if (not (rational? q)) (error 'numerator q)) + (do ((num q (* 2 num))) + ((integer? num) num))) + +(define (denominator q) + (if (not (rational? q)) (error 'denominator q)) + (do ((num q (* 2 num)) + (den (- q q -1) (* 2 den))) + ((integer? num) den))) + +;;;; http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/math/isqrt/isqrt.txt +;;; Akira Kurihara +;;; School of Mathematics +;;; Japan Women's University +;@ +(define integer-sqrt + (let ((table '#(0 + 1 1 1 + 2 2 2 2 2 + 3 3 3 3 3 3 3 + 4 4 4 4 4 4 4 4 4)) + (square (lambda (x) (* x x)))) + (lambda (n) + (define (isqrt n) + (if (> n 24) + (let* ((len/4 (quotient (- (integer-length n) 1) 4)) + (top (isqrt (ash n (* -2 len/4)))) + (init (ash top len/4)) + (q (quotient n init)) + (iter (quotient (+ init q) 2))) + (cond ((odd? q) iter) + ((< (remainder n init) (square (- iter init))) (- iter 1)) + (else iter))) + (vector-ref table n))) + (if (and (exact? n) (integer? n) (not (negative? n))) + (isqrt n) + (slib:error 'integer-sqrt n))))) + +(if (defined? array?) +(begin + +(define (array-null? array) + (zero? (apply * (map (lambda (bnd) (- 1 (apply - bnd))) + (array-shape array))))) +(define (create-array prot . args) + (if (array-null? prot) + (dimensions->uniform-array args (array-prototype prot)) + (dimensions->uniform-array args (array-prototype prot) + (apply array-ref prot + (map car (array-shape prot)))))) +(define make-array create-array) +(define (list->array rank proto lst) + (list->uniform-array rank (array-prototype proto) lst)) +(define (vector->array vect prototype . dimensions) + (define vdx (vector-length vect)) + (if (not (eqv? vdx (apply * dimensions))) + (slib:error 'vector->array vdx '<> (cons '* dimensions))) + (let ((ra (apply make-array prototype dimensions))) + (define (v2ra dims idxs) + (cond ((null? dims) + (set! vdx (+ -1 vdx)) + (apply array-set! ra (vector-ref vect vdx) (reverse idxs))) + (else + (do ((idx (+ -1 (car dims)) (+ -1 idx))) + ((negative? idx) vect) + (v2ra (cdr dims) (cons idx idxs)))))) + (v2ra dimensions '()) + ra)) +(define (array->vector ra) + (define dims (array-dimensions ra)) + (let* ((vdx (apply * dims)) + (vect (make-vector vdx))) + (define (ra2v dims idxs) + (if (null? dims) + (let ((val (apply array-ref ra (reverse idxs)))) + (set! vdx (+ -1 vdx)) + (vector-set! vect vdx val) + vect) + (do ((idx (+ -1 (car dims)) (+ -1 idx))) + ((negative? idx) vect) + (ra2v (cdr dims) (cons idx idxs))))) + (ra2v dims '()))) +(define (make-uniform-wrapper prot) + (if (string? prot) (set! prot (string->number prot))) + (if prot + (lambda opt (if (null? opt) + (list->uniform-array 1 prot '()) + (list->uniform-array 0 prot (car opt)))) + vector)) +(define Ac64 (make-uniform-wrapper "+64i")) +(define Ac32 (make-uniform-wrapper "+32i")) +(define Ar64 (make-uniform-wrapper "64.")) +(define Ar32 (make-uniform-wrapper "32.")) +(define As64 (make-uniform-wrapper -64)) +(define As32 (make-uniform-wrapper -32)) +(define As16 (make-uniform-wrapper -16)) +(define As8 (make-uniform-wrapper -8)) +(define Au64 (make-uniform-wrapper 64)) +(define Au32 (make-uniform-wrapper 32)) +(define Au16 (make-uniform-wrapper 16)) +(define Au8 (make-uniform-wrapper 8)) +(define At1 (make-uniform-wrapper #t)) + +;;; New SRFI-58 names +;; flonums +(define A:floC128b Ac64) +(define A:floC64b Ac64) +(define A:floC32b Ac32) +(define A:floC16b Ac32) +(define A:floR128b Ar64) +(define A:floR64b Ar64) +(define A:floR32b Ar32) +(define A:floR16b Ar32) +;; decimal flonums +(define A:floQ128d Ar64) +(define A:floQ64d Ar64) +(define A:floQ32d Ar32) +;; fixnums +(define A:fixZ64b As64) +(define A:fixZ32b As32) +(define A:fixZ16b As16) +(define A:fixZ8b As8) +(define A:fixN64b Au64) +(define A:fixN32b Au32) +(define A:fixN16b Au16) +(define A:fixN8b Au8) +(define A:bool At1) + +(define (array-shape a) + (let ((dims (array-dimensions a))) + (if (pair? dims) + (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind)) + dims) + dims))) +(define array=? equal?) +(provide 'srfi-47) +(provide 'srfi-58) +(provide 'srfi-63) +)) + +(if (defined? bigdbl:powers-of-5) + (do ((i 0 (+ i 1)) + (acc 1 (* acc 5))) + ((>= i (vector-length bigdbl:powers-of-5))) + (vector-set! bigdbl:powers-of-5 i acc))) + +(define (alarm-interrupt) (alarm 0)) +(if (defined? setitimer) + (begin + (define profile-alarm #f) + (define (profile-alarm-interrupt) (profile-alarm 0)) + (define virtual-alarm #f) + (define (virtual-alarm-interrupt) (virtual-alarm 0)) + (define milli-alarm #f) + (let ((make-alarm + (lambda (sym) + (and (setitimer sym 0 0) ;DJGPP supports only REAL and PROFILE + (lambda (value . interval) + (cadr + (setitimer sym value + (if (pair? interval) (car interval) 0)))))))) + (set! profile-alarm (make-alarm 'profile)) + (set! virtual-alarm (make-alarm 'virtual)) + (set! milli-alarm (make-alarm 'real))))) + +;;;; Initialize statically linked add-ons +(cond ((defined? scm_init_extensions) + (scm_init_extensions) + (if (defined? *features*) (set! slib:features *features*)) + (set! scm_init_extensions #f))) + +;;; Use *argv* instead of (program-arguments), to allow option +;;; processing to be done on it. "ScmInit.scm" must +;;; (set! *argv* (program-arguments)) +;;; if it wants to alter the arguments which BOOT-TAIL processes. +(define *argv* #f) + +(if (not (defined? *syntax-rules*)) + (define *syntax-rules* #f)) +(if (not (defined? *interactive*)) + (define *interactive* #f)) + +(define (boot-tail dumped?) + (cond ((not *argv*) + (set! *argv* (program-arguments)) + (cond (dumped? + (set-vicinities! dumped?) + (verbose (if (and (isatty? (current-input-port)) + (isatty? (current-output-port))) + (if (<= (length *argv*) 1) 2 1) + 0)))) + (cond ((provided? 'getopt) + (set! *optind* 1) + (set! *optarg* #f))))) + +;;; This loads the user's initialization file, or files named in +;;; program arguments. + (or *script* + (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)) + *load-reader*) + (errno 0)) + + ;; Include line numbers in loaded code. + (if (defined? read-numbered) + (set! *load-reader* read-numbered)) + + (cond + ((and (> (length *argv*) 1) (char=? #\- (string-ref (cadr *argv*) 0))) + (require 'getopt) +;;; (else +;;; (define *optind* 1) +;;; (define getopt:opt #f) +;;; (define (getopt optstring) #f)) + + (let* ((simple-opts "muvqibs") + (arg-opts '("a kbytes" "-version" "-help" + "-no-symbol-case-fold" + "no-init-file" "-no-init-file" "p number" + "h feature" "r feature" "d filename" + "f filename" "l filename" + "c string" "e string" "o filename")) + (opts (apply string-append ":" simple-opts + (map (lambda (o) + (string-append (string (string-ref o 0)) ":")) + arg-opts))) + (didsomething #f) + (moreopts #t) + (exe-name (symbol->string (scheme-implementation-type))) + (up-name (apply string (map char-upcase (string->list exe-name))))) + + (define (do-thunk thunk) + (if *interactive* + (thunk) + (let ((complete #f)) + (dynamic-wind + (lambda () #f) + (lambda () + (thunk) + (set! complete #t)) + (lambda () + (if (not complete) (close-port (current-input-port)))))))) + + (define (do-string-arg) + (require 'string-port) + (do-thunk + (lambda () + ((if *syntax-rules* macro:eval eval) + (call-with-input-string + (string-append "(begin " *optarg* ")") + read)))) + (set! didsomething #t)) + + (define (do-load file) + (do-thunk + (lambda () + (cond (*syntax-rules* (require 'macro) (macro:load file)) + (else (load file))))) + (set! didsomething #t)) + + (define (usage preopt opt postopt success?) + (define cep (if success? (current-output-port) (current-error-port))) + (define indent (make-string 6 #\space)) + (define i 3) + (cond ((char? opt) (set! opt (string opt))) + ;;((symbol? opt) (set! opt (symbol->string opt))) + ) + (display (string-append preopt opt postopt) cep) + (newline cep) + (display (string-append "Usage: " + exe-name + " [-a kbytes] [-" simple-opts "]") cep) + (for-each + (lambda (o) + (display (string-append " [-" o "]") cep) + (set! i (+ 1 i)) + (cond ((zero? (modulo i 5)) (newline cep) (display indent cep)))) + (cdr arg-opts)) + (display " [-- | -s | -] [file] [args...]" cep) (newline cep) + (if success? (display success? cep) (quit #f))) + + ;; -a int => ignore (handled by scm_init_from_argv) + ;; -c str => (eval str) + ;; -e str => (eval str) + ;; -d str => (require 'databases) (open-database str) + ;; -f str => (load str) + ;; -l str => (load str) + ;; -r sym => (require sym) + ;; -h sym => (provide sym) + ;; -o str => (dump str) + ;; -p int => (verbose int) + ;; -m => (set! *syntax-rules* #t) + ;; -u => (set! *syntax-rules* #f) + ;; -v => (verbose 3) + ;; -q => (verbose 0) + ;; -i => (set! *interactive* #t) + ;; -b => (set! *interactive* #f) + ;; -s => set argv, don't execute first one + ;; --no-symbol-case-fold => symbols preserve character case + ;; -no-init-file => don't load init file + ;; --no-init-file => don't load init file + ;; --help => print and exit + ;; --version => print and exit + ;; -- => last option + + (let loop ((option (getopt-- opts))) + (case option + ((#\a) + (cond ((> *optind* 3) + (usage "scm: option `-" getopt:opt "' must be first" #f)) + ((or (not (exact? (string->number *optarg*))) + (not (<= 1 (string->number *optarg*) 10000))) + ;; This size limit should match scm.c ^^ + (usage "scm: option `-" getopt:opt + (string-append *optarg* "' unreasonable") #f)))) + ((#\e #\c) (do-string-arg)) ;sh-like + ((#\f #\l) (do-load *optarg*)) ;(set-car! *argv* *optarg*) + ((#\d) (require 'databases) + (open-database *optarg*)) + ((#\o) (require 'dump) + (if (< *optind* (length *argv*)) + (dump *optarg* #t) + (dump *optarg*))) + ((#\r) (do-thunk (lambda () + (if (and (= 1 (string-length *optarg*)) + (char-numeric? (string-ref *optarg* 0))) + (case (string-ref *optarg* 0) + ((#\2) (require 'r2rs)) + ((#\3) (require 'r3rs)) + ((#\4) (require 'r4rs)) + ((#\5) (require 'r5rs) + (set! *syntax-rules* #t)) + (else (require (string->symbol *optarg*)))) + (require (string->symbol *optarg*)))))) + ((#\h) (do-thunk (lambda () (provide (string->symbol *optarg*))))) + ((#\p) (verbose (string->number *optarg*))) + ((#\q) (verbose 0)) + ((#\v) (verbose 3)) + ((#\i) (set! *interactive* #t) ;sh-like + (verbose (max 2 (verbose)))) + ((#\b) (set! didsomething #t) + (set! *interactive* #f)) + ((#\s) (set! moreopts #f) ;sh-like + (set! didsomething #t) + (set! *interactive* #t)) + ((#\m) (set! *syntax-rules* #t)) + ((#\u) (set! *syntax-rules* #f)) + ((#\n) (if (not (string=? "o-init-file" *optarg*)) + (usage "scm: unrecognized option `-n" *optarg* "'" #f))) + ((#\:) (usage "scm: option `-" getopt:opt "' requires an argument" #f)) + ((#\?) (usage "scm: unrecognized option `-" getopt:opt "'" #f)) + ((#f) (set! moreopts #f) ;sh-like + (cond ((and (< *optind* (length *argv*)) + (string=? "-" (list-ref *argv* *optind*))) + (set! *optind* (+ 1 *optind*))))) + (else + (or (cond ((not (string? option)) #f) + ((string-ci=? "no-init-file" option)) + ((string-ci=? "no-symbol-case-fold" option)) + ((string-ci=? "version" option) + (display + (string-append exe-name " " + (scheme-implementation-version) + " +Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +" + up-name + " may be distributed under the terms of" + " the GNU General Public Licence; +certain other uses are permitted as well." + " For details, see the file `COPYING', +which is included in the " + up-name " distribution. +There is no warranty, to the extent permitted by law. +" + )) + (cond ((execpath) => + (lambda (path) + (display " This executable was loaded from ") + (write path) + (newline)))) + (quit #t)) + ((string-ci=? "help" option) + (usage "This is " + up-name + ", a Scheme interpreter." + (let ((sihp (scheme-implementation-home-page))) + (if sihp + (string-append "Latest info: " sihp " +") + ""))) + (quit #t)) + (else #f)) + (usage "scm: unknown option `--" option "'" #f)))) + + (cond ((and moreopts (< *optind* (length *argv*))) + (loop (getopt-- opts))) + ((< *optind* (length *argv*)) ;No more opts + (set! *argv* (list-tail *argv* *optind*)) + (set! *optind* 1) + (cond ((and (not didsomething) *script*) + (do-load *script*) + (set! *optind* (+ 1 *optind*)))) + (cond ((and (> (verbose) 2) + (not (= (+ -1 *optind*) (length *argv*)))) + (display "scm: extra command arguments unused:" + (current-error-port)) + (for-each (lambda (x) (display (string-append " " x) + (current-error-port))) + (list-tail *argv* (+ -1 *optind*))) + (newline (current-error-port))))) + ((and (not didsomething) (= *optind* (length *argv*))) + (set! *interactive* #t))))) + + (cond ((not *interactive*) (quit)) + ((and *syntax-rules* (not (provided? 'macro))) + (require 'repl) + (require 'macro) + (let* ((oquit quit)) + (set! quit (lambda () (repl:quit))) + (set! exit quit) + (repl:top-level macro:eval) + (oquit)))) + ;;otherwise, fall into natural SCM repl. + ) + (else (errno 0) + (set! *interactive* #t) + (for-each load (cdr (program-arguments)))))) diff --git a/Link.scm b/Link.scm old mode 100644 new mode 100755 index b5394e9..03ac108 --- a/Link.scm +++ b/Link.scm @@ -53,6 +53,7 @@ (set! file (string-append "./" file))) (with-load-pathname file (lambda () + (load:pre 'link file) (set! linkobj (or (provided? 'sun-dl) (dyn:link file))) (and linkobj (for-each (lambda (lib) @@ -61,7 +62,9 @@ libs)) (if (provided? 'sun-dl) (set! linkobj (dyn:link file))) (cond ((not linkobj) #f) - ((dyn:call (file->init_name name) linkobj) #t) + ((dyn:call (file->init_name name) linkobj) + (load:post 'link file) + #t) (else (dyn:unlink linkobj) #f)))))))) ((defined? vms:dynamic-link-call) @@ -76,7 +79,10 @@ (set! fil (substring file (+ i 1) (string-length file)))) (else (loop (- i 1))))) (with-load-pathname file - (lambda () (vms:dynamic-link-call dir fil (file->init_name fil))))))) + (lambda () + (load:pre 'link file) + (vms:dynamic-link-call dir fil (file->init_name fil)) + (load:post 'link file)))))) (cond ((provided? 'sun-dl) diff --git a/Macexp.scm b/Macexp.scm old mode 100644 new mode 100755 index bb0e877..9b217a3 --- a/Macexp.scm +++ b/Macexp.scm @@ -182,7 +182,8 @@ (genname name) name) (genname (identifier->symbol name))))) - identity)) + (lambda (name env) + name))) ;; Local bindings -> (identifier pretty-name (usage-context ...)) ;; This will change. @@ -492,13 +493,15 @@ (cond ((identifier? form) (let ((expanded (@macroexpand1 form env))) - (cond ((eq? form expanded) form) + (cond ((eq? expanded form) + form) ((not expanded) (let* ((b (lookup form env)) (name (binding->name b))) (binding-add-context! b context) name)) - (else expanded)))) + (else + (expand expanded env context))))) ((number? form) form) ((char? form) form) ((boolean? form) form) @@ -541,6 +544,7 @@ (memq 'verbose opt))) ;; Debugging fodder. +#+(or) (begin (define (read* filename) (call-with-input-file filename diff --git a/Macro.scm b/Macro.scm old mode 100644 new mode 100755 diff --git a/Makefile b/Makefile old mode 100644 new mode 100755 index 1477c86..67487a9 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ # "Makefile" for scm Scheme Interpreter -# Copyright (C) 1990-2008 Free Software Foundation, Inc. +# Copyright (C) 1990-2008, 2010 Free Software Foundation, Inc. # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU Lesser General Public License as @@ -17,56 +17,69 @@ # Author: Aubrey Jaffer +# These are normally set in "config.status"; defaults are here so that +# "make" won't complain about target redefinitions. +snapdir=$(HOME)/pub/ +infodir=$(HOME)/info/ +htmldir=$(HOME)/public_html/ + SHELL = /bin/sh -#CC = gcc -#CFLAGS = -g -#LIBS = -#LD = $(CC) -g -LD = $(CC) +INSTALL = install +INSTALL_PROGRAM = ${INSTALL} +INSTALL_DATA = ${INSTALL} -m 644 +INSTALL_INFO = ginstall-info + SCMLIT = ./scmlit SCMEXE = ./scm -#SHOBJS = *.sl -SHOBJS = *.so - -#BUILD = ./build -hsystem -p svr4-gcc-sun-ld BUILD = ./build -hsystem -# Workaround for unexec on Fedora Core 1 GNU/Linux i386 +TEXI2HTML = /usr/local/bin/texi2html -split -verbose +TEXI2PDF = texi2pdf +VIEWPDF = evince +MAKEDEV = $(MAKE) -f $(HOME)/makefile.dev +CHPAT = $(HOME)/bin/chpat +RSYNC = rsync -av +Uploadee = csail +SCMOPTS = udscm[45].opt scm[45].opt + +# OS-X 10.6, but harmless for other OS. +SETARCH = env DYLD_NO_PIE=1 +# Fedora-Core-1 #SETARCH = setarch i386 -# http://jamesthornton.com/writing/emacs-compile.html -# [For FC3] combreloc has become the default for recent GNU ld, which -# breaks the unexec/undump on all versions of both Emacs and -# XEmacs... -# -# Add the following to udscm5.opt: -#--linker-options="-z nocombreloc" - -# http://www.opensubscriber.com/message/emacs-devel@gnu.org/1007118.html -# Kernels later than 2.6.11 must do (as root) before dumping: -#echo 0 > /proc/sys/kernel/randomize_va_space +#CC = gcc +#CFLAGS = -g +#LIBS = +#LD = $(CC) -g +LD = $(CC) -#for RPMs +# VERSION is defined in "patchlvl.h" +# RELEASE is for RPMs RELEASE = 1 -intro: +intro: config.status @echo - @echo "This is the scm-$(VERSION) distribution. Read \"scm.info\"" + @echo "This is the scm $(VERSION) distribution. Read \"scm.info\"" @echo "to learn how to build and install SCM. Or browse" - @echo " http://swiss.csail.mit.edu/~jaffer/SCM" + @echo " http://people.csail.mit.edu/jaffer/SCM" @echo - $(MAKE) scm -srcdir.mk: Makefile - echo "CPROTO=`type cproto | sed 's%.* %%'`" > srcdir.mk - echo "srcdir=`pwd`/" >> srcdir.mk -#srcdir=$(HOME)/scm/ -#srcdir=/usr/local/src/scm/ -include srcdir.mk +# ./configure --distdir=${HOME}/dist/ --snapdir=${HOME}/pub/ --htmldir=${HOME}/public_html/ --pdfdir=${HOME}/public_html/ + +config.status: + ./configure +Makefile: config.status +include config.status + +libscmdir = $(libdir)scm/ +windistdir = /c/Voluntocracy/dist/ +rpm_prefix = $(HOME)/rpmbuild/ +prevdocsdir = prevdocs/ + +# This should be moved to "config.status" +x11incdir=/usr/include/ # directory where COPYING and InitXXX.scm reside. -#IMPLPATH = /usr/local/src/scm/ -#this one is good for bootstrapping #IMPLPATH = `pwd`/ IMPLPATH=$(srcdir) include patchlvl.h @@ -81,8 +94,9 @@ cfiles = scmmain.c 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 continue.c \ findexec.c script.c debug.c byte.c bytenumb.c differ.c -ufiles = pre-crt0.c ecrt0.c gmalloc.c unexec.c unexelf.c unexhp9k800.c \ - unexsunos4.c unexalpha.c unexsgi.c +ufiles = pre-crt0.c ecrt0.c gmalloc.c unexec.c unexelf.c unexhp9k800.c \ + unexsunos4.c unexalpha.c unexsgi.c unexmacosx.c \ + macosx-config.h lastfile.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 \ @@ -97,16 +111,244 @@ turfiles = turtlegr.c turtle grtest.scm xafiles = xatoms.scm x11.scm xevent.scm keysymdef.scm xfiles = x.c x.h xgen.scm xevent.h inc2scm $(xafiles) -all: require.scm - $(MAKE) mydlls - $(MAKE) dscm5 - $(MAKE) differ.so - $(MAKE) db.so - if [ -d /usr/X11R6/lib ]; then $(MAKE) x.so; fi +tfiles = r4rstest.scm example.scm pi.scm pi.c split.scm bench.scm \ + syntest2.scm syntest1.scm +texifiles = scm.texi fdl.texi indexes.texi platform.txi features.txi +dfiles = ANNOUNCE README COPYING COPYING.LESSER scm.1 scm.doc QUICKREF \ + $(texifiles) scm.info Xlibscm.info Xlibscm.texi \ + hobbit.info hobbit.texi +mfiles = configure Makefile build.scm build build.bat requires.scm \ + .gdbinit mkimpcat.scm disarm.scm scm.spec scm.nsi +sfiles = setjump.mar setjump.s ugsetjump.s continue-ia64.S \ + get-contoffset-ia64.c +wbfiles = wbtab.scm rwb-isam.scm +catfiles = implcat slibcat +afiles = $(dfiles) ChangeLog $(cfiles) $(hfiles) $(ifiles) $(tfiles) \ + $(mfiles) $(hobfiles) $(sfiles) $(ufiles) $(xfiles) \ + version.txi # $(wbfiles) $(turfiles) + +lsdfiles = $(ifiles) $(hobfiles) COPYING COPYING.LESSER r4rstest.scm \ + build.scm mkimpcat.scm patchlvl.h +#*.sl + +ctagfiles = $(hfiles) $(cfiles) $(xfiles) +tagfiles = $(ctagfiles) $(ifiles) $(sfiles) $(mfiles) \ + Xlibscm.texi hobbit.texi build hobbit.scm +# # $(ufiles) ChangeLog $(dfiles) + +installdirs: + mkdir -p $(DESTDIR)$(includedir) + mkdir -p $(DESTDIR)$(bindir) + mkdir -p $(DESTDIR)$(libdir) + mkdir -p $(DESTDIR)$(libscmdir) + mkdir -p $(DESTDIR)$(mandir)man1/ + mkdir -p $(DESTDIR)$(infodir) + mkdir -p $(DESTDIR)$(pdfdir) + mkdir -p $(DESTDIR)$(dvidir) + +platform.txi: build.scm + $(MAKE) $(SCMLIT) + $(SCMLIT) -r database-browse -l build.scm \ + -e "(browse build 'platform)" > platform.txi +features.txi: build build.scm + $(MAKE) $(SCMLIT) + $(SCMLIT) -l build -e"(make-features-txi)" + +scm.dvi: $(texifiles) Makefile + $(TEXI2DVI) -b -c $< +Xlibscm.dvi: Xlibscm.texi version.txi + $(TEXI2DVI) -b -c $< +hobbit.dvi: hobbit.texi version.txi + $(TEXI2DVI) -b -c $< +dvi: scm.dvi Xlibscm.dvi hobbit.dvi +xdvi: scm.dvi + xdvi $< +Xdvi: Xlibscm.dvi + xdvi $< +hobdvi: hobbit.dvi + xdvi $< +install-dvi: scm.dvi Xlibscm.dvi hobbit.dvi + $(INSTALL_DATA) $< Xlibscm.dvi hobbit.dvi $(DESTDIR)$(dvidir) + +scm.pdf: $(texifiles) + $(TEXI2PDF) -b -c $< +Xlibscm.pdf: Xlibscm.texi version.txi + $(TEXI2PDF) -b -c $< +hobbit.pdf: hobbit.texi version.txi + $(TEXI2PDF) -b -c $< +pdf: scm.pdf Xlibscm.pdf hobbit.pdf +xpdf: scm.pdf + $(VIEWPDF) $< +Xpdf: Xlibscm.pdf + $(VIEWPDF) $< +hobpdf: hobbit.pdf + $(VIEWPDF) $< +install-pdf: scm.pdf Xlibscm.pdf hobbit.pdf + $(INSTALL_DATA) $< Xlibscm.pdf hobbit.pdf $(DESTDIR)$(pdfdir) + +scm_toc.html: $(texifiles) + $(TEXI2HTML) $< +$(DESTDIR)$(htmldir)scm_toc.html: scm_toc.html installdirs + -rm -f scm_stoc.html + if [ -f $(prevdocsdir)scm_toc.html ]; \ + then hitch $(prevdocsdir)scm_\*.html scm_\*.html \ + $(DESTDIR)$(htmldir); \ + else $(INSTALL_DATA) scm_*.html $(DESTDIR)$(htmldir); fi + +Xlibscm_toc.html: Xlibscm.texi version.txi + $(TEXI2HTML) $< +$(DESTDIR)$(htmldir)Xlibscm_toc.html: Xlibscm_toc.html installdirs + -rm -f Xlibscm_stoc.html + chpat '' '\ +\ +' Xlibscm_*.html + $(INSTALL_DATA) Xlibscm_*.html $(DESTDIR)$(htmldir) + +hobbit_toc.html: hobbit.texi version.txi + $(TEXI2HTML) $< +$(DESTDIR)$(htmldir)hobbit_toc.html: hobbit_toc.html installdirs + -rm -f hobbit_stoc.html + chpat '' '\ +\ +' hobbit_*.html + $(INSTALL_DATA) hobbit_*.html $(DESTDIR)$(htmldir) + +# html: scm_toc.html Xlibscm_toc.html hobbit_toc.html + +# install-html: $(DESTDIR)$(htmldir)scm_toc.html \ +# $(DESTDIR)$(htmldir)Xlibscm_toc.html \ +# $(DESTDIR)$(htmldir)hobbit_toc.html + +html/scm: $(texifiles) + mkdir -p html + rm -rf html/scm + $(MAKEINFO) --html $< -o html/scm + if type icoize>/dev/null; then icoize ../Logo/SCM.ico html/scm/*.html; fi +$(DESTDIR)$(htmldir)scm: html/scm + -rm -rf $(DESTDIR)$(htmldir)scm + mkdir -p $(DESTDIR)$(htmldir)scm + $(INSTALL_DATA) html/scm/*.html $(DESTDIR)$(htmldir)scm + +html/Xlibscm: Xlibscm.texi version.txi + mkdir -p html + rm -rf html/Xlibscm + $(MAKEINFO) --html $< -o html/Xlibscm + if type icoize>/dev/null; then icoize ../Logo/SCM.ico html/Xlibscm/*.html; fi +$(DESTDIR)$(htmldir)Xlibscm: html/Xlibscm + -rm -rf $(DESTDIR)$(htmldir)Xlibscm + mkdir -p $(DESTDIR)$(htmldir)Xlibscm + $(INSTALL_DATA) html/Xlibscm/*.html $(DESTDIR)$(htmldir)Xlibscm + +html/hobbit: hobbit.texi version.txi + mkdir -p html + rm -rf html/hobbit + $(MAKEINFO) --html $< -o html/hobbit + if type icoize>/dev/null; then icoize ../Logo/SCM.ico html/hobbit/*.html; fi +$(DESTDIR)$(htmldir)hobbit: html/hobbit + -rm -rf $(DESTDIR)$(htmldir)hobbit + mkdir -p $(DESTDIR)$(htmldir)hobbit + $(INSTALL_DATA) html/hobbit/*.html $(DESTDIR)$(htmldir)hobbit + +html: html/scm html/Xlibscm html/hobbit + +install-html: $(DESTDIR)$(htmldir)scm \ + $(DESTDIR)$(htmldir)Xlibscm \ + $(DESTDIR)$(htmldir)hobbit + + +scm-$(VERSION).info: $(texifiles) + $(MAKEINFO) $< --no-split -o $@ +scm.info: scm-$(VERSION).info + if [ -f $(prevdocsdir)scm.info ]; \ + then infobar $(prevdocsdir)scm.info $< $@; \ + else cp $< $@; fi +$(DESTDIR)$(infodir)scm.info: scm.info installdirs + $(INSTALL_DATA) -p $< $@ + -rm $(DESTDIR)$(infodir)scm.info.gz + $(POST_INSTALL) # Post-install commands follow. + -$(INSTALL_INFO) $@ $(DESTDIR)$(infodir)dir + +Xlibscm.info: Xlibscm.texi version.txi + $(MAKEINFO) $< --no-split -o $@ +$(DESTDIR)$(infodir)Xlibscm.info: Xlibscm.info installdirs + $(INSTALL_DATA) $< $@ + -rm $(DESTDIR)$(infodir)Xlibscm.info*.gz + $(POST_INSTALL) # Post-install commands follow. + -$(INSTALL_INFO) $@ $(DESTDIR)$(infodir)dir + +hobbit.info: hobbit.texi version.txi + $(MAKEINFO) $< --no-split -o hobbit.info +$(DESTDIR)$(infodir)hobbit.info: hobbit.info installdirs + $(INSTALL_DATA) $< $@ + -rm $(DESTDIR)$(infodir)hobbit.info*.gz + $(POST_INSTALL) # Post-install commands follow. + -$(INSTALL_INFO) $@ $(DESTDIR)$(infodir)dir + +install-info: $(DESTDIR)$(infodir)scm.info \ + $(DESTDIR)$(infodir)Xlibscm.info \ + $(DESTDIR)$(infodir)hobbit.info +info: install-info + +$(DESTDIR)$(infodir)scm.info.gz: $(DESTDIR)$(infodir)scm.info + gzip -f $< +$(DESTDIR)$(infodir)Xlibscm.info.gz: $(DESTDIR)$(infodir)Xlibscm.info + gzip -f $< +$(DESTDIR)$(infodir)hobbit.info.gz: $(DESTDIR)$(infodir)hobbit.info + gzip -f $< +install-infoz: $(DESTDIR)$(infodir)scm.info.gz \ + $(DESTDIR)$(infodir)Xlibscm.info.gz \ + $(DESTDIR)$(infodir)hobbit.info.gz +infoz: install-infoz + +scm.doc: scm.1 + nroff -man $< | ul -tunknown >$@ + +# configure.usage: configure +# $(srcdir)configure --help >$@ 2>&1 + +README: build build.scm scm.info + $(SCMEXE) -l build -e"(make-readme)" + +docs: README scm.doc install-html install-pdf install-dvi install-infoz + +prevdocs: $(prevdocsdir)scm_toc.html $(prevdocsdir)scm.info +$(prevdocsdir)scm_toc.html: +$(prevdocsdir)scm.info: + cd $(prevdocsdir); unzip -a $(distdir)scm*.zip + rm $(prevdocsdir)scm/scm.info + cd $(prevdocsdir)scm; $(MAKE) scm.info; $(MAKE) scm_toc.html + cd $(prevdocsdir); mv -f scm/scm.info scm/*.html ./ + rm -rf $(prevdocsdir)scm + -rm -f scm-$(VERSION).info + +alld5: udscm5.opt scmlit + if grep -ie dynamic-linking udscm5.opt>/dev/null && ! $(MAKE) dlls; \ + then \ + if sed "s/dynamic-linking//g" < udscm5.opt > tmp.opt; then \ + mv -f tmp.opt udscm5.opt; fi; \ + if sed "s/dynamic-linking//g" < scm5.opt > tmp.opt; then \ + mv -f tmp.opt scm5.opt; fi \ + fi + if ! $(MAKE) dscm5; then $(MAKE) scm5; fi + +all5: scm5.opt scmlit + if grep -ie dynamic-linking scm5.opt>/dev/null && ! $(MAKE) dlls; \ + then \ + if sed "s/dynamic-linking//g" < scm5.opt > tmp.opt; then \ + mv -f tmp.opt scm5.opt; fi \ + fi + $(MAKE) scm5; fi + +all: + if [ -f udscm5.opt -o ! -f scm5.opt ]; then $(MAKE) alld5; \ + else $(MAKE) all5; fi + +# $(MAKE) wbscm.so + require.scm: cp -p requires.scm require.scm -# SCMLIT -- try making this first! +# SCMLIT -- Make this first! scmlit: $(ofiles) scmmain.o require.scm Makefile $(LD) -o scmlit $(ofiles) scmmain.o $(LIBS) $(MAKE) checklit @@ -152,7 +394,7 @@ scm4.opt: scm4: $(cfiles) $(hfiles) build.scm build scm4.opt $(BUILD) -f scm4.opt -o scm -s $(IMPLPATH) -rm $(ofiles) scmmain.o - -$(MAKE) check + $(MAKE) check # R5RS interpreter (not dumpable) scm5.opt: @@ -163,17 +405,22 @@ scm5.opt: scm5: $(cfiles) $(hfiles) build.scm build scm5.opt $(BUILD) -f scm5.opt -o scm -s $(IMPLPATH) -rm $(ofiles) scmmain.o - -$(MAKE) check - -$(MAKE) checkmacro + $(MAKE) checkmacro + +# http://www.opensubscriber.com/message/emacs-devel@gnu.org/1007118.html +# Kernels later than 2.6.11 must do (as root) before dumping: +#echo 0 > /proc/sys/kernel/randomize_va_space # dumpable R4RS interpreter udscm4.opt: - echo "-F cautious bignums arrays inexact" >> udscm4.opt - echo "-F engineering-notation dump dynamic-linking" >> udscm4.opt + $(MAKE) scm4.opt + cat scm4.opt > udscm4.opt + echo "-F dump" >> udscm4.opt # if type gcc; then echo "--compiler-options=\"-fno-guess-branch-probability\"" >> udscm4.opt; fi udscm4: $(cfiles) $(hfiles) build.scm build udscm4.opt $(BUILD) -f udscm4.opt -o udscm4 -s $(IMPLPATH) -rm $(ofiles) scmmain.o + strip udscm4 dscm4: udscm4 $(ifiles) require.scm if [ -f /proc/sys/kernel/randomize_va_space -a\ "`cat /proc/sys/kernel/randomize_va_space`" != "0" ]; then {\ @@ -190,9 +437,9 @@ dscm4: udscm4 $(ifiles) require.scm # dumpable R5RS interpreter udscm5.opt: - $(MAKE) udscm4.opt - cat udscm4.opt >> udscm5.opt - echo "-F macro" >> udscm5.opt + $(MAKE) scm5.opt + cat scm5.opt > udscm5.opt + echo "-F dump" >> udscm5.opt udscm5: $(cfiles) $(ufiles) $(hfiles) build.scm build udscm5.opt $(BUILD) -f udscm5.opt -o udscm5 -s $(IMPLPATH) -rm $(ofiles) scmmain.o @@ -210,7 +457,6 @@ dscm5: udscm5 $(ifiles) require.scm cat randomize_va_space.tmp > /proc/sys/kernel/randomize_va_space;\ rm randomize_va_space.tmp;\ } fi - $(MAKE) check $(MAKE) checkmacro # R5RS interpreter for debugging with GDB. @@ -242,7 +488,6 @@ libscm.opt: echo "-F cautious bignums arrays inexact" >> libscm.opt echo "-F engineering-notation" >> libscm.opt echo "-F dynamic-linking" >> libscm.opt -mylib: libscm.a libscm.a: libscm.opt scm.h scmfig.h $(BUILD) -t lib -f libscm.opt libtest: libscm.a libtest.c @@ -253,68 +498,69 @@ libtest: libscm.a libtest.c dlls.opt: echo "--compiler-options=-Wall" >> dlls.opt echo "--linker-options=-Wall" >> dlls.opt -mydlls: dlls.opt bytenumb.so - $(BUILD) -t dll -f dlls.opt -c ramap.c - $(BUILD) -t dll -f dlls.opt -c record.c - $(BUILD) -t dll -f dlls.opt -c gsubr.c - $(BUILD) -t dll -f dlls.opt -c byte.c - $(BUILD) -t dll -f dlls.opt -c sc2.c - $(BUILD) -t dll -f dlls.opt -c ioext.c - $(BUILD) -t dll -f dlls.opt -c posix.c - $(BUILD) -t dll -f dlls.opt -c socket.c - $(BUILD) -t dll -f dlls.opt -c unix.c - $(BUILD) -t dll -f dlls.opt -F curses - $(BUILD) -t dll -f dlls.opt -c rgx.c - if [ -f /usr/lib/libreadline.so ]; \ - then $(BUILD) -t dll -f dlls.opt -F edit-line; fi +dlls: dlls.opt + $(BUILD) -t dll -f dlls.opt -F rev2-procedures #-c sc2.c + $(BUILD) -t dll -f dlls.opt -F byte #-c byte.c + $(BUILD) -t dll -f dlls.opt -F array-for-each #-c ramap.c + $(BUILD) -t dll -f dlls.opt -F differ #-c differ.c + $(BUILD) -t dll -f dlls.opt -F generalized-c-arguments #-c gsubr.c + $(BUILD) -t dll -f dlls.opt -F record #-c record.c + -$(BUILD) -t dll -f dlls.opt -F byte-number inexact bignums + -$(BUILD) -t dll -f dlls.opt -F i/o-extensions #-c ioext.c + -$(BUILD) -t dll -f dlls.opt -F posix #-c posix.c + -$(BUILD) -t dll -f dlls.opt -F socket #-c socket.c + -$(BUILD) -t dll -f dlls.opt -F unix #-c unix.c + -$(BUILD) -t dll -f dlls.opt -F regex #-c rgx.c + -$(BUILD) -t dll -f dlls.opt -F curses #-c crs.c + -$(BUILD) -t dll -f dlls.opt -F edit-line + -$(MAKE) x.so +# -$(MAKE) turtlegr.so +mydlls: dlls # legacy rwb-isam.scm wbtab.scm: ../wb/rwb-isam.scm ../wb/wbtab.scm - cp ../wb/rwb-isam.scm ../wb/wbtab.scm ./ -db.so: dlls.opt rwb-isam.scm wbtab.scm scm.h scmfig.h - if [ -f ../wb/blink.c ]; then \ - $(BUILD) -t dll -f dlls.opt -F wb; fi - -bytenumb.so: bytenumb.c scm.h scmfig.h - $(BUILD) -t dll -f dlls.opt -F byte-number inexact bignums -differ.so: differ.c scm.h scmfig.h - $(BUILD) -t dll -f dlls.opt -F differ -myturtle: dlls.opt scm.h scmfig.h + -cp -f ../wb/rwb-isam.scm ../wb/wbtab.scm ./ +wbscm.so: dlls.opt build.scm scm.h scmfig.h ../wb/c/*.c $(wbfiles) + $(MAKE) $(SCMLIT) + $(BUILD) -t dll -f dlls.opt -F wb + $(SCMLIT) -lmkimpcat.scm + +turtlegr.so: dlls.opt scm.h scmfig.h $(BUILD) -t dll -f dlls.opt -F turtlegr x.so: x.c x.h xevent.h dlls.opt scm.h scmfig.h $(BUILD) -t dll -f dlls.opt -F x - # Generate x11 include and Scheme files -incdir=/usr/include/ -x11.scm: inc2scm +x11.scm: inc2scm Makefile rm -f x11.scm - $(SCMLIT) -l inc2scm x11.scm x: $(DESTDIR)$(incdir) X11/X.h X11/cursorfont.h X11/Xlib.h \ - X11/Xutil.h -keysymdef.scm: inc2scm + $(SCMLIT) -l inc2scm x11.scm x: $(x11incdir) \ + X11/X.h X11/cursorfont.h X11/Xlib.h X11/Xutil.h +keysymdef.scm: inc2scm Makefile rm -f keysymdef.scm - $(SCMLIT) -l inc2scm keysymdef.scm x: $(DESTDIR)$(incdir) X11/keysym.h X11/keysymdef.h + $(SCMLIT) -l inc2scm keysymdef.scm x: $(x11incdir) \ + X11/keysym.h X11/keysymdef.h xevent.h xevent.scm xatoms.scm: xgen.scm Makefile - $(SCMLIT) -l xgen.scm $(DESTDIR)$(incdir)X11/Xlib.h -x.h: x.c xevent.h - if [ -x "$(CPROTO)" ]; then $(CPROTO) x.c > x.h; fi + $(SCMLIT) -l xgen.scm $(x11incdir)X11/Xlib.h +# x.h: x.c xevent.h +# if [ -x "$(CPROTO)" ]; then $(CPROTO) x.c > x.h; fi -# Check SCM; SCMLIT function. -checklit: +# **************** Tests and Performance **************** +# Check SCMLIT; SCM +checklit: require.scm $(SCMLIT) -fr4rstest.scm -e'(test-sc4)(test-delay)(gc)' \ - -e '(or (null? errs) (quit 1))' -Checklit: + -e '(or (null? errs) (quit 1))' < /dev/null +Checklit: require.scm $(SCMLIT) --no-symbol-case-fold -fr4rstest.scm -e'(test-sc4)(test-delay)(gc)' \ - -e '(or (null? errs) (quit 1))' -check: r4rstest.scm + -e '(or (null? errs) (quit 1))' < /dev/null +check: r4rstest.scm require.scm $(SCMEXE) -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)(gc)' \ - -e '(or (null? errs) (quit 1))' -Check: r4rstest.scm + -e '(or (null? errs) (quit 1))' < /dev/null +Check: r4rstest.scm require.scm $(SCMEXE) --no-symbol-case-fold -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)(gc)' \ - -e '(or (null? errs) (quit 1))' + -e '(or (null? errs) (quit 1))' < /dev/null checkmacro: syntest1.scm syntest2.scm r4rstest.scm $(SCMEXE) -rmacro -fsyntest1.scm -fsyntest2.scm \ -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)' -fsyntest1 \ - -e '(or (null? errs) (quit 1))' + -e '(or (null? errs) (quit 1))' < /dev/null # Measuare running speed of SCM; SCMLIT. Results are appended to file # "BenchLog" @@ -352,194 +598,68 @@ report: $(SCMLIT) -e"(slib:report #t)" $(SCMEXE) -e"(slib:report #t)" -implcat: $(SHOBJS) mkimpcat.scm - $(SCMLIT) -lmkimpcat.scm - -htmldir=../public_html/ -dvi: scm.dvi Xlibscm.dvi hobbit.dvi -scm.dvi: $(texifiles) Makefile - texi2dvi -b -c scm.texi -Xlibscm.dvi: version.txi Xlibscm.texi Makefile - texi2dvi -b -c Xlibscm.texi -hobbit.dvi: version.txi hobbit.texi Makefile - texi2dvi -b -c hobbit.texi -xdvi: scm.dvi - xdvi scm.dvi -Xdvi: Xlibscm.dvi - xdvi Xlibscm.dvi -hobdvi: hobbit.dvi - xdvi hobbit.dvi - -pdf: $(htmldir)scm.pdf $(htmldir)Xlibscm.pdf $(htmldir)hobbit.pdf -$(htmldir)scm.pdf: $(texifiles) Makefile - texi2pdf -b -c scm.texi - mv scm.pdf $(htmldir) -$(htmldir)Xlibscm.pdf: version.txi Xlibscm.texi Makefile - texi2pdf -b -c Xlibscm.texi - mv Xlibscm.pdf $(htmldir) -$(htmldir)hobbit.pdf: version.txi hobbit.texi Makefile - texi2pdf -b -c hobbit.texi - mv hobbit.pdf $(htmldir) -xpdf: $(htmldir)scm.pdf - xpdf $(htmldir)scm.pdf -Xpdf: $(htmldir)Xlibscm.pdf - xpdf $(htmldir)Xlibscm.pdf -hobpdf: $(htmldir)hobbit.pdf - xpdf $(htmldir)hobbit.pdf - -PREVDOCS = prevdocs/ -html: $(htmldir)scm_toc.html $(htmldir)Xlibscm_toc.html $(htmldir)hobbit_toc.html - -TEXI2HTML = /usr/local/bin/texi2html -split -verbose - -$(htmldir)scm_toc.html: Makefile $(texifiles) - ${TEXI2HTML} scm.texi - -rm -f scm_stoc.html - if [ -f $(PREVDOCS)scm_toc.html ]; \ - then hitch $(PREVDOCS)scm_\*.html scm_\*.html $(htmldir); \ - else cp scm_*.html $(htmldir); fi -$(htmldir)Xlibscm_toc.html: Makefile version.txi Xlibscm.texi - ${TEXI2HTML} Xlibscm.texi - -rm -f Xlibscm_stoc.html - chpat '' '\ -\ -' Xlibscm_*.html - cp Xlibscm_*.html $(htmldir) -$(htmldir)hobbit_toc.html: Makefile version.txi hobbit.texi - ${TEXI2HTML} hobbit.texi - -rm -f hobbit_stoc.html - chpat '' '\ -\ -' hobbit_*.html - cp hobbit_*.html $(htmldir) - -prevdocs: $(PREVDOCS)scm_toc.html $(PREVDOCS)scm.info -$(PREVDOCS)scm_toc.html: -$(PREVDOCS)scm.info: Makefile - cd $(PREVDOCS); unzip -a $(dest)scm*.zip - rm $(PREVDOCS)scm/scm.info - cd $(PREVDOCS)scm; make scm.info; make scm_toc.html - cd $(PREVDOCS); mv -f scm/scm.info scm/*.html ./ - rm -rf $(PREVDOCS)scm - -rm -f scm-$(VERSION).info - ################ INSTALL DEFINITIONS ################ -rpm_prefix=$(HOME)/rpmbuild/ - -prefix = /usr/local/ -exec_prefix = $(prefix) -# directory where `make install' will put executable. -bindir = $(exec_prefix)bin/ -libdir = $(exec_prefix)lib/ -libscmdir = $(libdir)scm/ -# directory where `make install' will put manual page. -man1dir = $(prefix)man/man1/ -infodir = $(prefix)info/ -includedir = $(prefix)include/ - -README: build build.scm scm.info - $(SCMEXE) -l build -e"(make-readme)" - -platform.txi: build.scm - $(SCMLIT) -r database-browse -l build.scm -e "(browse build 'platform)" \ - > platform.txi -features.txi: build build.scm - $(SCMLIT) -l build -e"(make-features-txi)" -scm.info: $(texifiles) - makeinfo scm.texi --no-split -o scm.info - mv scm.info scm-$(VERSION).info - if [ -f $(PREVDOCS)scm.info ]; \ - then infobar $(PREVDOCS)scm.info scm-$(VERSION).info scm.info; \ - else cp scm-$(VERSION).info scm.info; fi -$(DESTDIR)$(infodir)scm.info: scm.info - mkdir -p $(DESTDIR)$(infodir) - cp -p scm.info $(DESTDIR)$(infodir)scm.info - -install-info $(DESTDIR)$(infodir)scm.info $(DESTDIR)$(infodir)dir - -rm $(DESTDIR)$(infodir)scm.info.gz - -Xlibscm.info: version.txi Xlibscm.texi - makeinfo Xlibscm.texi --no-split -o Xlibscm.info -$(DESTDIR)$(infodir)Xlibscm.info: Xlibscm.info - mkdir -p $(DESTDIR)$(infodir) - cp Xlibscm.info $(DESTDIR)$(infodir)Xlibscm.info - -install-info $(DESTDIR)$(infodir)Xlibscm.info $(DESTDIR)$(infodir)dir - -rm $(DESTDIR)$(infodir)Xlibscm.info*.gz - -hobbit.info: version.txi hobbit.texi - makeinfo hobbit.texi --no-split -o hobbit.info -$(DESTDIR)$(infodir)hobbit.info: hobbit.info - mkdir -p $(DESTDIR)$(infodir) - cp hobbit.info $(DESTDIR)$(infodir)hobbit.info - -install-info $(DESTDIR)$(infodir)hobbit.info $(DESTDIR)$(infodir)dir - -rm $(DESTDIR)$(infodir)hobbit.info*.gz - -info: installinfo -installinfo: $(DESTDIR)$(infodir)scm.info $(DESTDIR)$(infodir)Xlibscm.info $(DESTDIR)$(infodir)hobbit.info - -infoz: installinfoz -installinfoz: $(DESTDIR)$(infodir)scm.info.gz $(DESTDIR)$(infodir)Xlibscm.info.gz $(DESTDIR)$(infodir)hobbit.info.gz -$(DESTDIR)$(infodir)scm.info.gz: $(DESTDIR)$(infodir)scm.info - gzip -f $(DESTDIR)$(infodir)scm.info -$(DESTDIR)$(infodir)Xlibscm.info.gz: $(DESTDIR)$(infodir)Xlibscm.info - gzip -f $(DESTDIR)$(infodir)Xlibscm.info -$(DESTDIR)$(infodir)hobbit.info.gz: $(DESTDIR)$(infodir)hobbit.info - gzip -f $(DESTDIR)$(infodir)hobbit.info - -lsdfiles = $(ifiles) $(hobfiles) COPYING COPYING.LESSER r4rstest.scm \ - build build.scm mkimpcat.scm $(SHOBJS) patchlvl.h \ - Iedline.scm $(xafiles) db.so wbtab.scm rwb-isam.scm - -install: scm.1 - mkdir -p $(DESTDIR)$(bindir) - mkdir -p $(DESTDIR)$(man1dir) - -cp scm scmlit $(DESTDIR)$(bindir) - -strip $(DESTDIR)$(bindir)scmlit - -cp scm.1 $(DESTDIR)$(man1dir) - mkdir -p $(DESTDIR)$(libscmdir) +install-man: scm.1 installdirs + -$(INSTALL_DATA) $< $(DESTDIR)$(mandir)man1/ + +install-lib: $(lsdfiles) installdirs + $(INSTALL_DATA) $(lsdfiles) $(DESTDIR)$(libscmdir) + $(INSTALL_PROGRAM) build $(DESTDIR)$(libscmdir) + if [ -f x.so ]; \ + then $(INSTALL_DATA) $(xafiles) $(DESTDIR)$(libscmdir); fi + if [ -f byte.so ]; \ + then $(INSTALL_DATA) *.so $(DESTDIR)$(libscmdir); fi + if [ -f wbscm.so ]; \ + then $(INSTALL_DATA) $(wbfiles) $(DESTDIR)$(libscmdir); fi test -f $(DESTDIR)$(libscmdir)require.scm || \ - cp requires.scm $(DESTDIR)$(libscmdir)require.scm - -cp $(lsdfiles) $(DESTDIR)$(libscmdir) + $(INSTALL_DATA) requires.scm $(DESTDIR)$(libscmdir)require.scm + if [ -f libscm.a ]; \ + then $(INSTALL_DATA) libscm.a $(DESTDIR)$(libdir)libscm.a; fi -installlib: - mkdir -p $(DESTDIR)$(includedir) - cp scm.h scmfig.h scmflags.h $(DESTDIR)$(includedir) - mkdir -p $(DESTDIR)$(libdir) - cp libscm.a $(DESTDIR)$(libdir)libscm.a +install: install-man install-lib install-infoz installdirs + $(INSTALL_PROGRAM) scm scmlit $(DESTDIR)$(bindir) + -strip $(DESTDIR)$(bindir)scmlit + $(INSTALL_DATA) scm.h scmfig.h scmflags.h $(DESTDIR)$(includedir) + $(DESTDIR)$(bindir)scm -br new-catalog uninstall: + $(PRE_UNINSTALL) # Pre-uninstall commands follow. + -$(INSTALL_INFO) --delete $(DESTDIR)$(infodir)scm.info $(DESTDIR)$(infodir)dir + -$(INSTALL_INFO) --delete $(DESTDIR)$(infodir)Xlibscm.info $(DESTDIR)$(infodir)dir + -$(INSTALL_INFO) --delete $(DESTDIR)$(infodir)hobbit.info $(DESTDIR)$(infodir)dir + $(NORMAL_UNINSTALL) # Normal commands follow. -rm $(DESTDIR)$(bindir)scm $(DESTDIR)$(bindir)scmlit - -rm $(DESTDIR)$(man1dir)scm.1 - -rm $(DESTDIR)$(includedir)scm.h $(DESTDIR)$(includedir)scmfig.h $(DESTDIR)$(includedir)scmflags.h + -rm $(DESTDIR)$(mandir)man1/scm.1 + -rm $(DESTDIR)$(includedir)scm.h \ + $(DESTDIR)$(includedir)scmfig.h \ + $(DESTDIR)$(includedir)scmflags.h -rm $(DESTDIR)$(libdir)libscm.a - -(cd $(DESTDIR)$(libscmdir); rm $(lsdfiles) require.scm) - -uninstallinfo: - -rm $(DESTDIR)$(infodir)scm.info.gz $(DESTDIR)$(infodir)Xlibscm.info.gz\ + -(cd $(DESTDIR)$(libscmdir); \ + rm $(lsdfiles) build $(xafiles) *.so require.scm \ + $(wbfiles) $(catfiles)) + -rm $(DESTDIR)$(infodir)scm.info.gz \ + $(DESTDIR)$(infodir)Xlibscm.info.gz \ $(DESTDIR)$(infodir)hobbit.info.gz + $(POST_UNINSTALL) # Post-uninstall commands follow. + -rmdir $(DESTDIR)$(libscmdir) -scm.doc: scm.1 - nroff -man $< | ul -tunknown >$@ - -docs: $(DESTDIR)$(infodir)scm.info.gz $(htmldir)scm_toc.html scm.doc \ - scm.dvi Xlibscm.dvi hobbit.dvi \ - $(htmldir)scm.pdf $(htmldir)Xlibscm.pdf $(htmldir)hobbit.pdf - xdvi -s 4 scm.dvi +################ WINDOWS INSTALLER DEFINITIONS ################ winscm5.opt: echo "-F arrays array-for-each byte i/o-extensions" >> winscm5.opt echo "-F bignums inexact engineering-notation" >> winscm5.opt echo "-F cautious rev2-procedures macro" >> winscm5.opt - echo "-F wb" >> winscm5.opt -gw32scmwb.sh: winscm5.opt build.scm Makefile version.txi scmlit + echo "-F wb-no-threads" >> winscm5.opt +gw32scmwb.sh: scmlit winscm5.opt build.scm Makefile version.txi ./build -p gnu-win32 -f winscm5.opt -w gw32scmwb.sh scm.exe: gw32scmwb.sh ./gw32scmwb.sh hobbit.html: hobbit.texi - makeinfo --html --no-split --no-warn hobbit.texi + $(MAKEINFO) --html --no-split hobbit.texi scm.html: $(texifiles) - makeinfo --html --no-split --no-warn --force scm.texi + $(MAKEINFO) --html --no-split scm.texi ## to build a windows installer ## make sure makeinfo and NSIS are available on the commandline @@ -549,117 +669,98 @@ w32install: scm.exe hobbit.html scm.html #### Stuff for maintaining SCM below #### ver = $(VERSION) -version.txi: patchlvl.h - echo @set SCMVERSION $(ver) > version.txi - echo @set SCMDATE `date +"%B %Y"` >> version.txi - -RM_R = rm -rf - -confiles = scmconfig.h.in mkinstalldirs acconfig-1.5.h install-sh \ - configure configure.in Makefile.in COPYING COPYING.LESSER \ - README.unix - -tfiles = r4rstest.scm example.scm pi.scm pi.c split.scm bench.scm \ - syntest2.scm syntest1.scm -texifiles = version.txi scm.texi fdl.texi indexes.texi platform.txi features.txi -dfiles = ANNOUNCE README COPYING COPYING.LESSER scm.1 scm.doc QUICKREF \ - $(texifiles) scm.info Xlibscm.info Xlibscm.texi \ - hobbit.info hobbit.texi ChangeLog -mfiles = Makefile build.scm build build.bat requires.scm \ - .gdbinit mkimpcat.scm disarm.scm scm.spec scm.nsi -sfiles = setjump.mar setjump.s ugsetjump.s continue-ia64.S \ - get-contoffset-ia64.c -wbfiles = wbtab.scm rwb-isam.scm -afiles = $(dfiles) $(cfiles) $(hfiles) $(ifiles) $(tfiles) $(mfiles) \ - $(hobfiles) $(sfiles) $(ufiles) $(xfiles) $(turfiles) $(wbfiles) - -makedev = make -f $(HOME)/makefile.dev -CHPAT=$(HOME)/bin/chpat -RSYNC=rsync -bav -UPLOADEE=swissnet_upload -dest = $(HOME)/dist/ -DOSCM = /c/Voluntocracy/dist/ temp/scm: $(afiles) - -$(RM_R) temp + -rm -rf temp mkdir -p temp/scm ln $(afiles) temp/scm release: dist pdf # rpm cvs tag -F scm-$(VERSION) - cp ANNOUNCE $(htmldir)SCM_ANNOUNCE.txt - $(RSYNC) $(htmldir)SCM.html $(htmldir)SCM_ANNOUNCE.txt $(UPLOADEE):public_html/ - $(RSYNC) $(dest)README $(dest)scm-$(VERSION).zip \ - $(dest)scm-$(VERSION)-$(RELEASE).src.rpm $(dest)scm-$(VERSION)-$(RELEASE).i386.rpm \ - $(htmldir)hobbit.pdf $(htmldir)Xlibscm.pdf $(UPLOADEE):dist/ -# upload $(dest)README $(dest)scm-$(VERSION).zip ftp.gnu.org:gnu/jacal/ - -upzip: $(HOME)/pub/scm.zip - $(RSYNC) $(HOME)/pub/scm.zip $(UPLOADEE):pub/ + $(INSTALL_DATA) ANNOUNCE $(htmldir)SCM_ANNOUNCE.txt + $(RSYNC) $(htmldir)SCM.html $(htmldir)SCM_ANNOUNCE.txt \ + $(htmldir)hobbit.pdf $(htmldir)Xlibscm.pdf \ + $(Uploadee):public_html/ + $(RSYNC) $(distdir)README $(distdir)scm-$(VERSION).zip \ + $(distdir)scm-$(VERSION)-$(RELEASE).*.rpm $(Uploadee):dist/ +# upload $(distdir)README $(distdir)scm-$(VERSION).zip ftp.gnu.org:gnu/jacal/ +# $(distdir)scm-$(VERSION)-$(RELEASE).x86_64.rpm + +upzip: $(snapdir)scm.zip + $(RSYNC) $(snapdir)scm.zip $(Uploadee):pub/ $(RSYNC) r4rstest.scm $(HOME)/dist/ - $(RSYNC) r4rstest.scm $(UPLOADEE):dist/ + $(RSYNC) r4rstest.scm $(Uploadee):dist/ + +dist: $(distdir)scm-$(VERSION).zip +$(distdir)scm-$(VERSION).zip: temp/scm + $(MAKEDEV) DEST=$(distdir) PROD=scm ver=-$(VERSION) zip -dist: $(dest)scm-$(VERSION).zip -$(dest)scm-$(VERSION).zip: temp/scm - $(makedev) DEST=$(dest) PROD=scm ver=-$(VERSION) zip +upgnu: $(distdir)scm-$(VERSION).tar.gz + cd $(distdir); gnupload --to ftp.gnu.org:scm scm-$(VERSION).tar.gz +tar.gz: $(distdir)scm-$(VERSION).tar.gz +$(distdir)scm-$(VERSION).tar.gz: temp/scm/ + $(MAKEDEV) DEST=$(distdir) PROD=scm ver=-$(VERSION) tar.gz rpm: pubzip -# $(dest)scm-$(VERSION)-$(RELEASE).i386.rpm: $(dest)scm-$(VERSION).zip - cp -f $(HOME)/pub/scm.zip $(rpm_prefix)SOURCES/scm-$(VERSION).zip - rpmbuild -ba scm.spec # --clean + cp -f $(snapdir)scm.zip $(rpm_prefix)SOURCES/scm-$(VERSION).zip + rpmbuild -ba scm.spec # --clean --target i386 rm $(rpm_prefix)SOURCES/scm-$(VERSION).zip - mv $(rpm_prefix)RPMS/i386/scm-$(VERSION)-$(RELEASE).i386.rpm \ - $(rpm_prefix)SRPMS/scm-$(VERSION)-$(RELEASE).src.rpm $(dest) + mv $(rpm_prefix)RPMS/*/scm-$(VERSION)-$(RELEASE).*.rpm \ + $(rpm_prefix)SRPMS/scm-$(VERSION)-$(RELEASE).src.rpm \ + $(distdir) shar: scm.shar scm.shar: temp/scm - $(makedev) PROD=scm shar + $(MAKEDEV) PROD=scm shar dclshar: scm.com com: scm.com scm.com: temp/scm - $(makedev) PROD=scm com + $(MAKEDEV) PROD=scm com zip: scm.zip scm.zip: temp/scm - $(makedev) PROD=scm zip -doszip: $(DOSCM)scm-$(VERSION).zip -$(DOSCM)scm-$(VERSION).zip: temp/scm turtle turtlegr.c grtest.scm SCM.ico scm.html hobbit.html - $(makedev) DEST=$(DOSCM) PROD=scm ver=-$(VERSION) zip - -cd ..; zip -9ur $(DOSCM)scm-$(VERSION).zip \ + $(MAKEDEV) PROD=scm zip +doszip: $(windistdir)scm-$(VERSION).zip +$(windistdir)scm-$(VERSION).zip: temp/scm $(turfiles) SCM.ico scm.html hobbit.html + cp -f ../wb/wbtab.scm ../wb/rwb-isam.scm temp/scm/ + $(MAKEDEV) DEST=$(windistdir) PROD=scm ver=-$(VERSION) zip + -cd ..; zip -9ur $(windistdir)scm-$(VERSION).zip \ scm/turtle scm/turtlegr.c scm/grtest.scm \ scm/SCM.ico \ scm/scm.html scm/hobbit.html - zip -d $(DOSCM)scm-$(VERSION).zip scm/scm.info scm/Xlibscm.info scm/hobbit.info -pubzip: $(HOME)/pub/scm.zip -$(HOME)/pub/scm.zip: temp/scm - $(makedev) DEST=$(HOME)/pub/ PROD=scm zip + zip -d $(windistdir)scm-$(VERSION).zip scm/scm.info scm/Xlibscm.info scm/hobbit.info +pubzip: $(snapdir)scm.zip +$(snapdir)scm.zip: temp/scm + $(MAKEDEV) DEST=$(snapdir) PROD=scm zip diffs: pubdiffs pubdiffs: temp/scm - $(makedev) DEST=$(HOME)/pub/ PROD=scm pubdiffs + $(MAKEDEV) DEST=$(snapdir) PROD=scm pubdiffs distdiffs: temp/scm - $(makedev) DEST=$(dest) PROD=scm ver=$(ver) distdiffs + $(MAKEDEV) DEST=$(distdir) PROD=scm ver=$(ver) distdiffs CITERS = ANNOUNCE hobbit.texi hobbit.scm \ ../jacal/ANNOUNCE ../jacal/jacal.texi \ ../wb/ANNOUNCE ../wb/README ../wb/wb.texi \ ../synch/ANNOUNCE \ - ../dist/README \ - $(DOSCM)unzipall.bat $(DOSCM)buildall \ + $(distdir)README \ + $(windistdir)unzipall.bat $(windistdir)buildall \ $(htmldir)JACAL.html $(htmldir)README.html \ $(htmldir)SIMSYNCH.html $(htmldir)SLIB.html \ $(htmldir)FreeSnell/ANNOUNCE $(htmldir)FreeSnell/index.html CITES = scm.spec scm.nsi ../wb/wb.spec $(htmldir)SCM.html updates: Init$(ver).scm - $(CHPAT) slib-$(VERSION) slib-$(ver) $(CITERS) + $(CHPAT) scm-$(VERSION) scm-$(ver) $(CITERS) $(CHPAT) $(VERSION) $(ver) $(CITES) - make README + $(MAKE) README Init$(ver).scm: mv -f Init$(VERSION).scm Init$(ver).scm $(CHPAT) $(VERSION) $(ver) patchlvl.h Init$(ver).scm new: updates + echo @set SCMVERSION $(ver) > version.txi + echo @set SCMDATE `date +"%B %Y"` >> version.txi echo `date -I` \ Aubrey Jaffer \ \<`whoami`@`hostname`\>> change echo>> change echo \ \* patchlvl.h \(SCMVERSION\): Bumped from $(VERSION) to $(ver).>>change @@ -673,18 +774,6 @@ new: updates cvs commit -m '(SCMVERSION): Bumped from $(VERSION) to $(ver).' cvs tag -F scm-$(ver) -configtemp/scm: $(confiles) - -$(RM_R) configtemp/scm - -mkdir -p configtemp/scm - ln $(confiles) configtemp/scm -confdist: scmconfig.tar.gz -scmconfig.tar.gz: configtemp/scm - cd configtemp; tar cohf ../scmconfig.tar scm - chmod 664 scmconfig.tar - -rm -f scmconfig.tar.*z - gzip scmconfig.tar - chmod 664 scmconfig.tar.*z - lint: lints lints: $(cfiles) $(hfiles) lint $(CPPFLAGS) $(ALL_CFLAGS) $(cfiles) | tee lints @@ -711,21 +800,17 @@ name8s: scmlit l=$$1\ }END{exit stat}' - -ctagfiles = $(hfiles) $(cfiles) $(xfiles) ctags: $(ctagfiles) etags $(ctagfiles) -TAGFILES = $(hfiles) $(cfiles) $(ifiles) $(sfiles) $(xfiles) $(mfiles)\ - $(txifiles) Xlibscm.texi hobbit.texi build hobbit.scm -# # $(ufiles) ChangeLog -TAGS: $(TAGFILES) - etags $(TAGFILES) +TAGS: $(tagfiles) + etags $(tagfiles) tags: TAGS mostlyclean: clean: -rm -f core a.out ramap.o ramap.obj $(ofiles) scmmain.o lints - -$(RM_R) *temp + -rm -rf *temp distclean: clean -rm -f $(EXECFILES) *.o *.obj a.out TAGS implcat slibcat gdbscm realclean: distclean diff --git a/QUICKREF b/QUICKREF old mode 100644 new mode 100755 diff --git a/README b/README old mode 100644 new mode 100755 index e6d4e57..17d25f2 --- a/README +++ b/README @@ -1,10 +1,10 @@ -This directory contains the distribution of scm5e5. SCM conforms to +This directory contains the distribution of scm5f2. SCM conforms to Revised^5 Report on the Algorithmic Language Scheme and the IEEE P1178 specification. SCM runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS, Unix and similar systems. SCM supports the SLIB Scheme library; both SCM and SLIB are GNU packages. - `http://swiss.csail.mit.edu/~jaffer/SCM' + `http://people.csail.mit.edu/jaffer/SCM' 0.1 Manifest ============ @@ -51,7 +51,7 @@ Scheme library; both SCM and SLIB are GNU packages. functions. `ioext.c' system calls in common between PC compilers and unix. `lastfile.c' find the point in data space between data and libraries. -`macos-config.h' Included by unexmacosx.c and lastfile.c. +`macosx-config.h'Included by unexmacosx.c and lastfile.c. `mkimpcat.scm' build SCM-specific catalog for SLIB. `patchlvl.h' patchlevel of this release. `pi.c' computes digits of pi [cc -o pi pi.c;time pi 100 5]. @@ -103,64 +103,99 @@ Scheme library; both SCM and SLIB are GNU packages. -File: scm.info, Node: SLIB, Next: Building SCM, Prev: Making SCM, Up: Installing SCM +File: scm-5f2.info, Node: Distributions, Next: GNU configure and make, Prev: Installing SCM, Up: Installing SCM -2.2 SLIB -======== +2.1 Distributions +================= -[SLIB] is a portable Scheme library meant to provide compatibility and -utility functions for all standard Scheme implementations. Although -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: +The SCM homepage contains links to precompiled binaries and source +distributions. - * swiss.csail.mit.edu:/pub/scm/slib-3b1.tar.gz +Downloads and instructions for installing the precompiled binaries are +at `http://people.csail.mit.edu/jaffer/SCM#QuickStart'. - * ftp.gnu.org:/pub/gnu/jacal/slib-3b1.tar.gz +If there is no precompiled binary for your platform, you may be able to +build from the source distribution. The rest of these instructions +deal with building and installing SCM and SLIB from sources. -Unpack SLIB (`tar xzf slib-3b1.tar.gz' or `unzip -ao slib-3b1.zip') in -an appropriate directory for your system; both `tar' and `unzip' will -create the directory `slib'. +Download (both SCM and SLIB of) either the last release or current +development snapshot from +`http://people.csail.mit.edu/jaffer/SCM#BuildFromSource'. -Then create a file `require.scm' in the SCM "implementation-vicinity" -(this is the same directory as where the file `Init5e5.scm' is -installed). `require.scm' should have the contents: +Unzip both the SCM and SLIB zips. For example, if you are working in +`/usr/local/src/', this will create directories `/usr/local/src/scm/' +and `/usr/local/src/slib/'. - (define (library-vicinity) "/usr/local/lib/slib/") -where the pathname string `/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 (*note chmod: I/O-Extensions.). -The way to specify a relative pathname is to append it to the -implementation-vicinity, which is absolute: - (define library-vicinity - (let ((lv (string-append (implementation-vicinity) "../slib/"))) - (lambda () lv))) +File: scm-5f2.info, Node: GNU configure and make, Next: Building SCM, Prev: Distributions, Up: Installing SCM -Alternatively, you can set the (shell) environment variable -`SCHEME_LIBRARY_PATH' to the pathname of the SLIB directory (*note -SCHEME_LIBRARY_PATH: SCM Variables.). If set, the environment variable -overrides `require.scm'. Again, absolute pathnames are recommended. +2.2 GNU configure and make +========================== + +`scm/configure' and `slib/configure' are Shell scripts which create the +files `scm/config.status' and `slib/config.status' on Unix and MinGW +systems. + +The `config.status' files are used (included) by the Makefile to +control where the packages will be installed by `make install'. With +GNU shell (bash) and utilities, the following commands should build and +install SCM and SLIB: + + bash$ (cd slib; ./configure --prefix=/usr/local/) + bash$ (cd scm + > ./configure --prefix=/usr/local/ + > make scmlit + > sudo make all + > sudo make install) + bash$ (cd slib; sudo make install) + +If the install commands worked, skip to *note Testing::. + +If `configure' doesn't work on your system, make `scm/config.status' +and `slib/config.status' be empty files. + +For additional help on using the `configure' script, run +`./configure --help'. + +`make all' will attempt to create a dumped executable (*note Saving +Executable Images::), which has very small startup latency. If that +fails, it will try to compile an ordinary `scm' executable. + +Note that the compilation output may contain error messages; be +concerned only if the `make install' transcripts contain errors. + +`sudo' runs the command after it as user "root". On recent GNU/Linux +systems, dumping requires that `make all' be run as user root; hence +the use of `sudo'. +`make install' requires root privileges if you are installing to +standard Unix locations as specified to (or defaulted by) +`./configure'. Note that this is independent of whether you did +`sudo make all' or `make all'. +* Menu: -File: scm.info, Node: Making SCM, Next: SLIB, Prev: Installing SCM, Up: Installing SCM +* Making scmlit:: +* Makefile targets:: -2.1 Making SCM -============== -The SCM distribution has "Makefile" which contains rules for making -"scmlit", a "bare-bones" version of SCM sufficient for running `build'. -`build' is used to compile (or create scripts to compile) full -featured versions (*note Building SCM::). -Makefiles are not portable to the majority of platforms. If `Makefile' -works for you, good; If not, I don't want to hear about it. If you -need to compile SCM without build, there are several ways to proceed: +File: scm-5f2.info, Node: Making scmlit, Next: Makefile targets, Prev: GNU configure and make, Up: GNU configure and make - * Use the build (http://swiss.csail.mit.edu/~jaffer/buildscm.html) +2.2.1 Making scmlit +------------------- + +The SCM distribution `Makefile' contains rules for making "scmlit", a +"bare-bones" version of SCM sufficient for running `build'. `build' is +a Scheme program used to compile (or create scripts to compile) full +featured versions of SCM (*note Building SCM::). To create scmlit, run +`make scmlit' in the `scm/' directory. + +Makefiles are not portable to the majority of platforms. If you need +to compile SCM without `scmlit', there are several ways to proceed: + + * Use the build (http://people.csail.mit.edu/jaffer/buildscm.html) web page to create custom batch scripts for compiling SCM. * Use SCM on a different platform to run `build' to create a script @@ -171,61 +206,711 @@ need to compile SCM without build, there are several ways to proceed: * Create your own script or `Makefile'. +Finding SLIB +------------ +If you didn't create scmlit using `make scmlit', then you must create a +file named `scm/require.scm'. For most installations, +`scm/require.scm' can just be copied from `scm/requires.scm', which is +part of the SCM distribution. -File: scm.info, Node: Editing Scheme Code, Next: Debugging Scheme Code, Prev: SCM Session, Up: Operational Features +If, when executing `scmlit' or `scm', you get a message like: -3.7 Editing Scheme Code -======================= + ERROR: "LOAD couldn't find file " "/usr/local/src/scm/require" - -- Function: ed arg1 ... - The value of the environment variable `EDITOR' (or just `ed' if it - isn't defined) is invoked as a command with arguments ARG1 .... +then create a file `require.scm' in the SCM "implementation-vicinity" +(this is the same directory as where the file `Init5f1.scm' is). +`require.scm' should have the contents: - -- Function: ed filename - If SCM is compiled under VMS `ed' will invoke the editor with a - single the single argument FILENAME. + (define (library-vicinity) "/usr/local/lib/slib/") -Gnu Emacs: - Editing of Scheme code is supported by emacs. Buffers holding - files ending in .scm are automatically put into scheme-mode. +where the pathname string `/usr/local/lib/slib/' is to be replaced by +the pathname into which you unzipped (or installed) SLIB. - 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. +Alternatively, you can set the (shell) environment variable +`SCHEME_LIBRARY_PATH' to the pathname of the SLIB directory (*note +SCHEME_LIBRARY_PATH: SCM Variables.). If set, this environment +variable overrides `scm/require.scm'. -Epsilon (MS-DOS): - There is lisp (and scheme) mode available by use of the package - `LISP.E'. It offers several different indentation formats. With - this package, buffers holding files ending in `.L', `.LSP', `.S', - and `.SCM' (my modification) are automatically put into lisp-mode. +Absolute pathnames are recommended here; if you use a relative +pathname, SLIB can get confused when the working directory is changed +(*note chmod: I/O-Extensions.). The way to specify a relative pathname +is to append it to the implementation-vicinity, which is absolute: - It is possible to run a process in a buffer under Epsilon. With - Epsilon 5.0 the command line options `-e512 -m0' are neccessary to - manage RAM properly. It has been reported that when compiling SCM - with Turbo C, you need to `#define NOSETBUF' for proper operation - in a process buffer with Epsilon 5.0. + (define library-vicinity + (let ((lv (string-append (implementation-vicinity) "../slib/"))) + (lambda () lv))) - One can also call out to an editor from SCM if RAM is at a - premium; See "under other systems" below. -other systems: - Define the environment variable `EDITOR' to be the name of the - editing program you use. The SCM procedure `(ed arg1 ...)' will - invoke your editor and return to SCM when you exit the editor. The - following definition is convenient: - (define (e) (ed "work.scm") (load "work.scm")) +File: scm-5f2.info, Node: Makefile targets, Prev: Making scmlit, Up: GNU configure and make - Typing `(e)' will invoke the editor with the file of interest. - After editing, the modified file will be loaded. +2.2.2 Makefile targets +---------------------- + +Each of the following four `make' targets creates an executable named +`scm'. Each target takes its build options from a file with an `.opt' +suffix. If that options file doesn't exist, making that target will +create the file with the `-F' features: cautious, bignums, arrays, +inexact, engineering-notation, and dynamic-linking. Once that `.opt' +file exists, you can edit it to your taste and it will be preserved. + +`make scm4' + Produces a R4RS executable named `scm' lacking hygienic macros + (but with defmacro). The build options are taken from `scm4.opt'. + If build or the executable fails, try removing `dynamic-linking' + from `scm4.opt'. + +`make scm5' + R5RS; like `make scm4' but with `-F macro'. The build options are + taken from `scm5.opt'. If build or the executable fails, try + removing `dynamic-linking' from `scm5.opt'. + +`make dscm4' + Produces a R4RS executable named `udscm4', which it starts and + dumps to a low startup latency executable named `scm'. The build + options are taken from `udscm4.opt'. + + If the build fails, then `build scm4' instead. If the dumped + executable fails to run, then send me a bug report (and use + `build scm4' until the problem with dump is corrected). + +`make dscm5' + Like `make dscm4' but with `-F macro'. The build options are + taken from `udscm5.opt'. + + If the build fails, then `build scm5' instead. If the dumped + executable fails to run, then send me a bug report (and use + `build scm5' until the problem with dump is corrected). + + +If the above builds fail because of `-F dynamic-linking', then (because +they can't be dynamically linked) you will likely want to add some +other features to the build's `.opt' file. See the `-F' build option +in *note Build Options::. + +If dynamic-linking is working, then you will likely want to compile +most of the modules as "DLL"s. The build options for compiling DLLs +are in `dlls.opt'. + +`make x.so' + The `Xlib' module; *note SCM Language X Interface: (Xlibscm)Top. + +`make myturtle' + Creates a DLL named `turtlegr.so' which is a simple graphics API. + +`make wbscm.so' + The `wb' module; *note B-tree database implementation: (wb)Top. + Compiling this requires that wb source be in a peer directory to + scm. + +`make dlls' + Compiles all the distributed library modules, but not `wbscm.so'. + Many of the module compiles are recursively invoked in such a way + that failure of one (which could be due to a system library not + being installed) doesn't cause the top-level `make dlls' to fail. + If `make dlls' fails as a whole, it is time to submit a bug report + (*note Reporting Problems::). + + + + +File: scm-5f2.info, Node: Building SCM, Next: Saving Executable Images, Prev: GNU configure and make, Up: Installing SCM + +2.3 Building SCM +================ + +The file "build" loads the file "build.scm", which constructs a +relational database of how to compile and link SCM executables. +`build.scm' has information for the platforms which SCM has been ported +to (of which I have been notified). Some of this information is old, +incorrect, or incomplete. Send corrections and additions to +agj@alum.mit.edu. + +* Menu: + +* Invoking Build:: +* Build Options:: build --help +* Compiling and Linking Custom Files:: + + + +File: scm-5f2.info, Node: Invoking Build, Next: Build Options, Prev: Building SCM, Up: Building SCM + +2.3.1 Invoking Build +-------------------- + +This section teaches how to use `build', a Scheme program for creating +compilation scripts to produce SCM executables and library modules. +The options accepted by `build' are documented in *note Build Options::. + +Use the _any_ method if you encounter problems with the other two +methods (MS-DOS, Unix). + +MS-DOS + From the SCM source directory, type `build' followed by up to 9 + command line arguments. + +Unix + From the SCM source directory, type `./build' followed by command + line arguments. + +_any_ + From the SCM source directory, start `scm' or `scmlit' and type + `(load "build")'. Alternatively, start `scm' or `scmlit' with the + command line argument `-ilbuild'. This method will also work for + MS-DOS and Unix. + + After loading various SLIB modules, the program will print: + + type (b "build ") to build + type (b*) to enter build command loop + + The `b*' procedure enters into a "build shell" where you can enter + commands (with or without the `build'). Blank lines are ignored. + To create a build script with all defaults type `build'. + + If the build-shell encouters an error, you can reenter the + build-shell by typing `(b*)'. To exit scm type `(quit)'. + + +Here is a transcript of an interactive (b*) build-shell. + + bash$ scmlit + SCM version 5e7, Copyright (C) 1990-2006 Free Software Foundation. + 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. + > (load "build") + ;loading build + ; loading /home/jaffer/slib/getparam + ; loading /home/jaffer/slib/coerce + ... + ; done loading build.scm + type (b "build ") to build + type (b*) to enter build command loop + ;done loading build + # + > (b*) + ;loading /home/jaffer/slib/comparse + ;done loading /home/jaffer/slib/comparse.scm + build> -t exe + #! /bin/sh + # unix (linux) script created by SLIB/batch Wed Oct 26 17:14:23 2011 + # [-p linux] + # ================ Write file with C defines + rm -f scmflags.h + echo '#define IMPLINIT "Init5e7.scm"'>>scmflags.h + echo '#define BIGNUMS'>>scmflags.h + echo '#define FLOATS'>>scmflags.h + echo '#define ARRAYS'>>scmflags.h + # ================ Compile C source files + gcc -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c + # ================ Link C object files + gcc -rdynamic -o scm continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o -lm -lc + "scm" + build> -t exe -w myscript.sh + "scm" + build> (quit) + +No compilation was done. The `-t exe' command shows the compile +script. The `-t exe -w myscript.sh' line creates a file `myscript.sh' +containing the compile script. To actually compile and link it, type +`./myscript.sh'. + +Invoking build without the `-F' option will build or create a shell +script with the `arrays', `inexact', and `bignums' options as defaults. +Invoking `build' with `-F lit -o scmlit' will make a script for +compiling `scmlit'. + + bash$ ./build + -| + #! /bin/sh + # unix (linux) script created by SLIB/batch + # ================ Write file with C defines + rm -f scmflags.h + echo '#define IMPLINIT "Init5f1.scm"'>>scmflags.h + echo '#define BIGNUMS'>>scmflags.h + echo '#define FLOATS'>>scmflags.h + echo '#define ARRAYS'>>scmflags.h + # ================ Compile C source files + gcc -O2 -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c + # ================ Link C object files + gcc -rdynamic -o scm continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o -lm -lc + +To cross compile for another platform, invoke build with the `-p' or +`--platform=' option. This will create a script for the platform named +in the `-p' or `--platform=' option. + + bash$ ./build -o scmlit -p darwin -F lit + -| + #! /bin/sh + # unix (darwin) script created by SLIB/batch + # ================ Write file with C defines + rm -f scmflags.h + echo '#define IMPLINIT "Init5f1.scm"'>>scmflags.h + # ================ Compile C source files + cc -O3 -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c + # ================ Link C object files + mv -f scmlit scmlit~ + cc -o scmlit continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o + + + +File: scm-5f2.info, Node: Build Options, Next: Compiling and Linking Custom Files, Prev: Invoking Build, Up: Building SCM + +2.3.2 Build Options +------------------- + +The options to "build" specify what, where, and how to build a SCM +program or dynamically linked module. These options are unrelated to +the SCM command line options. + + -- Build Option: -p PLATFORM-NAME + -- Build Option: --platform=PLATFORM-NAME + specifies that the compilation should be for a + computer/operating-system combination called PLATFORM-NAME. + _Note_ The case of PLATFORM-NAME is distinguised. The current + PLATFORM-NAMEs are all lower-case. + + The platforms defined by table "platform" in `build.scm' are: + + Table: platform + name processor operating-system compiler + #f processor-family operating-system #f + symbol processor-family operating-system symbol + symbol symbol symbol symbol + ================= ================= ================= ================= + *unknown* *unknown* unix cc + acorn-unixlib acorn *unknown* cc + aix powerpc aix cc + alpha-elf alpha unix cc + alpha-linux alpha linux gcc + amiga-aztec m68000 amiga cc + amiga-dice-c m68000 amiga dcc + amiga-gcc m68000 amiga gcc + amiga-sas m68000 amiga lc + atari-st-gcc m68000 atari-st gcc + atari-st-turbo-c m68000 atari-st tcc + borland-c i8086 ms-dos bcc + darwin powerpc unix cc + djgpp i386 ms-dos gcc + freebsd *unknown* unix cc + gcc *unknown* unix gcc + gnu-win32 i386 unix gcc + highc i386 ms-dos hc386 + hp-ux hp-risc hp-ux cc + irix mips irix gcc + linux *unknown* linux gcc + linux-aout i386 linux gcc + linux-ia64 ia64 linux gcc + microsoft-c i8086 ms-dos cl + microsoft-c-nt i386 ms-dos cl + microsoft-quick-c i8086 ms-dos qcl + ms-dos i8086 ms-dos cc + netbsd *unknown* unix gcc + openbsd *unknown* unix gcc + os/2-cset i386 os/2 icc + os/2-emx i386 os/2 gcc + osf1 alpha unix cc + plan9-8 i386 plan9 8c + sunos sparc sunos cc + svr4 *unknown* unix cc + svr4-gcc-sun-ld sparc sunos gcc + turbo-c i8086 ms-dos tcc + unicos cray unicos cc + unix *unknown* unix cc + vms vax vms cc + vms-gcc vax vms gcc + watcom-9.0 i386 ms-dos wcc386p + + -- Build Option: -f PATHNAME + specifies that the build options contained in PATHNAME be spliced + into the argument list at this point. The use of option files can + separate functional features from platform-specific ones. + + The `Makefile' calls out builds with the options in `.opt' files: + + `dlls.opt' + Options for Makefile targets dlls, myturtle, and x.so. + + `gdb.opt' + Options for udgdbscm and gdbscm. + + `libscm.opt' + Options for libscm.a. + + `pg.opt' + Options for pgscm, which instruments C functions. + + `udscm4.opt' + Options for targets udscm4 and dscm4 (scm). + + `udscm5.opt' + Options for targets udscm5 and dscm5 (scm). + + The Makefile creates options files it depends on only if they do + not already exist. + + -- Build Option: -o FILENAME + -- Build Option: --outname=FILENAME + specifies that the compilation should produce an executable or + object name of FILENAME. The default is `scm'. Executable + suffixes will be added if neccessary, e.g. `scm' => `scm.exe'. + + -- Build Option: -l LIBNAME ... + -- Build Option: --libraries=LIBNAME + specifies that the LIBNAME should be linked with the executable + produced. If compile flags or include directories (`-I') are + needed, they are automatically supplied for compilations. The `c' + library is always included. SCM "features" specify any libraries + they need; so you shouldn't need this option often. + + -- Build Option: -D DEFINITION ... + -- Build Option: --defines=DEFINITION + specifies that the DEFINITION should be made in any C source + compilations. If compile flags or include directories (`-I') are + needed, they are automatically supplied for compilations. SCM + "features" specify any flags they need; so you shouldn't need this + option often. + + -- Build Option: --compiler-options=FLAG + specifies that that FLAG will be put on compiler command-lines. + + -- Build Option: --linker-options=FLAG + specifies that that FLAG will be put on linker command-lines. + + -- Build Option: -s PATHNAME + -- Build Option: --scheme-initial=PATHNAME + specifies that PATHNAME should be the default location of the SCM + initialization file `Init5f1.scm'. SCM tries several likely + locations before resorting to PATHNAME (*note File-System + Habitat::). If not specified, the current directory (where build + is building) is used. + + -- Build Option: -c PATHNAME ... + -- Build Option: --c-source-files=PATHNAME + specifies that the C source files PATHNAME ... are to be compiled. + + -- Build Option: -j PATHNAME ... + -- Build Option: --object-files=PATHNAME + specifies that the object files PATHNAME ... are to be linked. + + -- Build Option: -i CALL ... + -- Build Option: --initialization=CALL + specifies that the C functions CALL ... are to be invoked during + initialization. + + -- Build Option: -t BUILD-WHAT + -- Build Option: --type=BUILD-WHAT + specifies in general terms what sort of thing to build. The + choices are: + `exe' + executable program. + + `lib' + library module. + + `dlls' + archived dynamically linked library object files. + + `dll' + dynamically linked library object file. + + The default is to build an executable. + + -- Build Option: -h BATCH-SYNTAX + -- Build Option: -batch-dialect=BATCH-SYNTAX + specifies how to build. The default is to create a batch file for + the host system. The SLIB file `batch.scm' knows how to create + batch files for: + * unix + + * dos + + * vms + + * amigaos (was amigados) + + * system + + This option executes the compilation and linking commands + through the use of the `system' procedure. + + * *unknown* + + This option outputs Scheme code. + + -- Build Option: -w BATCH-FILENAME + -- Build Option: -script-name=BATCH-FILENAME + specifies where to write the build script. The default is to + display it on `(current-output-port)'. + + -- Build Option: -F FEATURE ... + -- Build Option: --features=FEATURE + specifies to build the given features into the executable. The + defined features are: + + "array" + Alias for ARRAYS + + "array-for-each" + array-map! and array-for-each (arrays must also be featured). + + "arrays" + Use if you want arrays, uniform-arrays and uniform-vectors. + + "bignums" + Large precision integers. + + "byte" + Treating strings as byte-vectors. + + "byte-number" + Byte/number conversions + + "careful-interrupt-masking" + Define this for extra checking of interrupt masking and some + simple checks for proper use of malloc and free. This is for + debugging C code in `sys.c', `eval.c', `repl.c' and makes the + interpreter several times slower than usual. + + "cautious" + Normally, the number of arguments arguments to interpreted + closures (from LAMBDA) are checked if the function part of a + form is not a symbol or only the first time the form is + executed if the function part is a symbol. defining + `reckless' disables any checking. If you want to have SCM + always check the number of arguments to interpreted closures + define feature `cautious'. + + "cheap-continuations" + If you only need straight stack continuations, executables + compile with this feature will run faster and use less + storage than not having it. Machines with 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 + use this feature. + + "compiled-closure" + Use if you want to use compiled closures. + + "curses" + For the "curses" screen management package. + + "debug" + Turns on the features `cautious' and + `careful-interrupt-masking'; uses `-g' flags for debugging + SCM source code. + + "differ" + Sequence comparison + + "dont-memoize-locals" + SCM normally converts references to local variables to ILOCs, + which make programs run faster. If SCM is badly broken, try + using this option to disable the MEMOIZE_LOCALS feature. + + "dump" + Convert a running scheme program into an executable file. + "dynamic-linking" + Be able to load compiled files while running. + "edit-line" + interface to the editline or GNU readline library. -File: scm.info, Node: Problems Compiling, Next: Problems Linking, Prev: Automatic C Preprocessor Definitions, Up: Installing SCM + "engineering-notation" + Use if you want floats to display in engineering notation + (exponents always multiples of 3) instead of scientific + notation. -2.8 Problems Compiling -====================== + "generalized-c-arguments" + `make_gsubr' for arbitrary (< 11) arguments to C functions. + + "i/o-extensions" + Commonly available I/O extensions: "exec", line I/O, file + positioning, file delete and rename, and directory functions. + + "inexact" + Use if you want floating point numbers. + + "lit" + Lightweight - no features + + "macro" + C level support for hygienic and referentially transparent + macros (syntax-rules macros). + + "mysql" + Client connections to the mysql databases. + + "no-heap-shrink" + Use if you want segments of unused heap to not be freed up + after garbage collection. This may increase time in GC for + *very* large working sets. + + "none" + No features + + "posix" + Posix functions available on all "Unix-like" systems. fork + and process functions, user and group IDs, file permissions, + and "link". + + "reckless" + If your scheme code runs without any errors you can disable + almost all error checking by compiling all files with + `reckless'. + + "record" + The Record package provides a facility for user to define + their own record data types. See SLIB for documentation. + + "regex" + String regular expression matching. + + "rev2-procedures" + These procedures were specified in the `Revised^2 Report on + Scheme' but not in `R4RS'. + + "sicp" + Use if you want to run code from: + + Harold Abelson and Gerald Jay Sussman with Julie Sussman. + `Structure and Interpretation of Computer Programs.' The MIT + Press, Cambridge, Massachusetts, USA, 1985. + + Differences from R5RS are: + * (eq? '() '#f) + + * (define a 25) returns the symbol a. + + * (set! a 36) returns 36. + + "single-precision-only" + Use if you want all inexact real numbers to be single + precision. This only has an effect if SINGLES is also + defined (which is the default). This does not affect complex + numbers. + + "socket" + BSD "socket" interface. Socket addr functions require + inexacts or bignums for 32-bit precision. + + "tick-interrupts" + Use if you want the ticks and ticks-interrupt functions. + + "turtlegr" + "Turtle" graphics calls for both Borland-C and X11 from + sjm@ee.tut.fi. + + "unix" + Those unix features which have not made it into the Posix + specs: nice, acct, lstat, readlink, symlink, mknod and sync. + + "wb" + WB database with relational wrapper. + + "wb-no-threads" + no-comment + + "windows" + Microsoft Windows executable. + + "x" + Alias for Xlib feature. + + "xlib" + Interface to Xlib graphics routines. + + + + +File: scm-5f2.info, Node: Saving Executable Images, Next: Installation, Prev: Building SCM, Up: Installing SCM + +2.4 Saving Executable Images +============================ + +In SCM, the ability to save running program images is called "dump" +(*note Dump::). In order to make `dump' available to SCM, build with +feature `dump'. `dump'ed executables are compatible with dynamic +linking. + +Most of the code for "dump" is taken from `emacs-19.34/src/unex*.c'. +No modifications to the emacs source code were required to use +`unexelf.c'. Dump has not been ported to all platforms. If `unexec.c' +or `unexelf.c' don't work for you, try using the appropriate `unex*.c' +file from emacs. + +The `dscm4' and `dscm5' targets in the SCM `Makefile' save images from +`udscm4' and `udscm5' executables respectively. + +"Address space layout randomization" interferes with `dump'. Here are +the fixes for various operating-systems: + +Fedora-Core-1 + Remove the `#' from the line `#SETARCH = setarch i386' in the + `Makefile'. + +Fedora-Core-3 + `http://jamesthornton.com/writing/emacs-compile.html' [For FC3] + combreloc has become the default for recent GNU ld, which breaks + the unexec/undump on all versions of both Emacs and XEmacs... + + Override by adding the following to `udscm5.opt': + `--linker-options="-z nocombreloc"' + +Linux Kernels later than 2.6.11 +`http://www.opensubscriber.com/message/emacs-devel@gnu.org/1007118.html' + mentions the "exec-shield" feature. Kernels later than 2.6.11 + must do (as root): + + echo 0 > /proc/sys/kernel/randomize_va_space + + before dumping. `Makefile' has this `randomize_va_space' stuffing + scripted for targets `dscm4' and `dscm5'. You must either set + `randomize_va_space' to 0 or run as root to dump. + +OS-X 10.6 +`http://developer.apple.com/library/mac/#documentation/Darwin/Reference/Manpages/man1/dyld.1.html' + The dynamic linker uses the following environment variables. They + affect any program that uses the dynamic linker. + + DYLD_NO_PIE + + Causes dyld to not randomize the load addresses of images in a + process where the main executable was built position independent. + This can be helpful when trying to reproduce and debug a problem + in a PIE. + + + + +File: scm-5f2.info, Node: Installation, Next: Troubleshooting and Testing, Prev: Saving Executable Images, Up: Installing SCM + +2.5 Installation +================ + +Once `scmlit', `scm', and `dlls' have been built, these commands will +install them to the locations specified when you ran `./configure': + + bash$ (cd scm; make install) + bash$ (cd slib; make install) + +Note that installation to system directories (like `/usr/bin/') will +require that those commands be run as root: + + bash$ (cd scm; sudo make install) + bash$ (cd slib; sudo make install) + + + +File: scm-5f2.info, Node: Problems Compiling, Next: Problems Linking, Prev: Troubleshooting and Testing, Up: Troubleshooting and Testing + +2.6.1 Problems Compiling +------------------------ FILE PROBLEM / MESSAGE HOW TO FIX *.c include file not found. Correct the status of @@ -256,22 +941,25 @@ scl.c syntax error. #define SYSTNAME to your system -File: scm.info, Node: Problems Linking, Next: Problems Running, Prev: Problems Compiling, Up: Installing SCM +File: scm-5f2.info, Node: Problems Linking, Next: Testing, Prev: Problems Compiling, Up: Troubleshooting and Testing -2.9 Problems Linking -==================== +2.6.2 Problems Linking +---------------------- PROBLEM HOW TO FIX _sin etc. missing. Uncomment LIBS in makefile. -File: scm.info, Node: Problems Running, Next: Testing, Prev: Problems Linking, Up: Installing SCM +File: scm-5f2.info, Node: Problems Starting, Next: Problems Running, Prev: Testing, Up: Troubleshooting and Testing -2.10 Problems Running -===================== +2.6.4 Problems Starting +----------------------- PROBLEM HOW TO FIX +/bin/bash: scm: program not found Is `scm' in a `$PATH' directory? +/bin/bash: /usr/local/bin/scm: `chmod +x /usr/local/bin/scm' +Permission denied Opening message and then machine Change memory model option to C crashes. compiler (or makefile). Make sure sizet definition is @@ -288,17 +976,17 @@ remove in scmfig.h and Do so and recompile files. recompile scm. add in scmfig.h and recompile scm. -ERROR: Init5e5.scm not found. Assign correct IMPLINIT in makefile +ERROR: Init5f1.scm not found. Assign correct IMPLINIT in makefile or scmfig.h. Define environment variable SCM_INIT_PATH to be the full - pathname of Init5e5.scm. + pathname of Init5f1.scm. WARNING: require.scm not found. Define environment variable SCHEME_LIBRARY_PATH to be the full pathname of the scheme library [SLIB]. Change library-vicinity in - Init5e5.scm to point to library or + Init5f1.scm to point to library or remove. Make sure the value of (library-vicinity) has a trailing @@ -306,44 +994,10 @@ WARNING: require.scm not found. Define environment variable -File: scm.info, Node: Testing, Next: Reporting Problems, Prev: Problems Running, Up: Installing SCM - -2.11 Testing -============ - -Loading `r4rstest.scm' in the distribution will run an [R4RS] -conformance test on `scm'. - - > (load "r4rstest.scm") - -| - ;loading "r4rstest.scm" - SECTION(2 1) - SECTION(3 4) - # - # - # - # - ... - -Loading `pi.scm' in the distribution will enable you to compute digits -of pi. - - > (load "pi") - ;loading "pi" - ;done loading "pi.scm" - ;Evaluation took 20 ms (0 in gc) 767 cells work, 233.B other - # - > (pi 100 5) - 00003 14159 26535 89793 23846 26433 83279 50288 41971 69399 - 37510 58209 74944 59230 78164 06286 20899 86280 34825 34211 - 70679 - ;Evaluation took 550 ms (60 in gc) 36976 cells work, 1548.B other - # +File: scm-5f2.info, Node: Problems Running, Next: Reporting Problems, Prev: Problems Starting, Up: Troubleshooting and Testing -Loading `bench.scm' will compute and display performance statistics of -SCM running `pi.scm'. `make bench' or `make benchlit' appends the -performance report to the file `BenchLog', facilitating tracking -effects of changes to SCM on performance. +2.6.5 Problems Running +---------------------- PROBLEM HOW TO FIX Runs some and then machine crashes. See above under machine crashes. @@ -359,7 +1013,7 @@ Some symbol names print incorrectly. Change memory model option to C than HEAP_SEG_SIZE). ERROR: Rogue pointer in Heap. See above under machine crashes. Newlines don't appear correctly in Check file mode (define OPEN_... in -output files. `Init5e5.scm'). +output files. `Init5f1.scm'). Spaces or control characters appear Check character defines in in symbol names. `scmfig.h'. Negative numbers turn positive. Check SRS in `scmfig.h'. @@ -369,13 +1023,79 @@ VMS: Couldn't unwind stack. #define CHEAP_CONTINUATIONS in `scmfig.h'. VAX: botched longjmp. -Sparc(SUN-4) heap is growing out of control - You are experiencing a GC problem peculiar to the Sparc. The - problem is that SCM doesn't know how to clear register windows. - Every location which is not reused still gets marked at GC time. - This causes lots of stuff which should be collected to not be. - This will be a problem with any _conservative_ GC until we find - what instruction will clear the register windows. This problem is - exacerbated by using lots of call-with-current-continuations. A - possible fix for dynthrow() is commented out in `continue.c'. + + +File: scm-5f2.info, Node: Reporting Problems, Prev: Problems Running, Up: Troubleshooting and Testing + +2.6.6 Reporting Problems +------------------------ + +Reported problems and solutions are grouped under Compiling, Linking, +Running, and Testing. If you don't find your problem listed there, you +can send a bug report to `agj@alum.mit.edu' or `scm-discuss@gnu.org'. +The bug report should include: + + 1. The version of SCM (printed when SCM is invoked with no arguments). + + 2. The type of computer you are using. + + 3. The name and version of your computer's operating system. + + 4. The values of the environment variables `SCM_INIT_PATH' and + `SCHEME_LIBRARY_PATH'. + + 5. The name and version of your C compiler. + + 6. If you are using an executable from a distribution, the name, + vendor, and date of that distribution. In this case, + corresponding with the vendor is recommended. + + + +File: scm-5f2.info, Node: Editing Scheme Code, Next: Debugging Scheme Code, Prev: SCM Session, Up: Operational Features + +3.7 Editing Scheme Code +======================= + + -- Function: ed arg1 ... + The value of the environment variable `EDITOR' (or just `ed' if it + isn't defined) is invoked as a command with arguments ARG1 .... + + -- Function: ed filename + If SCM is compiled under VMS `ed' will invoke the editor with a + single the single argument FILENAME. + +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 `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 + `LISP.E'. It offers several different indentation formats. With + this package, buffers holding files ending in `.L', `.LSP', `.S', + and `.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 `-e512 -m0' are neccessary to + manage RAM properly. It has been reported that when compiling SCM + with Turbo C, you need to `#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. + +other systems: + Define the environment variable `EDITOR' to be the name of the + editing program you use. The SCM procedure `(ed arg1 ...)' will + invoke your editor and return to SCM when you exit the editor. The + following definition is convenient: + + (define (e) (ed "work.scm") (load "work.scm")) + + Typing `(e)' will invoke the editor with the file of interest. + After editing, the modified file will be loaded. diff --git a/Transcen.scm b/Transcen.scm old mode 100644 new mode 100755 diff --git a/Tscript.scm b/Tscript.scm old mode 100644 new mode 100755 diff --git a/Xlibscm.info b/Xlibscm.info old mode 100644 new mode 100755 index a87c4b6..b06db8d --- a/Xlibscm.info +++ b/Xlibscm.info @@ -1,8 +1,8 @@ -This is Xlibscm.info, produced by makeinfo version 4.8 from +This is Xlibscm.info, produced by makeinfo version 4.13 from Xlibscm.texi. This manual documents the X Interface for SCM Language (version -5e5, February 2008). +5f2, January 2015). Copyright (C) 1999 Free Software Foundation, Inc. @@ -32,7 +32,7 @@ XlibScm ******* This manual documents the X Interface for SCM Language (version -5e5, February 2008). +5f2, January 2015). Copyright (C) 1999 Free Software Foundation, Inc. @@ -2115,21 +2115,21 @@ Concept Index  Tag Table: Node: Top1054 -Node: XlibScm2138 -Node: Display and Screens4932 -Node: Drawables11974 -Node: Windows and Pixmaps12239 -Node: Window Attributes19341 -Node: Window Properties and Visibility35346 -Node: Graphics Context39818 -Node: Cursor55558 -Node: Colormap58069 -Node: Rendering67964 -Node: Images75544 -Node: Event75690 -Node: Indexes90177 -Node: Procedure and Macro Index90333 -Node: Variable Index95785 -Node: Concept Index99238 +Node: XlibScm2137 +Node: Display and Screens4931 +Node: Drawables11973 +Node: Windows and Pixmaps12238 +Node: Window Attributes19340 +Node: Window Properties and Visibility35345 +Node: Graphics Context39817 +Node: Cursor55557 +Node: Colormap58068 +Node: Rendering67963 +Node: Images75543 +Node: Event75689 +Node: Indexes90176 +Node: Procedure and Macro Index90332 +Node: Variable Index95784 +Node: Concept Index99237  End Tag Table diff --git a/Xlibscm.texi b/Xlibscm.texi old mode 100644 new mode 100755 index 71e22ef..337bb76 --- a/Xlibscm.texi +++ b/Xlibscm.texi @@ -111,7 +111,7 @@ dynamic linking, compiled separately and loaded with @code{(require @noindent The most recent information about SCM can be found on SCM's @dfn{WWW} home page: -@center @url{http://swiss.csail.mit.edu/~jaffer/SCM} +@center @url{http://people.csail.mit.edu/jaffer/SCM} @end iftex Much of this X documentation is dervied from: diff --git a/bench.scm b/bench.scm old mode 100644 new mode 100755 diff --git a/build b/build index 293ccbc..80fd280 100755 --- a/build +++ b/build @@ -71,7 +71,7 @@ specification. SCM runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS, Unix and similar systems. SCM supports the SLIB Scheme library; both SCM and SLIB are GNU packages. -@center @url{http://swiss.csail.mit.edu/~jaffer/SCM} +@center @url{http://people.csail.mit.edu/jaffer/SCM} @section Manifest " @@ -79,13 +79,21 @@ Scheme library; both SCM and SLIB are GNU packages. (print-manifest pipe) (close-port pipe) (set! scm-info (string-append "scm-" scm-info ".info")) - (append-info-node scm-info "SLIB" "README") - (append-info-node scm-info "Making SCM" "README") - (append-info-node scm-info "Editing Scheme Code" "README") + (append-info-node scm-info "Distributions" "README") + (append-info-node scm-info "GNU configure and make" "README") + (append-info-node scm-info "Making scmlit" "README") + (append-info-node scm-info "Makefile targets" "README") + (append-info-node scm-info "Building SCM" "README") + (append-info-node scm-info "Invoking Build" "README") + (append-info-node scm-info "Build Options" "README") + (append-info-node scm-info "Saving Executable Images" "README") + (append-info-node scm-info "Installation" "README") (append-info-node scm-info "Problems Compiling" "README") (append-info-node scm-info "Problems Linking" "README") + (append-info-node scm-info "Problems Starting" "README") (append-info-node scm-info "Problems Running" "README") - (append-info-node scm-info "Testing" "README"))) + (append-info-node scm-info "Reporting Problems" "README") + (append-info-node scm-info "Editing Scheme Code" "README"))) (define build:csv (make-command-server build '*commands*)) (define (build-from-argv) diff --git a/build.scm b/build.scm old mode 100644 new mode 100755 index 28a768e..ae1dd7c --- a/build.scm +++ b/build.scm @@ -23,9 +23,10 @@ (require 'object->string) (require 'filename) (require 'batch) +(require-if 'compiling 'alist-table) (require-if 'compiling 'posix-time) ;@ -(set! OPEN_WRITE "w") ; Because MS-DOS scripts need ^M +(define OPEN_WRITE "w") ; Because MS-DOS scripts need ^M ;@ (define build (add-command-tables (create-database #f 'alist-table))) @@ -144,7 +145,7 @@ ("unexalpha.c" c-source platform-specific "Convert a running program into an Alpha executable file.") ("unexsgi.c" c-source platform-specific "Convert a running program into an IRIX executable file.") ("unexsunos4.c" c-source platform-specific "Convert a running program into an executable file.") - ("macos-config.h" c-header platform-specific "Included by unexmacosx.c and lastfile.c.") + ("macosx-config.h" c-header platform-specific "Included by unexmacosx.c and lastfile.c.") ("unexmacosx.c" c-source platform-specific "Convert a running program into an executable file under MacOS X.") ("lastfile.c" c-source platform-specific "find the point in data space between data and libraries.") )) @@ -436,9 +437,19 @@ #;WB database with relational wrapper. (define-build-feature 'wb - '((c-file "../wb/blink.c" "../wb/blkio.c" "../wb/del.c" "../wb/ents.c" - "../wb/handle.c" "../wb/prev.c" "../wb/scan.c" "../wb/segs.c" - "../wb/stats.c" "../wb/wbsys.c" "../wb/db.c") + '((c-file + "../wb/c/blink.c" "../wb/c/blkio.c" "../wb/c/del.c" "../wb/c/ents.c" + "../wb/c/handle.c" "../wb/c/prev.c" "../wb/c/scan.c" "../wb/c/segs.c" + "../wb/c/stats.c" "../wb/c/wbsys.c" "../wb/c/wbscm.c") + (c-lib pthread) + (scm-srcdir "../scm") + (compiled-init "init_db"))) +(define-build-feature + 'wb-no-threads + '((c-file + "../wb/c/blink.c" "../wb/c/blkio.c" "../wb/c/del.c" "../wb/c/ents.c" + "../wb/c/handle.c" "../wb/c/prev.c" "../wb/c/scan.c" "../wb/c/segs.c" + "../wb/c/stats.c" "../wb/c/wbsys.c" "../wb/c/wbscm.c") (scm-srcdir "../scm") (compiled-init "init_db"))) @@ -545,6 +556,7 @@ (lib *unknown* "" "" #f () ("scmmain.c")) (mysql *unknown* "-I/usr/include/mysql" "-L/usr/lib/mysql -lmysqlclient" "/usr/lib/mysql/libmysqlclient.a" () ()) + (pthread *unknown* "" "-lpthread" #f () ()) (m gnu-win32 "" "" #f () ()) (c gnu-win32 "" "" #f () ()) @@ -824,6 +836,7 @@ (and (batch:try-chopped-command parms "qcl" "/AH" "/W1" "/Ze" "/O" "/Ot" "/DNDEBUG" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) @@ -851,6 +864,7 @@ parms "wcc386p" "/mf" "/d2" "/ze" "/oxt" "/3s" "/zq" "/w3" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) @@ -905,7 +919,8 @@ parms "gcc" "-c" (include-spec "-I" parms) - (c-includes parms) (c-flags parms) + (c-includes parms) + (c-flags parms) files) (truncate-up-to (map c->o files) "\\/")))) (defcommand link-c-program djgpp @@ -1077,14 +1092,17 @@ (append objects libs))) oname))) +(define (build-continue-ia64 parms) + (and (batch:try-command + parms "gcc -o get-contoffset-ia64 get-contoffset-ia64.c") + (batch:try-command + parms "./get-contoffset-ia64 contoffset-ia64.S") + (batch:try-command + parms "gcc -c continue-ia64.S"))) + (defcommand link-c-program linux-ia64 (lambda (oname objects libs parms) - (and (and (batch:try-command - parms "gcc -o get-contoffset-ia64 get-contoffset-ia64.c") - (batch:try-command - parms "./get-contoffset-ia64 contoffset-ia64.S") - (batch:try-command - parms "gcc -c continue-ia64.S")) + (and (build-continue-ia64 parms) (batch:try-command parms "gcc" "-rdynamic" "-o" oname "continue-ia64.o" (must-be-first @@ -1187,8 +1205,11 @@ (define c-files (remove-if (lambda (file) (member file suppressors)) files)) (and (batch:try-chopped-command - parms "gcc" "-c" (include-spec "-I" parms) - (c-includes parms) (c-flags parms) c-files) + parms "gcc" "-c" + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + c-files) (let ((fnames (map c-> c-files))) (and (batch:try-command parms "dllwrap" @@ -1240,10 +1261,10 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-std1" + "cc" "-std1" "-c" ;;(if (member "-g" (c-includes parms)) "" "-O") - "-c" (c-includes parms) (include-spec "-I" parms) + (c-includes parms) (c-flags parms) files) (truncate-up-to (map c->o files) #\/)))) @@ -1251,8 +1272,11 @@ (lambda (files parms) (and (batch:try-chopped-command - parms "cc" "-std1" "-c" (c-includes parms) - (include-spec "-I" parms) (c-flags parms) files) + parms "cc" "-std1" "-c" + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + files) (let* ((platform (car (parameter-list-ref parms 'platform))) (fnames (truncate-up-to (map c-> files) #\/))) (and (batch:try-command @@ -1307,7 +1331,9 @@ (and (batch:try-chopped-command parms "gcc" "-fpic" "-c" (include-spec "-I" parms) - (c-includes parms) (c-flags parms) files) + (c-includes parms) + (c-flags parms) + files) (let* ((platform (car (parameter-list-ref parms 'platform))) (fnames (truncate-up-to (map c-> files) #\/))) (and (batch:try-command @@ -1488,6 +1514,7 @@ (and (batch:try-chopped-command parms "cc" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) (map c-> files)) @@ -1568,6 +1595,15 @@ (and (batch:try-command parms "ar rc" aname objects) (batch:try-command parms "ranlib" aname) aname)))) + +(defcommand make-archive linux-ia64 + (lambda (oname objects libs parms) + (let ((aname (string-append "lib" oname ".a"))) + (and (build-continue-ia64 parms) + (batch:try-command parms "ar rc" aname objects "continue-ia64.o") + (batch:try-command parms "ranlib" aname) + aname)))) + (defcommand compile-dll-c-files *unknown* (lambda (files parms) (and (batch:try-chopped-command parms @@ -1595,6 +1631,7 @@ ;;; gcc 3.4.2 for FreeBSD does not allow options other than default i.e. -O0 if NO -DGCC_SPARC_BUG - dai 2004-10-30 ;;"cc" "-O3 -pipe -DGCC_SPARC_BUG " "-c" "cc" "-O3 -pipe " "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) @@ -1615,7 +1652,10 @@ (lambda (files parms) (and (batch:try-chopped-command parms "cc" "-O3 -pipe " "-fPIC" "-c" - (c-includes parms) (c-flags parms) files) + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + files) (let ((fnames (truncate-up-to (map c-> files) #\/))) (and (batch:try-command parms "cc" "-shared" @@ -1649,6 +1689,7 @@ (and (batch:try-chopped-command parms "cc" "-O3" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) @@ -1664,11 +1705,18 @@ (defcommand compile-dll-c-files darwin (lambda (files parms) (and (batch:try-chopped-command - parms "gcc" "-c" - (c-includes parms) (c-flags parms) files) + parms + "env MACOSX_DEPLOYMENT_TARGET=10.3" + "gcc" "-c" + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + files) (let ((fnames (truncate-up-to (map c-> files) #\/))) (and (batch:try-command - parms "gcc" "-dynamiclib" "-single_module" "-L." "-undefined" "dynamic_lookup" + parms + "env MACOSX_DEPLOYMENT_TARGET=10.3" + "gcc" "-dynamiclib" "-single_module" "-L." "-undefined" "dynamic_lookup" "-o" (string-append (car fnames) ".so") (map (lambda (fname) (string-append fname ".o")) fnames)) (for-each (lambda (fname) @@ -1681,6 +1729,7 @@ (let ((platform (car (parameter-list-ref parms 'platform)))) (and (batch:try-command parms + "env MACOSX_DEPLOYMENT_TARGET=10.3" "gcc" "-dynamiclib" "-L." "-undefined" "dynamic_lookup" "-o" (string-append (car (parameter-list-ref parms 'implvic)) @@ -1698,6 +1747,7 @@ (and (batch:try-chopped-command parms "cc" "-c" (include-spec "-I" parms) + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) @@ -1717,8 +1767,11 @@ (defcommand compile-dll-c-files netbsd (lambda (files parms) (and (batch:try-chopped-command - parms "cc" "-fPIC" "-c" (include-spec "-I" parms) - (c-includes parms) (c-flags parms) files) + parms "cc" "-fPIC" "-c" + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + files) (let ((objs (map c->o files))) (and (batch:try-command parms "gcc" "-shared" "-fPIC" objs) (batch:try-command parms "mv" "a.out" (car objs)) @@ -1741,7 +1794,8 @@ (lambda (files parms) (and (batch:try-chopped-command parms - "cc" "-c" (include-spec "-I" parms) + "cc" "-c" + (include-spec "-I" parms) (c-includes parms) (c-flags parms) files) @@ -1761,8 +1815,11 @@ (defcommand compile-dll-c-files openbsd (lambda (files parms) (and (batch:try-chopped-command - parms "cc" "-fPIC" "-c" (include-spec "-I" parms) - (c-includes parms) (c-flags parms) files) + parms "cc" "-fPIC" "-c" + (include-spec "-I" parms) + (c-includes parms) + (c-flags parms) + files) (let ((objs (map c->o files))) (and (batch:try-command parms "gcc" "-shared" "-fPIC" objs) (batch:try-command parms "mv" "a.out" (car objs)) @@ -1940,7 +1997,6 @@ (in-vicinity (car (parameter-list-ref parms 'scm-srcdir)) "patchlvl.h")) ".scm"))) - ;;,@`(if (equal? "" implvic) '() (...)) ,@(if (string=? "" init=) '() `((define "INITS" ,init=))) ,@(if (string=? "" compiled-init=) '() diff --git a/byte.c b/byte.c old mode 100644 new mode 100755 diff --git a/bytenumb.c b/bytenumb.c old mode 100644 new mode 100755 index 30ca469..b5821d3 --- a/bytenumb.c +++ b/bytenumb.c @@ -60,7 +60,8 @@ char * get_bytes(obj, minlen, s_name) obj, ARG1, s_name); { int byvlen = get_bytes_length(obj); - ASRTER(byvlen >= minlen, obj, s_wrong_length, s_name); + ASRTER((minlen < 0) ? byvlen >= -minlen : byvlen == minlen, + MAKINUM(byvlen), s_wrong_length, s_name); return (char*)scm_addr(cons(obj, list_of_0), s_name); } } @@ -74,7 +75,7 @@ SCM scm_bytes_to_integer(sbyts, sn) if (!(n)) return INUM0; { int cnt = abs(n); - char *byts = get_bytes(sbyts, cnt, s_bytes_to_integer); + char *byts = get_bytes(sbyts, -cnt, s_bytes_to_integer); int iu = 0, id = cnt - sizeof(BIGDIG); sizet ndigs = (cnt + sizeof(BIGDIG) - 1) / sizeof(BIGDIG); int negp = (0x80 & byts[0]) && (0 > n); @@ -83,7 +84,7 @@ SCM scm_bytes_to_integer(sbyts, sn) if (negp) for (; iu < ndigs; iu++) { int j = 0; - unsigned long dig = 0; + UBIGLONG dig = 0; for (; j < sizeof(BIGDIG); j++) { dig = (dig<<8) + (0xFF ^ ((id + j >= 0) ? (((unsigned char *)byts)[id + j]) : 255)); @@ -131,7 +132,7 @@ SCM scm_integer_to_bytes(sn, slen) } } else { - unsigned long res = n; + UBIGLONG res = n; while (!(0 > idx)) { byts[idx--] = res % 0x100; res = res>>8; @@ -143,7 +144,7 @@ SCM scm_integer_to_bytes(sn, slen) BIGDIG *digs = BDIGITS(sn), borrow = 1; sizet ndigs = NUMDIGS(sn); int iu = 0, id = abs(len) - 1; - unsigned long dig; + UBIGLONG dig; if ((0 > len) && (TYP16(sn)==tc16_bigneg)) for (; 0 <= id ; iu++) { sizet j = sizeof(BIGDIG); @@ -400,7 +401,7 @@ static char s_integer_byte_collate_M[] = "integer-byte-collate!"; SCM scm_integer_byte_collate_M(byte_vector) SCM byte_vector; { - char* bv = get_bytes(byte_vector, 1, s_integer_byte_collate_M); + char* bv = get_bytes(byte_vector, -1, s_integer_byte_collate_M); bv[0] = 0x80^(bv[0]); return byte_vector; } diff --git a/compile.scm b/compile.scm index 06aa956..fd2d9f0 100755 --- a/compile.scm +++ b/compile.scm @@ -39,7 +39,7 @@ Usage: compile.scm FILE1.scm FILE2.scm ... for your computer (for instance, `.o'). FILE1.scm must be in the current directory; FILE2.scm ... can be in other directories. -http://swiss.csail.mit.edu/~jaffer/SCM +http://people.csail.mit.edu/jaffer/SCM " (current-error-port)) #f) diff --git a/configure b/configure new file mode 100755 index 0000000..ae9ac54 --- /dev/null +++ b/configure @@ -0,0 +1,377 @@ +#! /bin/sh +# This is the configure script for Voluntocracy software projects, +# hosted at "http://people.csail.mit.edu/jaffer". Parts are taken +# from a configure script generated by GNU Autoconf 2.63. +# +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +# +# I place the rest in the public domain. +# Author: Aubrey Jaffer (2010) + +# The "config.status" produced by this script differs from GNU +# conventions in that the value of every *dir variable has a trailing +# slash (/). + +# Extract the PACKAGE_NAME, PACKAGE_TARNAME, and PACKAGE_VERSION from +# "version.txi", which is built by the project Makefile. +if test ! -f version.txi; then + make version.txi +fi +version_txi=`cat version.txi | sed 1q` +mywd=`pwd` + +PACKAGE_NAME=`expr "X$version_txi" : 'X@set \([A-Z]*\)VERSION .*' | tr '[A-Z]' '[a-z]'` +PACKAGE_TARNAME=`expr "X$mywd" : '.*/\([A-Za-z]*\)'` +if echo "$PACKAGE_TARNAME" | grep -iq "$PACKAGE_NAME"; then + if ! echo "$PACKAGE_NAME" | grep -iq "$PACKAGE_TARNAME"; then + PACKAGE_TARNAME=$PACKAGE_NAME + fi +fi +PACKAGE_VERSION=`expr "X$version_txi" : '.*VERSION \([0-9a-z]*\)'` +PACKAGE_STRING="$PACKAGE_TARNAME $PACKAGE_VERSION" +PACKAGE_BUGREPORT="$PACKAGE_TARNAME-discuss@gnu.org" + +CONFIG_STATUS="config.status" +ac_default_prefix=/usr/local/ +ac_init_version=false +srcdir=`pwd` +silent= +no_create= + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +prefix=$ac_default_prefix +exec_prefix='${prefix}' +bindir='${exec_prefix}bin/' +sbindir='${exec_prefix}sbin/' +libexecdir='${exec_prefix}libexec/' +datarootdir='${prefix}share/' +datadir='${datarootdir}' +sysconfdir='${prefix}etc/' +sharedstatedir='${prefix}com/' +localstatedir='${prefix}var/' +includedir='${prefix}include/' +oldincludedir='/usr/include/' +docdir='${datarootdir}doc/${PACKAGE_TARNAME}/' +infodir='${datarootdir}info/' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}lib/' +localedir='${datarootdir}locale/' +mandir='${datarootdir}man/' +snapdir='${srcdir}' +distdir='${srcdir}' + +ac_subst_vars='PACKAGE_NAME +PACKAGE_TARNAME +PACKAGE_VERSION +PACKAGE_STRING +PACKAGE_BUGREPORT +srcdir +prefix +exec_prefix +bindir +sbindir +libexecdir +datarootdir +datadir +sysconfdir +sharedstatedir +localstatedir +includedir +oldincludedir +docdir +infodir +htmldir +dvidir +pdfdir +psdir +libdir +localedir +mandir +distdir +snapdir' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + # Handling of the options. + -version | --version | -V) + ac_init_version=: ;; + + -bindir | --bindir) + ac_prev=bindir ;; + -bindir=* | --bindir=*) + bindir=$ac_optarg ;; + + -datadir | --datadir) + ac_prev=datadir ;; + -datadir=* | --datadir=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=*) + datarootdir=$ac_optarg ;; + + -distdir | --distdir) + ac_prev=distdir ;; + -distdir=* | --distdir=*) + distdir=$ac_optarg ;; + + -docdir | --docdir) + ac_prev=docdir ;; + -docdir=* | --docdir=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=*) + dvidir=$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | -exec_prefix) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | -exec_prefix=*) + exec_prefix=$ac_optarg ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + + -htmldir | --htmldir) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir) + ac_prev=includedir ;; + -includedir=* | --includedir=*) + includedir=$ac_optarg ;; + + -infodir | --infodir) + ac_prev=infodir ;; + -infodir=* | --infodir=*) + infodir=$ac_optarg ;; + + -libdir | --libdir) + ac_prev=libdir ;; + -libdir=* | --libdir=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir) + ac_prev=localedir ;; + -localedir=* | --localedir=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir) + ac_prev=mandir ;; + -mandir=* | --mandir=*) + mandir=$ac_optarg ;; + + -no-create | --no-create | -n) + no_create=yes ;; + + -oldincludedir | --oldincludedir) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix) + ac_prev=prefix ;; + -prefix=* | --prefix=*) + prefix=$ac_optarg ;; + + -pdfdir | --pdfdir) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir) + ac_prev=psdir ;; + -psdir=* | --psdir=*) + psdir=$ac_optarg ;; + + -snapdir | --snapdir) + ac_prev=snapdir ;; + -snapdir=* | --snapdir=*) + snapdir=$ac_optarg ;; + + -q | -quiet | --quiet | --q | -silent | --silent) + silent=yes ;; + + -sbindir | --sbindir) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=*) + sharedstatedir=$ac_optarg ;; + + -srcdir | --srcdir) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=*) + sysconfdir=$ac_optarg ;; + + *) { echo "error: unrecognized option: $1 +Try \`$0 --help' for more information." >&2 + { (exit 1); exit 1; }; } ;; + esac + shift +done + +# Now take action based on given options. + +if test "$ac_init_help" = "long"; then + + cat <<_ACEOF +\`configure' configures $PACKAGE_STRING installation. + +Usage: ./configure [OPTION]... + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + -V, --version display version information and exit + -q, --quiet, --silent do not print configuration + -n, --no-create do not create output file + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/$PACKAGE_TARNAME] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] + + --snapdir=DIR development snapshot destination [configure dir] + --distdir=DIR release distribution destination [configure dir] +_ACEOF + +exit +fi + +if $ac_init_version; then + echo "$PACKAGE_NAME configure $PACKAGE_VERSION" + exit +fi + +# Check all directory arguments for consistency. +for ac_var in srcdir exec_prefix prefix bindir sbindir libexecdir \ + datarootdir datadir sysconfdir sharedstatedir localstatedir \ + includedir oldincludedir docdir infodir htmldir dvidir pdfdir \ + psdir libdir localedir mandir snapdir distdir +do + eval ac_val=\$$ac_var + # Assure trailing slashes. + case $ac_val in + *[}/] ) ;; + * ) + ac_val="$ac_val""/" + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + * ) + case $ac_var in + *prefix | *srcdir | *snapdir | *distdir) continue;; + esac;; + esac + { echo "error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; } +done + +if test "$no_create" != yes; then + echo "#! /bin/cat +# Generated by configure for $PACKAGE_NAME $PACKAGE_VERSION. +# This file ($CONFIG_STATUS) is included by the ($PACKAGE_TARNAME) Makefile. +" > $CONFIG_STATUS + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + echo "$ac_var=$ac_val" >> $CONFIG_STATUS + done + chmod +x $CONFIG_STATUS + if test "$silent" != yes; then cat $CONFIG_STATUS; fi +else + if test "$silent" != yes; then + echo "This is the $CONFIG_STATUS file which would have been created: +# Generated by configure for $PACKAGE_NAME $PACKAGE_VERSION. +# This file is included by the Makefile. +" + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + echo "$ac_var=$ac_val" + done + fi +fi diff --git a/continue-ia64.S b/continue-ia64.S old mode 100644 new mode 100755 diff --git a/continue.c b/continue.c old mode 100644 new mode 100755 diff --git a/continue.h b/continue.h old mode 100644 new mode 100755 index 9f1d78f..8e1da75 --- a/continue.h +++ b/continue.h @@ -60,6 +60,9 @@ typedef long STACKITEM; #ifdef _UNICOS # define STACK_GROWS_UP #endif +#ifdef __hppa__ +# define STACK_GROWS_UP +#endif /* James Clark came up with this neat one instruction fix for continuations on the SPARC. It flushes the register windows so diff --git a/crs.c b/crs.c old mode 100644 new mode 100755 index a2094f7..12c0223 --- a/crs.c +++ b/crs.c @@ -249,9 +249,10 @@ SCM owidth(arg) { if (UNBNDP(arg)) arg = cur_outp; ASRTER(NIMP(arg) && OPOUTPORTP(arg), arg, ARG1, s_owidth); - if (NIMP(*loc_stdscr)) + if (NIMP(*loc_stdscr)) { if (WINP(arg)) return MAKINUM(WIN(arg)->_maxx+1); else return MAKINUM(COLS); + } return MAKINUM(80); } SCM oheight(arg) diff --git a/debug.c b/debug.c old mode 100644 new mode 100755 diff --git a/differ.c b/differ.c old mode 100644 new mode 100755 index d0462bb..fcff12e --- a/differ.c +++ b/differ.c @@ -23,6 +23,15 @@ #include "scm.h" +#ifdef __x86_64 +# define I32 int +#else +# define I32 long +#endif +/* Currently A:fixZ32b are actually A:fixZ64b. Remove next line when + this gets fixed. */ +#define I32 long + SCM_EXPORT SCM array_dims P((SCM ra)); typedef int (*int_function) (); @@ -33,19 +42,19 @@ typedef struct { int_function array_refs_revEql_P; } fp_procs; -int fp_compare(int *fp,int fpoff,int *cc,void *a,int m,void *b,int n,int_function array_refsEql_P,int p_lim); +int fp_compare(I32 *fp,int fpoff,I32 *cc,void *a,int m,void *b,int n,int_function array_refsEql_P,int p_lim); -int fp_run(int *fp,int fpoff,int k,void *a,int m,void *b,int n,int_function array_refsEql_P,int *cc,int p); +int fp_run(I32 *fp,int fpoff,int k,void *a,int m,void *b,int n,int_function array_refsEql_P,I32 *cc,int p); -int diff_mid_split(int n,int *rr,int *cc,int cost); +int diff_mid_split(int n,I32 *rr,I32 *cc,int cost); -void fp_init(int *fp,int fpoff,int fill,int mindx,int maxdx); +void fp_init(I32 *fp,int fpoff,int fill,int mindx,int maxdx); -int diff_divide_and_conquer(int *fp,int fpoff,int *ccrr,void *a,int start_a,int end_a,void *b,int start_b,int end_b,int *edits,int edx,int epo,fp_procs *procs,int p_lim); +int diff_divide_and_conquer(I32 *fp,int fpoff,I32 *ccrr,void *a,int start_a,int end_a,void *b,int start_b,int end_b,I32 *edits,int edx,int epo,fp_procs *procs,int p_lim); -int diff2et(int *fp,int fpoff,int *ccrr,void *a,int start_a,int end_a,void *b,int start_b,int end_b,int *edits,int edx,int epo,fp_procs *procs,int p_lim); +int diff2et(I32 *fp,int fpoff,I32 *ccrr,void *a,int start_a,int end_a,void *b,int start_b,int end_b,I32 *edits,int edx,int epo,fp_procs *procs,int p_lim); -int diff2ez(int *fp,int fpoff,int *ccrr,void *a,int start_a,int end_a,void *b,int start_b,int end_b,int *edits,int edx,int epo,fp_procs *procs,int p_lim); +int diff2ez(I32 *fp,int fpoff,I32 *ccrr,void *a,int start_a,int end_a,void *b,int start_b,int end_b,I32 *edits,int edx,int epo,fp_procs *procs,int p_lim); void check_cost(unsigned char *name,int est,int cost); @@ -53,11 +62,11 @@ SCM_EXPORT SCM diff2edits P((SCM Edits, SCM Fp, SCM Args)); SCM_EXPORT SCM diff2editlen P((SCM Fp, SCM A, SCM Args)); -# define MAX(a,b) (ab ? b : a) +#define MAX(a,b) (ab ? b : a) -long *long_subarray(ra, start, end) - long *ra; int start, end; +I32 *long_subarray(ra, start, end) + I32 *ra; int start, end; { return &(ra[start]); } @@ -72,36 +81,36 @@ char *char_subarray(ra, start, end) return &(ra[start]); } -long long_array_refsEql_P(a, x, m, b, y, n) - long *a; int x, m; long *b; int y, n; +int long_array_refsEql_P(a, x, m, b, y, n) + I32 *a; int x, m; I32 *b; int y, n; { return (a[x])==(b[y]); } -long long_array_refs_revEql_P(a, x, m, b, y, n) - long *a; int x, m; long *b; int y, n; +int long_array_refs_revEql_P(a, x, m, b, y, n) + I32 *a; int x, m; I32 *b; int y, n; { /* if (x > m) printf("long x(%d) > m(%d)\n", x, m); */ /* if (y > n) printf("long y(%d) > n(%d)\n", y, n); */ return a[(m)-(x)-1]==b[(n)-(y)-1]; } -short short_array_refsEql_P(a, x, m, b, y, n) +int short_array_refsEql_P(a, x, m, b, y, n) short *a; int x, m; short *b; int y, n; { return (a[x])==(b[y]); } -short short_array_refs_revEql_P(a, x, m, b, y, n) +int short_array_refs_revEql_P(a, x, m, b, y, n) short *a; int x, m; short *b; int y, n; { /* if (x > m) printf("short x(%d) > m(%d)\n", x, m); */ /* if (y > n) printf("short y(%d) > n(%d)\n", y, n); */ return a[(m)-(x)-1]==b[(n)-(y)-1]; } -char char_array_refsEql_P(a, x, m, b, y, n) +int char_array_refsEql_P(a, x, m, b, y, n) char *a; int x, m; char *b; int y, n; { return (a[x])==(b[y]); } -char char_array_refs_revEql_P(a, x, m, b, y, n) +int char_array_refs_revEql_P(a, x, m, b, y, n) char *a; int x, m; char *b; int y, n; { /* if (x > m) printf("char x(%d) > m(%d)\n", x, m); */ @@ -110,16 +119,22 @@ char char_array_refs_revEql_P(a, x, m, b, y, n) } fp_procs long_procs = - {long_subarray, long_array_refsEql_P, long_array_refs_revEql_P}; + {long_subarray, + long_array_refsEql_P, + long_array_refs_revEql_P}; fp_procs short_procs = - {short_subarray, short_array_refsEql_P, short_array_refs_revEql_P}; + {short_subarray, + short_array_refsEql_P, + short_array_refs_revEql_P}; fp_procs char_procs = - {char_subarray, char_array_refsEql_P, char_array_refs_revEql_P}; + {char_subarray, + char_array_refsEql_P, + char_array_refs_revEql_P}; int fp_compare(fp, fpoff, cc, a, m, b, n, array_refsEql_P, p_lim) - int *fp; + I32 *fp; int fpoff; - int *cc; + I32 *cc; void *a; int m; void *b; @@ -170,7 +185,7 @@ L_loop: /* Returns furthest y reached. */ int fp_run(fp, fpoff, k, a, m, b, n, array_refsEql_P, cc, p) - int *fp; + I32 *fp; int fpoff; int k; void *a; @@ -178,7 +193,7 @@ int fp_run(fp, fpoff, k, a, m, b, n, array_refsEql_P, cc, p) void *b; int n; int_function array_refsEql_P; - int *cc; + I32 *cc; int p; { int cost = (k)+(p)+(p); @@ -212,8 +227,8 @@ L_snloop: int diff_mid_split(n, rr, cc, cost) int n; - int *rr; - int *cc; + I32 *rr; + I32 *cc; int cost; { { @@ -234,7 +249,7 @@ L_loop: void fp_init(fp, fpoff, fill, mindx, maxdx) - int *fp; + I32 *fp; int fpoff; int fill; int mindx; @@ -257,16 +272,16 @@ void fp_init(fp, fpoff, fill, mindx, maxdx) /* EPO is insert/delete polarity (+1 or -1) */ int diff_divide_and_conquer(fp, fpoff, ccrr, a, start_a, end_a, b, start_b, end_b, edits, edx, epo, procs, p_lim) - int *fp; + I32 *fp; int fpoff; - int *ccrr; + I32 *ccrr; void *a; int start_a; int end_a; void *b; int start_b; int end_b; - int *edits; + I32 *edits; int edx; int epo; fp_procs *procs; @@ -277,8 +292,8 @@ int diff_divide_and_conquer(fp, fpoff, ccrr, a, start_a, end_a, b, start_b, end_ int len_a = (end_a)-(start_a); { int tcst = (p_lim)+(p_lim)+((len_b)-(len_a)); - int *cc = &(ccrr[0]); - int *rr = &(ccrr[(len_b)+1]); + I32 *cc = &(ccrr[0]); + I32 *rr = &(ccrr[(len_b)+1]); int m2 = (end_a)-(mid_a); int m1 = (mid_a)-(start_a); fp_init(cc, 0, (len_a)+(len_b), 0, len_b); @@ -289,8 +304,8 @@ int diff_divide_and_conquer(fp, fpoff, ccrr, a, start_a, end_a, b, start_b, end_ fp_compare(fp, fpoff, rr, procs->subarray(a, mid_a, end_a), m2, procs->subarray(b, start_b, end_b), len_b, procs->array_refs_revEql_P, MIN(p_lim, len_a)); { int b_splt = diff_mid_split(len_b, rr, cc, tcst); - int est_c = cc[b_splt]; - int est_r = rr[(len_b)-(b_splt)]; + I32 est_c = cc[b_splt]; + I32 est_r = rr[(len_b)-(b_splt)]; check_cost("cc", est_c, diff2et(fp, fpoff, ccrr, a, start_a, mid_a, b, start_b, (start_b)+(b_splt), edits, edx, epo, procs, ((est_c)-((b_splt)-((mid_a)-(start_a))))/2)); check_cost("rr", est_r, diff2et(fp, fpoff, ccrr, a, mid_a, end_a, b, (start_b)+(b_splt), end_b, edits, (est_c)+(edx), epo, procs, ((est_r)-(((len_b)-(b_splt))-((end_a)-(mid_a))))/2)); return (est_c)+(est_r); @@ -301,16 +316,16 @@ int diff_divide_and_conquer(fp, fpoff, ccrr, a, start_a, end_a, b, start_b, end_ /* Trim; then diff sub-arrays; either one longer. Returns edit-length */ int diff2et(fp, fpoff, ccrr, a, start_a, end_a, b, start_b, end_b, edits, edx, epo, procs, p_lim) - int *fp; + I32 *fp; int fpoff; - int *ccrr; + I32 *ccrr; void *a; int start_a; int end_a; void *b; int start_b; int end_b; - int *edits; + I32 *edits; int edx; int epo; fp_procs *procs; @@ -351,16 +366,16 @@ int diff2et(fp, fpoff, ccrr, a, start_a, end_a, b, start_b, end_b, edits, edx, e /* Diff sub-arrays, A not longer than B. Returns edit-length */ int diff2ez(fp, fpoff, ccrr, a, start_a, end_a, b, start_b, end_b, edits, edx, epo, procs, p_lim) - int *fp; + I32 *fp; int fpoff; - int *ccrr; + I32 *ccrr; void *a; int start_a; int end_a; void *b; int start_b; int end_b; - int *edits; + I32 *edits; int edx; int epo; fp_procs *procs; @@ -472,7 +487,7 @@ void* array2addr(RA, prot, pos, s_name) { ASRTER(BOOL_T==arrayp(RA, UNDEFINED) && array_prot(RA)==prot, RA, pos, s_name); - return (void*)scm_addr(cons(RA, list_of_0), s_name); + return scm_addr(cons(RA, list_of_0), s_name); } /* A not longer than B (M <= N) */ @@ -482,10 +497,10 @@ SCM diff2edits(Edits, Fp, Args) SCM Edits, Fp, Args; /* Ccrr, A, B; */ { SCM aprot, bprot; - int *edits; + I32 *edits; int est; - int *fp; - int *ccrr; + I32 *fp; + I32 *ccrr; void *a, *b; int m, n; fp_procs *procs; @@ -525,7 +540,7 @@ SCM diff2editlen(Fp, A, Args) fp_procs *procs; int p_lim; int m, n; - int *fp; + I32 *fp; void *a, *b; ASRTER(2==ilength(Args), Args, WNA, s_d2el); fp = array2addr(Fp, MAKINUM(-32), ARG1, s_d2el); diff --git a/disarm.scm b/disarm.scm old mode 100644 new mode 100755 diff --git a/dynl.c b/dynl.c old mode 100644 new mode 100755 index 171670b..f63e05b --- a/dynl.c +++ b/dynl.c @@ -374,7 +374,7 @@ SCM l_dyn_link(fname) DEFER_INTS; handle = dlopen(CHARS(fname), DLOPEN_MODE); if (NULL==handle) { - if (verbose > 1) { + if (scm_verbose > 1) { char *dlr = dlerror(); ALLOW_INTS; if (dlr) { @@ -444,7 +444,7 @@ SCM l_dyn_main_call(symb, shl, args) argv = makargvfrmstrs(args, s_main_call); ALLOW_INTS; /* *loc_loadpath = linkpath; */ - i = (*func) ((int)ilength(args), argv); + i = (*func) ((int)ilength(args), (const char**)argv); /* *loc_loadpath = oloadpath; */ DEFER_INTS; must_free_argv(argv); diff --git a/ecrt0.c b/ecrt0.c old mode 100644 new mode 100755 diff --git a/edline.c b/edline.c old mode 100644 new mode 100755 diff --git a/eval.c b/eval.c old mode 100644 new mode 100755 index 407efc4..eda526d --- a/eval.c +++ b/eval.c @@ -116,7 +116,6 @@ SCM m_letrec P((SCM xorig, SCM env, SCM ctxt)); SCM m_let P((SCM xorig, SCM env, SCM ctxt)); SCM m_apply P((SCM xorig, SCM env, SCM ctxt)); SCM m_syn_quote P((SCM xorig, SCM env, SCM ctxt)); -SCM m_define_syntax P((SCM xorig, SCM env, SCM ctxt)); SCM m_let_syntax P((SCM xorig, SCM env, SCM ctxt)); SCM m_letrec_syntax P((SCM xorig, SCM env, SCM ctxt)); SCM m_the_macro P((SCM xorig, SCM env, SCM ctxt)); @@ -130,7 +129,7 @@ static SCM *lookupcar P((SCM vloc)); static SCM scm_lookupval P((SCM vloc, int memo)); static SCM asubr_apply P((SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args)); static SCM ceval_1 P((SCM x)); -static SCM evalatomcar P((SCM x, int toplevelp)); +static SCM evalatomcar P((SCM x, int no_error)); static SCM evalcar P((SCM x)); static SCM id2sym P((SCM id)); static SCM iqq P((SCM form)); @@ -577,9 +576,9 @@ static SCM scm_lookupval(vloc, memo) } /* CAR(x) is known to be a cell but not a cons */ -static SCM evalatomcar(x, toplevelp) +static SCM evalatomcar(x, no_error) SCM x; - int toplevelp; + int no_error; { SCM ret; switch TYP7(CAR(x)) { @@ -597,7 +596,7 @@ static SCM evalatomcar(x, toplevelp) switch (MAC_TYPE(mac) & ~MAC_PRIMITIVE) { default: #ifdef MACRO - if (!toplevelp) + if (!no_error) everr(x, argv[1], argv[0], s_badkey, "", 0); #endif return ret; @@ -610,7 +609,7 @@ static SCM evalatomcar(x, toplevelp) return ret; case tc7_vector: #ifndef RECKLESS - if (2 <= verbose) scm_warn("unquoted ", s_vector, CAR(x)); + if (2 <= scm_verbose) scm_warn("unquoted ", s_vector, CAR(x)); #endif ret = cons2(IM_QUOTE, CAR(x), EOL); CAR(x) = ret; @@ -1490,14 +1489,14 @@ static void checked_define(name, val, what) if ('@'==CHARS(name)[0] && UNDEFINED != old) scm_warn(s_redefining, "internal name ", name); if (KEYWORDP(old)) { - if (1 <= verbose && built_inp(name, KEYWORD_MACRO(old))) + if (1 <= scm_verbose && built_inp(name, KEYWORD_MACRO(old))) scm_warn(s_redefining, s_built_in_syntax, name); - else if (3 <= verbose) + else if (3 <= scm_verbose) scm_warn(s_redefining, s_syntax, name); } - else if (2 <= verbose && built_inp(name, old) && (old != val)) + else if (2 <= scm_verbose && built_inp(name, old) && (old != val)) scm_warn(s_redefining, "built-in ", name); - else if (5 <= verbose && UNDEFINED != old) + else if (5 <= scm_verbose && UNDEFINED != old) scm_warn(s_redefining, "", name); #endif CDR(vcell) = val; @@ -1657,7 +1656,9 @@ static SCM m_body(xorig, env, ctxt) } ASSYNT(ilength(x) > 0, xorig, s_body, what); if (IMP(defs)) return x; - return cons(m_letrec1(IM_DEFINE, cons2(i_define, defs, x), env, ctxt), EOL); + return + cons(m_letrec1(IM_DEFINE, cons2(i_define, reverse(defs), x), env, ctxt), + EOL); } static SCM m_binding(name, value, env, ctxt) @@ -1746,18 +1747,19 @@ static SCM macroexp1(xorig, env, ctxt, mode) MACROEXP_TRACE(xorig, env); #endif x = scm_check_linum(xorig, &linum); - if (IMP(x) || NCONSP(x)) { /* Happens for unquoted vectors. */ + if (IMP(x) || VECTORP(x)) { /* Happens for unquoted vectors. */ if (NIMP(x)) x = evalatomcar(cons(x, EOL), 0); x = cons2(IM_QUOTE, x, EOL); goto retx; } - else if (IDENTP(x)) { /* Happens for @macroexpand1 */ + else if (IDENTP(x)) { /* Happens for @macroexpand1 */ + ASRTER(0==mode, x, "macroexp1", "internal error"); proc = x; - x = cons(proc, EOL); } - else + else { proc = CAR(x); + } ASRTGO(NIMP(proc), errout); if (CONSP(proc)) { if (mode < 3) { @@ -2071,7 +2073,7 @@ SCM scm_apply_cxr(proc, arg1) } # ifdef BIGDIG if (BIGP(arg1)) { - y = DSUBRF(proc)(big2dbl(arg1)); + y = DSUBRF(proc)(int2dbl(arg1)); goto ret; } # endif @@ -2685,13 +2687,13 @@ evap1: goto apply4; /* Jumping to apply code results in extra list copy for >=3 args, but we want to minimize bloat. */ } + case tc7_contin: + scm_dynthrow(proc, arg1, arg2, EOL); case tc7_subr_0: case tc7_cxr: case tc7_subr_1o: case tc7_subr_1: case tc7_subr_3: - case tc7_contin: - scm_dynthrow(proc, arg1, arg2, EOL); goto wrongnumargs; default: goto badfun; @@ -3252,14 +3254,21 @@ static char s_macroexpand1[] = "@macroexpand1"; SCM scm_macroexpand1(x, env) SCM x, env; { - SCM name; + SCM proc; if (IMP(x)) return BOOL_F; if (CONSP(x)) { - name = CAR(x); - if (IMP(name) || !IDENTP(name)) return BOOL_F; /* probably an error */ + proc = CAR(x); + if (IMP(proc) || !IDENTP(proc)) return BOOL_F; /* probably an error */ } else if (IDENTP(x)) { - name = x; + proc = scm_env_lookup(x, env); + if (IMP(proc)) /* local binding */ + return BOOL_F; + if (SYMBOLP(proc)) { /* global variable */ + proc = CDR(sym2vcell(proc)); + if (!KEYWORDP(proc)) + return BOOL_F; + } } else return BOOL_F; diff --git a/example.scm b/example.scm old mode 100644 new mode 100755 diff --git a/fdl.texi b/fdl.texi old mode 100644 new mode 100755 index 6c91624..8805f1a --- a/fdl.texi +++ b/fdl.texi @@ -1,12 +1,12 @@ @c The GNU Free Documentation License. -@center Version 1.2, November 2002 +@center Version 1.3, 3 November 2008 @c This file is intended to be included within another document, @c hence no sectioning command or @node. @display -Copyright @copyright{} 2000,2001,2002 Free Software Foundation, Inc. -51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA +Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. +@uref{http://fsf.org/} Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -111,6 +111,9 @@ formats which do not have any title page as such, ``Title Page'' means the text near the most prominent appearance of the work's title, preceding the beginning of the body of the text. +The ``publisher'' means any person or entity that distributes copies +of the Document to the public. + A section ``Entitled XYZ'' means a named subunit of the Document whose title either is precisely XYZ or contains XYZ in parentheses following text that translates XYZ in another language. (Here XYZ stands for a @@ -379,13 +382,30 @@ title. @item TERMINATION -You may not copy, modify, sublicense, or distribute the Document except -as expressly provided for under this License. Any other attempt to -copy, modify, sublicense or distribute the Document is void, and will -automatically terminate your rights under this License. However, -parties who have received copies, or rights, from you under this -License will not have their licenses terminated so long as such -parties remain in full compliance. +You may not copy, modify, sublicense, or distribute the Document +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense, or distribute it is void, and +will automatically terminate your rights under this License. + +However, if you cease all violation of this License, then your license +from a particular copyright holder is reinstated (a) provisionally, +unless and until the copyright holder explicitly and finally +terminates your license, and (b) permanently, if the copyright holder +fails to notify you of the violation by some reasonable means prior to +60 days after the cessation. + +Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + +Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, receipt of a copy of some or all of the same material does +not give you any rights to use it. @item FUTURE REVISIONS OF THIS LICENSE @@ -403,7 +423,42 @@ following the terms and conditions either of that specified version or of any later version that has been published (not as a draft) by the Free Software Foundation. If the Document does not specify a version number of this License, you may choose any version ever published (not -as a draft) by the Free Software Foundation. +as a draft) by the Free Software Foundation. If the Document +specifies that a proxy can decide which future versions of this +License can be used, that proxy's public statement of acceptance of a +version permanently authorizes you to choose that version for the +Document. + +@item +RELICENSING + +``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any +World Wide Web server that publishes copyrightable works and also +provides prominent facilities for anybody to edit those works. A +public wiki that anybody can edit is an example of such a server. A +``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the +site means any set of copyrightable works thus published on the MMC +site. + +``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0 +license published by Creative Commons Corporation, a not-for-profit +corporation with a principal place of business in San Francisco, +California, as well as future copyleft versions of that license +published by that same organization. + +``Incorporate'' means to publish or republish a Document, in whole or +in part, as part of another Document. + +An MMC is ``eligible for relicensing'' if it is licensed under this +License, and if all works that were first published under this License +somewhere other than this MMC, and subsequently incorporated in whole +or in part into the MMC, (1) had no cover texts or invariant sections, +and (2) were thus incorporated prior to November 1, 2008. + +The operator of an MMC Site may republish an MMC contained in the site +under CC-BY-SA on the same site at any time before August 1, 2009, +provided the MMC is eligible for relicensing. + @end enumerate @page @@ -417,7 +472,7 @@ license notices just after the title page: @group Copyright (C) @var{year} @var{your name}. Permission is granted to copy, distribute and/or modify this document - under the terms of the GNU Free Documentation License, Version 1.2 + under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the section entitled ``GNU @@ -448,3 +503,4 @@ to permit their use in free software. @c Local Variables: @c ispell-local-pdict: "ispell-dict" @c End: + diff --git a/features.txi b/features.txi old mode 100644 new mode 100755 index 83afb22..417c25d --- a/features.txi +++ b/features.txi @@ -197,6 +197,10 @@ nice, acct, lstat, readlink, symlink, mknod and sync. @cindex wb WB database with relational wrapper. +@item wb-no-threads +@cindex wb-no-threads +no-comment + @item windows @cindex windows Microsoft Windows executable. diff --git a/findexec.c b/findexec.c old mode 100644 new mode 100755 index a562077..5be7f54 --- a/findexec.c +++ b/findexec.c @@ -1,5 +1,6 @@ /* "findexec.c" was part of DLD, a dynamic link/unlink editor for C. - * Copyright (C) 1990 by W. Wilson Ho. + * Copyright (C) 1990 Free Software Foundation + * Author: W. Wilson Ho. * * GNU Emacs is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as @@ -148,6 +149,7 @@ static char *copy_of(s) # define ABSOLUTE_FILENAME_P(fname) (fname[0] == '/') # endif /* atarist */ +/* Return 0 if getcwd() returns 0. */ char *dld_find_executable(name) const char *name; { @@ -160,7 +162,7 @@ char *dld_find_executable(name) if (strchr(name, '/')) { strcpy (tbuf, "."); /* in case getcwd doesn't work */ - getcwd(tbuf, MAXPATHLEN); + if (!getcwd(tbuf, MAXPATHLEN)) return (char *)0L; if ((name[0] == '.') && (name[1] == '/')) { strcat(tbuf, name + 1); } else { @@ -190,8 +192,9 @@ char *dld_find_executable(name) *next = 0; if (*p) p++; - if (tbuf[0] == '.' && tbuf[1] == 0) - getcwd(tbuf, MAXPATHLEN); /* was getwd(tbuf); */ + if (tbuf[0] == '.' && tbuf[1] == 0) { + if (!getcwd(tbuf, MAXPATHLEN)) return (char *)0L; + } else if (tbuf[0]=='~' && tbuf[1]==0 && getenv("HOME")) strcpy(tbuf, (char *)getenv("HOME")); diff --git a/get-contoffset-ia64.c b/get-contoffset-ia64.c old mode 100644 new mode 100755 diff --git a/gmalloc.c b/gmalloc.c old mode 100644 new mode 100755 diff --git a/grtest.scm b/grtest.scm deleted file mode 100644 index 7401308..0000000 --- a/grtest.scm +++ /dev/null @@ -1,82 +0,0 @@ - -; This is a quick hack to test the graphics primitives. -; The SLIB scheme library is needed for random. -; IMHO, the syntax of `do' in scheme is horrible! -; - sjm - -(define (grtest) - (require 'random) ; needs SLIB - (graphics-mode!) - - (display "testing draw-to") (newline) - (clear-graphics!) - (goto-center!) - (do ((x 0 (+ x 3))) - ((> x (max-x)) 0) - (set-color! (remainder (/ x 3) (max-color))) - (draw-to x 0) - (draw-to x (max-y)) - ) - - (do ((y 0 (+ y 3))) - ((> y (max-y)) 0) - (set-color! (remainder (/ y 3) (max-color))) - (goto-center!) - (draw-to! 0 y) - (goto-center!) - (draw-to! (max-x) y) - ) - - (goto-nw!) - (do ((x 0 (+ x 2))) - ((> x (max-x)) 0) - (set-color! (remainder (/ x 2) (max-color))) - (draw-to x (max-y)) - ) - (do ((y (+ (max-y) 1) (- y 2))) - ((< y 0) 0) - (set-color! (remainder (/ y 2) (max-color))) - (draw-to (max-x) y) - ) - - (display "testing set-dot!") (newline) - (clear-graphics!) - (do ((x 0 (+ x 1))) - ((= x 100) 0) - (set-dot! (+ (random (max-x)) 1) (+ (random (max-y)) 1) - (+ (random (max-color)) 1)) - ) - - (display "testing draw with turn-to!") (newline) - (clear-graphics!) - (goto-center!) - (do ((x 0 (+ x 1))) - ((= x 100) 0) - (set-color! (+ (random (max-color)) 1)) - (turn-to! (random 360)) - (draw (random 50)) - ) - - (display "testing draw with turn-right") (newline) - (clear-graphics!) - (goto-center!) - (do ((x 0 (+ x 1))) - ((= x 100) 0) - (set-color! (+ (random (max-color)) 1)) - (turn-right (random 90)) - (draw (random 50)) - ) - - (display "testing draw with turn-left") (newline) - (clear-graphics!) - (goto-center!) - (do ((x 0 (+ x 1))) - ((= x 100) 0) - (set-color! (+ (random (max-color)) 1)) - (turn-left (random 90)) - (draw (random 50)) - ) - - (text-mode!) -) - diff --git a/gsubr.c b/gsubr.c old mode 100644 new mode 100755 diff --git a/hobbit.info b/hobbit.info old mode 100644 new mode 100755 index 4d7bc15..b75805d --- a/hobbit.info +++ b/hobbit.info @@ -1,7 +1,7 @@ -This is hobbit.info, produced by makeinfo version 4.8 from hobbit.texi. +This is hobbit.info, produced by makeinfo version 4.13 from hobbit.texi. -This manual is for the Hobbit compiler for SCM (version 5e5, February -2008), +This manual is for the Hobbit compiler for SCM (version 5f2, January +2015), Copyright (C) 2002 Free Software Foundation @@ -30,8 +30,8 @@ File: hobbit.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) Hobbit ****** -This manual is for the Hobbit compiler for SCM (version 5e5, February -2008), +This manual is for the Hobbit compiler for SCM (version 5f2, January +2015), Copyright (C) 2002 Free Software Foundation @@ -82,14 +82,14 @@ primitives. Hobbit compiles scheme files to C files and does not provide anything else by itself (eg. calling the C compiler, dynamic loading). Such -niceties are described in the next chapter *Note Compiling And +niceties are described in the next chapter *note Compiling And Linking::. Hobbit (derived from hobbit5x) is now part of the SCM Scheme implementation. The most recent information about SCM can be found on SCM's "WWW" home page: - `http://swiss.csail.mit.edu/~jaffer/SCM' + `http://people.csail.mit.edu/jaffer/SCM' Hobbit4d has also been ported to the Guile Scheme implementation: @@ -131,7 +131,7 @@ File: hobbit.info, Node: Compiling And Linking, Next: Error Detection, Prev: the `build' invocation which compiles the `c' files. cd ~/scm/ - scm -rcompile -e'(compile-file "example.scm")' + scm -rcompile -e"(compile-file \"example.scm\")" Starting to read example.scm @@ -160,7 +160,7 @@ File: hobbit.info, Node: Compiling And Linking, Next: Error Detection, Prev: (lambda (fp) (for-each (lambda (string) (write-line string fp)) - '("#define IMPLINIT \"Init5e5.scm\"" + '("#define IMPLINIT \"Init5f2.scm\"" "#define BIGNUMS" "#define FLOATS" "#define ARRAYS" @@ -183,7 +183,7 @@ File: hobbit.info, Node: Compiling And Linking, Next: Error Detection, Prev: to the `build' invocation which compiles the `c' files. cd ~/scm/ - scm -rcompile -e'(compile->executable "exscm" "example.scm")' + scm -rcompile -e"(compile->executable \"exscm\" \"example.scm\")" Starting to read example.scm @@ -212,7 +212,7 @@ File: hobbit.info, Node: Compiling And Linking, Next: Error Detection, Prev: (lambda (fp) (for-each (lambda (string) (write-line string fp)) - '("#define IMPLINIT \"Init5e5.scm\"" + '("#define IMPLINIT \"Init5f2.scm\"" "#define COMPILED_INITS init_example();" "#define CCLO" "#define FLOATS")))) @@ -301,7 +301,7 @@ File: hobbit.info, Node: Hobbit Options, Next: CC Optimizations, Prev: Error %negative? %number? %> %>= %= %<= %< %positive? %zero? %eqv? %+ %- %* %/ - See *Note The Language Compiled::. + See *note The Language Compiled::. 2. Redefinition of procedures. @@ -1702,8 +1702,8 @@ File: hobbit.info, Node: Author and Contributors, Next: Future Improvements, University of Go"teborg S-41296 Go"teborg Sweden -A. Jaffer (agj @ alum.mit.edu), the author of SCM, has been of major -help with a number of suggestions and hacks, especially concerning the +A. Jaffer (agj@alum.mit.edu), the author of SCM, has been of major help +with a number of suggestions and hacks, especially concerning the interface between compiled code and the SCM interpreter. Several people have helped with suggestions and detailed bug reports, @@ -1778,10 +1778,10 @@ hobbit4c: hobbit4b: The following bugs have been fixed: * Erroneous treatment of [ and ] inside symbols, reported by A. - Jaffer (agj @ alum.mit.edu). + Jaffer (agj@alum.mit.edu). - * A bug in the liftability analysis, reported by A. Jaffer (agj - @ alum.mit.edu). + * A bug in the liftability analysis, reported by A. Jaffer + (agj@alum.mit.edu). * A bug occurring in case arguments are evaluated right-to-left, which happens with Hobbit compiled by gcc on GNU/Linux. @@ -1954,45 +1954,45 @@ Index  Tag Table: Node: Top1024 -Node: Introduction2113 -Node: Compiling with Hobbit3429 -Node: Compiling And Linking3687 -Node: Error Detection8373 -Node: Hobbit Options9679 -Node: CC Optimizations16411 -Node: The Language Compiled17367 -Node: Macros18026 -Node: SCM Primitive Procedures18630 -Node: SLIB Logical Procedures19552 -Node: Fast Integer Calculations20707 -Node: Force and Delay21841 -Node: Suggestions for writing fast code22426 -Node: Performance of Compiled Code32625 -Node: Gain in Speed32885 -Node: Benchmarks34470 -Node: Benchmark Sources37570 -Node: Destruct37916 -Node: Recfib39503 -Node: div-iter and div-rec39758 -Node: Hanoi40844 -Node: Tak41425 -Node: Ctak41780 -Node: Takl42760 -Node: Cpstak43416 -Node: Pi44195 -Node: Principles of Compilation45328 -Node: Macro-Expansion and Analysis45754 -Node: Building Closures49559 -Node: Lambda-lifting52450 -Node: Statement-lifting55181 -Node: Higher-order Arglists56289 -Node: Typing and Constants58095 -Node: About Hobbit59359 -Node: The Aims of Developing Hobbit59619 -Node: Manifest60510 -Node: Author and Contributors60969 -Node: Future Improvements62024 -Node: Release History62789 -Node: Index69591 +Node: Introduction2112 +Node: Compiling with Hobbit3428 +Node: Compiling And Linking3686 +Node: Error Detection8378 +Node: Hobbit Options9684 +Node: CC Optimizations16416 +Node: The Language Compiled17372 +Node: Macros18031 +Node: SCM Primitive Procedures18635 +Node: SLIB Logical Procedures19557 +Node: Fast Integer Calculations20712 +Node: Force and Delay21846 +Node: Suggestions for writing fast code22431 +Node: Performance of Compiled Code32630 +Node: Gain in Speed32890 +Node: Benchmarks34475 +Node: Benchmark Sources37575 +Node: Destruct37921 +Node: Recfib39508 +Node: div-iter and div-rec39763 +Node: Hanoi40849 +Node: Tak41430 +Node: Ctak41785 +Node: Takl42765 +Node: Cpstak43421 +Node: Pi44200 +Node: Principles of Compilation45333 +Node: Macro-Expansion and Analysis45759 +Node: Building Closures49564 +Node: Lambda-lifting52455 +Node: Statement-lifting55186 +Node: Higher-order Arglists56294 +Node: Typing and Constants58100 +Node: About Hobbit59364 +Node: The Aims of Developing Hobbit59624 +Node: Manifest60515 +Node: Author and Contributors60974 +Node: Future Improvements62027 +Node: Release History62792 +Node: Index69590  End Tag Table diff --git a/hobbit.scm b/hobbit.scm old mode 100644 new mode 100755 index 1c0fa61..4e7d241 --- a/hobbit.scm +++ b/hobbit.scm @@ -199,6 +199,7 @@ case enum register typedef char extern return union const float short unsigned continue for signed void default goto sizeof volatile do if static while + system random exit ; Added by M.Ward ;;; Some things are commented out to make hobbit compile itself correctly. @@ -242,12 +243,12 @@ resizuve cons2r lnot booleanp eq equal consp cons nullp setcar setcdr listp list length append reverse list-ref memq memv member assq assv assoc symbolp symbol2string string2symbol numberp exactp - inexactp eqp lessp zerop positivep negativep oddp evenp lmax lmin sum + inexactp eqp lessp zerop positivep negativep oddp evenp scm_max scm_min sum product difference lquotient scm_abs remainder lremainder modulo lgcd llcm number2string ;;; string2number makdbl istr2flo mkbig long2big dbl2big - iint2str iflo2str floprint bigprint big2dbl charp char-lessp chci-eq + ilong2str iflo2str floprint bigprint int2dbl charp char-lessp chci-eq chci-lessp char-alphap char-nump char-whitep char-upperp char-lowerp char2int int2char char-upcase char-downcase stringp make-string string st-length st-ref st-set st-equal stci-equal st-lessp @@ -260,7 +261,7 @@ cur-input-port cur-output-port open-file open-pipe close-port close-pipe read-char peek-char eof-objectp scm_write scm_display scm_newline scm_write-char - file-position file-set-position scm_file-position lgetenv prog-args + file-position file-set-position scm_file-position scm_getenv prog-args makacro makmacro makmmacro remove ash round array-ref array_ref sin cos tan asin acos atan sinh cosh tanh asinh acosh atanh sqrt expt @@ -451,6 +452,7 @@ (#\. "_dot_") (#\* "_star_") (#\/ "_slash_") + (#\\ "_backsl_"); Added by M.Ward: (#\< "_less_") (#\= "_equal_") (#\> "_grtr_") @@ -1635,6 +1637,7 @@ (list 'lambda '() (list* 'let* '() + '(set! no-symhash-gc #t) (map list (reverse *splitted-init-function-names*)))))) @@ -2494,7 +2497,7 @@ (@copy-tree "copytree" 1) (exact? "exactp" 1) (inexact? "inexactp" 1) - (odd? "oddp" 1) (even? "evenp" 1) (max "lmax" 2) (min "lmin" 2) (abs "scm_abs" 1) + (odd? "oddp" 1) (even? "evenp" 1) (max "scm_max" 2) (min "scm_min" 2) (abs "scm_abs" 1) (quotient "lquotient" 2) (remainder "lremainder" 2) (modulo "modulo" 2) (gcd "lgcd" 2) (lcm "llcm" 2) diff --git a/hobbit.texi b/hobbit.texi old mode 100644 new mode 100755 index a04c8f8..2dd55aa --- a/hobbit.texi +++ b/hobbit.texi @@ -106,7 +106,7 @@ Hobbit (derived from hobbit5x) is now part of the SCM Scheme implementation. The most recent information about SCM can be found on SCM's @dfn{WWW} home page: -@center @url{http://swiss.csail.mit.edu/~jaffer/SCM} +@center @url{http://people.csail.mit.edu/jaffer/SCM} Hobbit4d has also been ported to the Guile Scheme implementation: @@ -149,7 +149,7 @@ files. @example cd ~/scm/ -scm -rcompile -e'(compile-file "example.scm")' +scm -rcompile -e"(compile-file \"example.scm\")" Starting to read example.scm @@ -206,7 +206,7 @@ files. @example cd ~/scm/ -scm -rcompile -e'(compile->executable "exscm" "example.scm")' +scm -rcompile -e"(compile->executable \"exscm\" \"example.scm\")" Starting to read example.scm @@ -1979,7 +1979,7 @@ University of Go"teborg@* S-41296 Go"teborg Sweden @end quotation -A. Jaffer (agj @@ alum.mit.edu), the author of SCM, has been of major +A. Jaffer (agj@@alum.mit.edu), the author of SCM, has been of major help with a number of suggestions and hacks, especially concerning the interface between compiled code and the SCM interpreter. @@ -2074,10 +2074,10 @@ The following bugs have been fixed: @itemize @bullet @item Erroneous treatment of [ and ] inside symbols, -reported by A. Jaffer (agj @@ alum.mit.edu). +reported by A. Jaffer (agj@@alum.mit.edu). @item A bug in the liftability analysis, -reported by A. Jaffer (agj @@ alum.mit.edu). +reported by A. Jaffer (agj@@alum.mit.edu). @item A bug occurring in case arguments are evaluated right-to-left, which happens with Hobbit compiled by gcc on GNU/Linux. diff --git a/inc2scm b/inc2scm index a7a05d2..c14035d 100755 --- a/inc2scm +++ b/inc2scm @@ -1,4 +1,4 @@ -#! /usr/local/bin/scm \ %0 %* +#! ./scmlit \ - !# ;;;; "inc2scm", Convert numeric C #defines to Scheme definitions. ;; Copyright (C) 1991-1999 Free Software Foundation, Inc. @@ -36,7 +36,7 @@ Usage: inc2scm defines.scm [pre:] [/usr/include/] file1.h file2.h ... /USR/INCLUDE/ defaults to /usr/include/. -http://swiss.csail.mit.edu/~jaffer/SCM +http://people.csail.mit.edu/jaffer/SCM " (current-error-port)) #f) diff --git a/indexes.texi b/indexes.texi old mode 100644 new mode 100755 diff --git a/ioext.c b/ioext.c old mode 100644 new mode 100755 index 2cc4dc0..abc0fd2 --- a/ioext.c +++ b/ioext.c @@ -569,6 +569,54 @@ SCM ren_fil(oldname, newname) return ans; #endif } +static char s_copy_file[] = "copy-file"; +SCM scm_copy_file(oldname, newname) + SCM oldname, newname; +{ + ASRTER(NIMP(oldname) && STRINGP(oldname), oldname, ARG1, s_copy_file); + ASRTER(NIMP(newname) && STRINGP(newname), newname, ARG2, s_copy_file); + { + FILE* fin = fopen(CHARS(oldname), "rb"); + FILE* fout; + unsigned char buff[1024]; + int cnt, retval = BOOL_T; + if (!fin) return BOOL_F; + fout = fopen(CHARS(newname), "wb"); + if (!fout) {fclose(fin); return BOOL_F;} + { +#ifndef THINK_C +# ifndef MCH_AMIGA +# ifndef vms + int i; + struct stat stat_temp; + struct utimbuf utm_tmp; + SYSCALL(i = fstat(fileno(fin), &stat_temp);); +# endif +# endif +#endif + while ((cnt = fread(buff, 1, 1024, fin))) { + if ((cnt > 0) && (cnt != fwrite(buff, 1, cnt, fout))) retval = BOOL_F; + } + if (!feof(fin)) retval = BOOL_F; + fclose(fin); + fclose(fout); +#ifndef THINK_C +# ifndef MCH_AMIGA +# ifndef vms + if (!i) { + utm_tmp.actime = stat_temp.st_atime; + utm_tmp.modtime = stat_temp.st_mtime; + SYSCALL(i = utime(CHARS(newname), &utm_tmp);); + } + if (i) return BOOL_F; +# endif +# endif +#endif + return retval; + } + } +} + static char s_fileno[] = "fileno"; SCM l_fileno(port) SCM port; @@ -754,6 +802,7 @@ static iproc subr1os[] = { static iproc subr2s[] = { {s_ren_fil, ren_fil}, + {s_copy_file, scm_copy_file}, #ifndef macintosh {s_access, l_access}, #endif @@ -859,9 +908,10 @@ void init_ioext() scm_ldstr("\n\ (define (file-exists? path) (access path \"r\"))\n\ (define (make-directory path)\n\ - (define umsk (umask 18))\n\ - (umask umsk)\n\ - (mkdir path (logxor #o777 umsk)))\n\ + (define umsk (umask #o022))\n\ + (let ((success? (mkdir path (logxor #o777 umsk))))\n\ + (umask umsk)\n\ + success?))\n\ (define current-directory getcwd)\n\ (define (directory-for-each proc dirname . args)\n\ (define dir (opendir (if (symbol? dirname)\n\ @@ -884,6 +934,14 @@ void init_ioext() (do ((filename (readdir dir) (readdir dir)))\n\ ((not filename) (closedir dir))\n\ (and (selector filename) (proc filename))))))\n\ +(define (directory*-for-each proc path-glob)\n\ + (define dir (pathname->vicinity path-glob))\n\ + (let ((glob (substring path-glob\n\ + (string-length dir)\n\ + (string-length path-glob))))\n\ + (directory-for-each proc\n\ + (if (equal? \"\" dir) \".\" dir)\n\ + glob)))\n\ (define (system->line command . tmp)\n\ (require 'filename)\n\ (cond ((null? tmp)\n\ diff --git a/keysymdef.scm b/keysymdef.scm old mode 100644 new mode 100755 index 5c7ca49..1315c13 --- a/keysymdef.scm +++ b/keysymdef.scm @@ -177,6 +177,9 @@ (define XK:ISO-Level3-Shift 65027) (define XK:ISO-Level3-Latch 65028) (define XK:ISO-Level3-Lock 65029) +(define XK:ISO-Level5-Shift 65041) +(define XK:ISO-Level5-Latch 65042) +(define XK:ISO-Level5-Lock 65043) (define XK:ISO-Group-Shift 65406) (define XK:ISO-Group-Latch 65030) (define XK:ISO-Group-Lock 65031) @@ -213,6 +216,7 @@ (define XK:dead-acute 65105) (define XK:dead-circumflex 65106) (define XK:dead-tilde 65107) +(define XK:dead-perispomeni 65107) (define XK:dead-macron 65108) (define XK:dead-breve 65109) (define XK:dead-abovedot 65110) @@ -229,6 +233,32 @@ (define XK:dead-hook 65121) (define XK:dead-horn 65122) (define XK:dead-stroke 65123) +(define XK:dead-abovecomma 65124) +(define XK:dead-psili 65124) +(define XK:dead-abovereversedcomma 65125) +(define XK:dead-dasia 65125) +(define XK:dead-doublegrave 65126) +(define XK:dead-belowring 65127) +(define XK:dead-belowmacron 65128) +(define XK:dead-belowcircumflex 65129) +(define XK:dead-belowtilde 65130) +(define XK:dead-belowbreve 65131) +(define XK:dead-belowdiaeresis 65132) +(define XK:dead-invertedbreve 65133) +(define XK:dead-belowcomma 65134) +(define XK:dead-currency 65135) +(define XK:dead-a 65152) +(define XK:dead-A 65153) +(define XK:dead-e 65154) +(define XK:dead-E 65155) +(define XK:dead-i 65156) +(define XK:dead-I 65157) +(define XK:dead-o 65158) +(define XK:dead-O 65159) +(define XK:dead-u 65160) +(define XK:dead-U 65161) +(define XK:dead-small-schwa 65162) +(define XK:dead-capital-schwa 65163) (define XK:First-Virtual-Screen 65232) (define XK:Prev-Virtual-Screen 65233) (define XK:Next-Virtual-Screen 65234) @@ -524,9 +554,9 @@ (define XK:nacute 497) (define XK:ncaron 498) (define XK:odoubleacute 501) -(define XK:udoubleacute 507) (define XK:rcaron 504) (define XK:uring 505) +(define XK:udoubleacute 507) (define XK:tcedilla 510) (define XK:abovedot 511) (define XK:Hstroke 673) @@ -587,32 +617,32 @@ (define XK:uogonek 1017) (define XK:utilde 1021) (define XK:umacron 1022) +(define XK:Wcircumflex 16777588) +(define XK:wcircumflex 16777589) +(define XK:Ycircumflex 16777590) +(define XK:ycircumflex 16777591) (define XK:Babovedot 16784898) (define XK:babovedot 16784899) (define XK:Dabovedot 16784906) -(define XK:Wgrave 16785024) -(define XK:Wacute 16785026) (define XK:dabovedot 16784907) -(define XK:Ygrave 16785138) (define XK:Fabovedot 16784926) (define XK:fabovedot 16784927) (define XK:Mabovedot 16784960) (define XK:mabovedot 16784961) (define XK:Pabovedot 16784982) -(define XK:wgrave 16785025) (define XK:pabovedot 16784983) -(define XK:wacute 16785027) (define XK:Sabovedot 16784992) -(define XK:ygrave 16785139) -(define XK:Wdiaeresis 16785028) -(define XK:wdiaeresis 16785029) (define XK:sabovedot 16784993) -(define XK:Wcircumflex 16777588) (define XK:Tabovedot 16785002) -(define XK:Ycircumflex 16777590) -(define XK:wcircumflex 16777589) (define XK:tabovedot 16785003) -(define XK:ycircumflex 16777591) +(define XK:Wgrave 16785024) +(define XK:wgrave 16785025) +(define XK:Wacute 16785026) +(define XK:wacute 16785027) +(define XK:Wdiaeresis 16785028) +(define XK:wdiaeresis 16785029) +(define XK:Ygrave 16785138) +(define XK:ygrave 16785139) (define XK:OE 5052) (define XK:oe 5053) (define XK:Ydiaeresis 5054) @@ -1770,3 +1800,83 @@ (define XK:braille-dots-1345678 16787709) (define XK:braille-dots-2345678 16787710) (define XK:braille-dots-12345678 16787711) +(define XK:Sinh-ng 16780674) +(define XK:Sinh-h2 16780675) +(define XK:Sinh-a 16780677) +(define XK:Sinh-aa 16780678) +(define XK:Sinh-ae 16780679) +(define XK:Sinh-aee 16780680) +(define XK:Sinh-i 16780681) +(define XK:Sinh-ii 16780682) +(define XK:Sinh-u 16780683) +(define XK:Sinh-uu 16780684) +(define XK:Sinh-ri 16780685) +(define XK:Sinh-rii 16780686) +(define XK:Sinh-lu 16780687) +(define XK:Sinh-luu 16780688) +(define XK:Sinh-e 16780689) +(define XK:Sinh-ee 16780690) +(define XK:Sinh-ai 16780691) +(define XK:Sinh-o 16780692) +(define XK:Sinh-oo 16780693) +(define XK:Sinh-au 16780694) +(define XK:Sinh-ka 16780698) +(define XK:Sinh-kha 16780699) +(define XK:Sinh-ga 16780700) +(define XK:Sinh-gha 16780701) +(define XK:Sinh-ng2 16780702) +(define XK:Sinh-nga 16780703) +(define XK:Sinh-ca 16780704) +(define XK:Sinh-cha 16780705) +(define XK:Sinh-ja 16780706) +(define XK:Sinh-jha 16780707) +(define XK:Sinh-nya 16780708) +(define XK:Sinh-jnya 16780709) +(define XK:Sinh-nja 16780710) +(define XK:Sinh-tta 16780711) +(define XK:Sinh-ttha 16780712) +(define XK:Sinh-dda 16780713) +(define XK:Sinh-ddha 16780714) +(define XK:Sinh-nna 16780715) +(define XK:Sinh-ndda 16780716) +(define XK:Sinh-tha 16780717) +(define XK:Sinh-thha 16780718) +(define XK:Sinh-dha 16780719) +(define XK:Sinh-dhha 16780720) +(define XK:Sinh-na 16780721) +(define XK:Sinh-ndha 16780723) +(define XK:Sinh-pa 16780724) +(define XK:Sinh-pha 16780725) +(define XK:Sinh-ba 16780726) +(define XK:Sinh-bha 16780727) +(define XK:Sinh-ma 16780728) +(define XK:Sinh-mba 16780729) +(define XK:Sinh-ya 16780730) +(define XK:Sinh-ra 16780731) +(define XK:Sinh-la 16780733) +(define XK:Sinh-va 16780736) +(define XK:Sinh-sha 16780737) +(define XK:Sinh-ssha 16780738) +(define XK:Sinh-sa 16780739) +(define XK:Sinh-ha 16780740) +(define XK:Sinh-lla 16780741) +(define XK:Sinh-fa 16780742) +(define XK:Sinh-al 16780746) +(define XK:Sinh-aa2 16780751) +(define XK:Sinh-ae2 16780752) +(define XK:Sinh-aee2 16780753) +(define XK:Sinh-i2 16780754) +(define XK:Sinh-ii2 16780755) +(define XK:Sinh-u2 16780756) +(define XK:Sinh-uu2 16780758) +(define XK:Sinh-ru2 16780760) +(define XK:Sinh-e2 16780761) +(define XK:Sinh-ee2 16780762) +(define XK:Sinh-ai2 16780763) +(define XK:Sinh-o2 16780764) +(define XK:Sinh-oo2 16780765) +(define XK:Sinh-au2 16780766) +(define XK:Sinh-lu2 16780767) +(define XK:Sinh-ruu2 16780786) +(define XK:Sinh-luu2 16780787) +(define XK:Sinh-kunddaliya 16780788) diff --git a/lastfile.c b/lastfile.c new file mode 100755 index 0000000..0e989ae --- /dev/null +++ b/lastfile.c @@ -0,0 +1,51 @@ +/* Mark end of data space to dump as pure, for GNU Emacs. + Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, + 2006, 2007 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 3 of the +License, 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. If not, see +. */ + + +/* How this works: + + Fdump_emacs dumps everything up to my_edata as text space (pure). + + The files of Emacs are written so as to have no initialized + data that can ever need to be altered except at the first startup. + This is so that those words can be dumped as sharable text. + + It is not possible to exercise such control over library files. + So it is necessary to refrain from making their data areas shared. + Therefore, this file is loaded following all the files of Emacs + but before library files. + As a result, the symbol my_edata indicates the point + in data space between data coming from Emacs and data + coming from libraries. +*/ + +#include "macosx-config.h" + +char my_edata[] = "End of SCM initialized data"; + +/* Help unexec locate the end of the .bss area used by Emacs (which + isn't always a separate section in NT executables). */ +char my_endbss[1]; + +/* The Alpha MSVC linker globally segregates all static and public bss + data, so we must take both into account to determine the true extent + of the bss area used by Emacs. */ +static char _my_endbss[1]; +char * my_endbss_static = _my_endbss; diff --git a/macosx-config.h b/macosx-config.h new file mode 100755 index 0000000..0c45387 --- /dev/null +++ b/macosx-config.h @@ -0,0 +1,1175 @@ +/* src/config.h. Generated from config.in by configure. */ +/* src/config.in. Generated from configure.in by autoheader. */ + +/* GNU Emacs site configuration template file. + Copyright (C) 1988, 1993, 1994, 1999, 2000, 2001, 2002, 2004, 2005, 2006, 2007 + 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 3 of the +License, 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. If not, see +. */ + + +/* No code in Emacs #includes config.h twice, but some bits of code + intended to work with other packages as well (like gmalloc.c) + think they can include it as many times as they like. */ +#ifndef EMACS_CONFIG_H +#define EMACS_CONFIG_H + + +/* Define to 1 if the mktime function is broken. */ +/* #undef BROKEN_MKTIME */ + +/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP + systems. This function is required for `alloca.c' support on those systems. + */ +/* #undef CRAY_STACKSEG_END */ + +/* Define to 1 if using `alloca.c'. */ +/* #undef C_ALLOCA */ + +/* Define to 1 if using `getloadavg.c'. */ +/* #undef C_GETLOADAVG */ + +/* Define C_SWITCH_X_SITE to contain any special flags your compiler may need + to deal with X Windows. For instance, if you've defined HAVE_X_WINDOWS + above and your X include files aren't in a place that your compiler can + find on its own, you might want to add "-I/..." or something similar. */ +#define C_SWITCH_X_SITE + +/* Define to 1 for DGUX with . */ +/* #undef DGUX */ + +/* Define to 1 if you are using the GNU C Library. */ +/* #undef DOUG_LEA_MALLOC */ + +/* Define to the canonical Emacs configuration name. */ +#define EMACS_CONFIGURATION "powerpc-apple-darwin8.11.0" + +/* Define to the options passed to configure. */ +#define EMACS_CONFIG_OPTIONS " 'CFLAGS=-I/opt/local/include -L/opt/local/lib' 'LDFLAGS=-L/opt/local/lib' 'CPPFLAGS=-I/opt/local/include -L/opt/local/lib'" + +/* Define to 1 if the `getloadavg' function needs to be run setuid or setgid. + */ +/* #undef GETLOADAVG_PRIVILEGED */ + +/* Define to 1 if the `getpgrp' function requires zero arguments. */ +#define GETPGRP_VOID 1 + +/* Define to 1 if gettimeofday accepts only one argument. */ +/* #undef GETTIMEOFDAY_ONE_ARGUMENT */ + +/* Define to 1 if you want to use the GNU memory allocator. */ +/* #undef GNU_MALLOC */ + +/* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */ +/* #undef HAVE_AIX_SMT_EXP */ + +/* Define to 1 if you have the `alarm' function. */ +#define HAVE_ALARM 1 + +/* Define to 1 if you have `alloca', as a function or macro. */ +#define HAVE_ALLOCA 1 + +/* Define to 1 if you have and it should be used (not on Ultrix). + */ +#define HAVE_ALLOCA_H 1 + +/* Define to 1 if ALSA is available. */ +/* #undef HAVE_ALSA */ + +/* Define to 1 if you have the `bcmp' function. */ +#define HAVE_BCMP 1 + +/* Define to 1 if you have the `bcopy' function. */ +#define HAVE_BCOPY 1 + +/* Define to 1 if you have the `bzero' function. */ +#define HAVE_BZERO 1 + +/* Define to 1 if you are using the Carbon API on Mac OS X. */ +#define HAVE_CARBON 1 + +/* Define to 1 if you have the `cbrt' function. */ +#define HAVE_CBRT 1 + +/* Define to 1 if you have the `closedir' function. */ +#define HAVE_CLOSEDIR 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_COFF_H */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_COM_ERR_H */ + +/* Define to 1 if you have /usr/lib/crti.o. */ +/* #undef HAVE_CRTIN */ + +/* Define to 1 if you have the declaration of `sys_siglist', and to 0 if you + don't. */ +#define HAVE_DECL_SYS_SIGLIST 1 + +/* Define to 1 if you have the declaration of `tzname', and to 0 if you don't. + */ +/* #undef HAVE_DECL_TZNAME */ + +/* Define to 1 if you have the declaration of `__sys_siglist', and to 0 if you + don't. */ +/* #undef HAVE_DECL___SYS_SIGLIST */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_DES_H */ + +/* Define to 1 if dynamic ptys are supported. */ +/* #undef HAVE_DEV_PTMX */ + +/* Define to 1 if you have the `difftime' function. */ +#define HAVE_DIFFTIME 1 + +/* Define to 1 if you have the `dup2' function. */ +#define HAVE_DUP2 1 + +/* Define to 1 if you have the `euidaccess' function. */ +/* #undef HAVE_EUIDACCESS */ + +/* Define to 1 if you have the header file. */ +#define HAVE_FCNTL_H 1 + +/* Define to 1 if you have the `fmod' function. */ +#define HAVE_FMOD 1 + +/* Define to 1 if you have the `fork' function. */ +#define HAVE_FORK 1 + +/* Define to 1 if you have the `fpathconf' function. */ +#define HAVE_FPATHCONF 1 + +/* Define to 1 if you have the `frexp' function. */ +#define HAVE_FREXP 1 + +/* Define to 1 if fseeko (and presumably ftello) exists and is declared. */ +#define HAVE_FSEEKO 1 + +/* Define to 1 if you have the `fsync' function. */ +#define HAVE_FSYNC 1 + +/* Define to 1 if you have the `ftime' function. */ +#define HAVE_FTIME 1 + +/* Define to 1 if you have the `gai_strerror' function. */ +#define HAVE_GAI_STRERROR 1 + +/* Define to 1 if you have the `gdk_display_open' function. */ +/* #undef HAVE_GDK_DISPLAY_OPEN */ + +/* Define to 1 if you have the `getaddrinfo' function. */ +#define HAVE_GETADDRINFO 1 + +/* Define to 1 if you have the `getcwd' function. */ +#define HAVE_GETCWD 1 + +/* Define to 1 if you have the `getdelim' function. */ +/* #undef HAVE_GETDELIM */ + +/* Define to 1 if you have the `getdomainname' function. */ +#define HAVE_GETDOMAINNAME 1 + +/* Define to 1 if you have the `gethostname' function. */ +#define HAVE_GETHOSTNAME 1 + +/* Define to 1 if you have the `getline' function. */ +/* #undef HAVE_GETLINE */ + +/* Define to 1 if you have the `getloadavg' function. */ +#define HAVE_GETLOADAVG 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_GETOPT_H 1 + +/* Define to 1 if you have the `getopt_long_only' function. */ +#define HAVE_GETOPT_LONG_ONLY 1 + +/* Define to 1 if you have the `getpagesize' function. */ +#define HAVE_GETPAGESIZE 1 + +/* Define to 1 if you have the `getpeername' function. */ +#define HAVE_GETPEERNAME 1 + +/* Define to 1 if you have the `getpt' function. */ +/* #undef HAVE_GETPT */ + +/* Define to 1 if you have the `getrusage' function. */ +#define HAVE_GETRUSAGE 1 + +/* Define to 1 if you have the `getsockname' function. */ +#define HAVE_GETSOCKNAME 1 + +/* Define to 1 if you have the `getsockopt' function. */ +#define HAVE_GETSOCKOPT 1 + +/* Define to 1 if you have the `gettimeofday' function. */ +#define HAVE_GETTIMEOFDAY 1 + +/* Define to 1 if you have the `getwd' function. */ +#define HAVE_GETWD 1 + +/* Define to 1 if you have the `get_current_dir_name' function. */ +/* #undef HAVE_GET_CURRENT_DIR_NAME */ + +/* Define to 1 if you have the ungif library (-lungif). */ +/* #undef HAVE_GIF */ + +/* Define to 1 if you have the `grantpt' function. */ +#define HAVE_GRANTPT 1 + +/* Define to 1 if using GTK. */ +/* #undef HAVE_GTK */ + +/* Define to 1 if you have GTK and pthread (-lpthread). */ +/* #undef HAVE_GTK_AND_PTHREAD */ + +/* Define to 1 if GTK has both file selection and chooser dialog. */ +/* #undef HAVE_GTK_FILE_BOTH */ + +/* Define to 1 if you have the `gtk_file_chooser_dialog_new' function. */ +/* #undef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW */ + +/* Define to 1 if you have the `gtk_file_selection_new' function. */ +/* #undef HAVE_GTK_FILE_SELECTION_NEW */ + +/* Define to 1 if you have the `gtk_main' function. */ +/* #undef HAVE_GTK_MAIN */ + +/* Define to 1 if GTK can handle more than one display. */ +/* #undef HAVE_GTK_MULTIDISPLAY */ + +/* Define to 1 if netdb.h declares h_errno. */ +#define HAVE_H_ERRNO 1 + +/* Define to 1 if you have the `index' function. */ +#define HAVE_INDEX 1 + +/* Define to 1 if you have inet sockets. */ +#define HAVE_INET_SOCKETS 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_INTTYPES_H 1 + +/* Define to 1 if you have the jpeg library (-ljpeg). */ +/* #undef HAVE_JPEG */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_KERBEROSIV_DES_H */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_KERBEROSIV_KRB_H */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_KERBEROS_DES_H */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_KERBEROS_KRB_H */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_KRB5_H */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_KRB_H */ + +/* Define if you have and nl_langinfo(CODESET). */ +#define HAVE_LANGINFO_CODESET 1 + +/* Define to 1 if you have the `com_err' library (-lcom_err). */ +/* #undef HAVE_LIBCOM_ERR */ + +/* Define to 1 if you have the `crypto' library (-lcrypto). */ +/* #undef HAVE_LIBCRYPTO */ + +/* Define to 1 if you have the `des' library (-ldes). */ +/* #undef HAVE_LIBDES */ + +/* Define to 1 if you have the `des425' library (-ldes425). */ +/* #undef HAVE_LIBDES425 */ + +/* Define to 1 if you have the `dgc' library (-ldgc). */ +/* #undef HAVE_LIBDGC */ + +/* Define to 1 if you have the `dnet' library (-ldnet). */ +/* #undef HAVE_LIBDNET */ + +/* Define to 1 if you have the hesiod library (-lhesiod). */ +/* #undef HAVE_LIBHESIOD */ + +/* Define to 1 if you have the `intl' library (-lintl). */ +/* #undef HAVE_LIBINTL */ + +/* Define to 1 if you have the `k5crypto' library (-lk5crypto). */ +/* #undef HAVE_LIBK5CRYPTO */ + +/* Define to 1 if you have the `krb' library (-lkrb). */ +/* #undef HAVE_LIBKRB */ + +/* Define to 1 if you have the `krb4' library (-lkrb4). */ +/* #undef HAVE_LIBKRB4 */ + +/* Define to 1 if you have the `krb5' library (-lkrb5). */ +/* #undef HAVE_LIBKRB5 */ + +/* Define to 1 if you have the `kstat' library (-lkstat). */ +/* #undef HAVE_LIBKSTAT */ + +/* Define to 1 if you have the `lockfile' library (-llockfile). */ +/* #undef HAVE_LIBLOCKFILE */ + +/* Define to 1 if you have the `m' library (-lm). */ +#define HAVE_LIBM 1 + +/* Define to 1 if you have the `mail' library (-lmail). */ +/* #undef HAVE_LIBMAIL */ + +/* Define to 1 if you have the `ncurses' library (-lncurses). */ +#define HAVE_LIBNCURSES 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_LIBPNG_PNG_H */ + +/* Define to 1 if you have the `pthreads' library (-lpthreads). */ +/* #undef HAVE_LIBPTHREADS */ + +/* Define to 1 if you have the resolv library (-lresolv). */ +/* #undef HAVE_LIBRESOLV */ + +/* Define to 1 if you have the `Xext' library (-lXext). */ +/* #undef HAVE_LIBXEXT */ + +/* Define to 1 if you have the `Xmu' library (-lXmu). */ +/* #undef HAVE_LIBXMU */ + +/* Define to 1 if you have the Xp library (-lXp). */ +/* #undef HAVE_LIBXP */ + +/* Define to 1 if you have the header file. */ +#define HAVE_LIMITS_H 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_LINUX_VERSION_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_LOCALE_H 1 + +/* Define to 1 if you have the `logb' function. */ +#define HAVE_LOGB 1 + +/* Define to 1 if you support file names longer than 14 characters. */ +#define HAVE_LONG_FILE_NAMES 1 + +/* Define to 1 if you have the `lrand48' function. */ +#define HAVE_LRAND48 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_MACHINE_SOUNDCARD_H */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_MACH_MACH_H */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_MAILLOCK_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_MALLOC_MALLOC_H 1 + +/* Define to 1 if you have the `mblen' function. */ +#define HAVE_MBLEN 1 + +/* Define to 1 if you have the `mbrlen' function. */ +#define HAVE_MBRLEN 1 + +/* Define to 1 if you have the `mbsinit' function. */ +#define HAVE_MBSINIT 1 + +/* Define to 1 if declares mbstate_t. */ +#define HAVE_MBSTATE_T 1 + +/* Define to 1 if you have the `memcmp' function. */ +#define HAVE_MEMCMP 1 + +/* Define to 1 if you have the `memcpy' function. */ +#define HAVE_MEMCPY 1 + +/* Define to 1 if you have the `memmove' function. */ +#define HAVE_MEMMOVE 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_MEMORY_H 1 + +/* Define to 1 if you have the `mempcpy' function. */ +/* #undef HAVE_MEMPCPY */ + +/* Define to 1 if you have the `memset' function. */ +#define HAVE_MEMSET 1 + +/* Define to 1 if you have mouse menus. (This is automatic if you use X, but + the option to specify it remains.) It is also defined with other window + systems that support xmenu.c. */ +#define HAVE_MENUS 1 + +/* Define to 1 if you have the `mkdir' function. */ +#define HAVE_MKDIR 1 + +/* Define to 1 if you have the `mkstemp' function. */ +#define HAVE_MKSTEMP 1 + +/* Define to 1 if you have the `mktime' function. */ +#define HAVE_MKTIME 1 + +/* Define to 1 if you have a working `mmap' system call. */ +#define HAVE_MMAP 1 + +/* Define to 1 if you have Motif 2.1 or newer. */ +/* #undef HAVE_MOTIF_2_1 */ + +/* Define to 1 if you have the `mremap' function. */ +/* #undef HAVE_MREMAP */ + +/* Define to 1 if you have the header file. */ +#define HAVE_NET_IF_H 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_NLIST_H */ + +/* Define to 1 if personality LINUX32 can be set. */ +/* #undef HAVE_PERSONALITY_LINUX32 */ + +/* Define to 1 if you have the png library (-lpng). */ +/* #undef HAVE_PNG */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_PNG_H */ + +/* Define to 1 if you have the `posix_memalign' function. */ +/* #undef HAVE_POSIX_MEMALIGN */ + +/* Define to 1 if you have the `pstat_getdynamic' function. */ +/* #undef HAVE_PSTAT_GETDYNAMIC */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_PTHREAD_H */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_PTY_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_PWD_H 1 + +/* Define to 1 if you have the `random' function. */ +#define HAVE_RANDOM 1 + +/* Define to 1 if you have the `recvfrom' function. */ +#define HAVE_RECVFROM 1 + +/* Define to 1 if you have the `rename' function. */ +#define HAVE_RENAME 1 + +/* Define to 1 if you have the `res_init' function. */ +#define HAVE_RES_INIT 1 + +/* Define to 1 if you have the `rindex' function. */ +#define HAVE_RINDEX 1 + +/* Define to 1 if you have the `rint' function. */ +#define HAVE_RINT 1 + +/* Define to 1 if you have the `rmdir' function. */ +#define HAVE_RMDIR 1 + +/* Define to 1 if you have the `select' function. */ +#define HAVE_SELECT 1 + +/* Define to 1 if you have the `sendto' function. */ +#define HAVE_SENDTO 1 + +/* Define to 1 if you have the `setitimer' function. */ +#define HAVE_SETITIMER 1 + +/* Define to 1 if you have the `setlocale' function. */ +#define HAVE_SETLOCALE 1 + +/* Define to 1 if you have the `setpgid' function. */ +#define HAVE_SETPGID 1 + +/* Define to 1 if you have the `setrlimit' function. */ +#define HAVE_SETRLIMIT 1 + +/* Define to 1 if you have the `setsid' function. */ +#define HAVE_SETSID 1 + +/* Define to 1 if you have the `setsockopt' function. */ +#define HAVE_SETSOCKOPT 1 + +/* Define to 1 if you have the `shutdown' function. */ +#define HAVE_SHUTDOWN 1 + +/* Define to 1 if the system has the type `size_t'. */ +#define HAVE_SIZE_T 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_SOUNDCARD_H */ + +/* Define to 1 if `speed_t' is declared by . */ +#define HAVE_SPEED_T 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STDINT_H 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_STDIO_EXT_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_STDLIB_H 1 + +/* Define to 1 if you have the `strerror' function. */ +#define HAVE_STRERROR 1 + +/* Define to 1 if you have the `strftime' function. */ +#define HAVE_STRFTIME 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STRINGS_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STRING_H 1 + +/* Define to 1 if you have the `strsignal' function. */ +#define HAVE_STRSIGNAL 1 + +/* Define to 1 if `ifr_addr' is member of `struct ifreq'. */ +#define HAVE_STRUCT_IFREQ_IFR_ADDR 1 + +/* Define to 1 if `ifr_broadaddr' is member of `struct ifreq'. */ +#define HAVE_STRUCT_IFREQ_IFR_BROADADDR 1 + +/* Define to 1 if `ifr_flags' is member of `struct ifreq'. */ +#define HAVE_STRUCT_IFREQ_IFR_FLAGS 1 + +/* Define to 1 if `ifr_hwaddr' is member of `struct ifreq'. */ +/* #undef HAVE_STRUCT_IFREQ_IFR_HWADDR */ + +/* Define to 1 if `ifr_netmask' is member of `struct ifreq'. */ +/* #undef HAVE_STRUCT_IFREQ_IFR_NETMASK */ + +/* Define to 1 if `n_un.n_name' is member of `struct nlist'. */ +/* #undef HAVE_STRUCT_NLIST_N_UN_N_NAME */ + +/* Define to 1 if `tm_zone' is member of `struct tm'. */ +#define HAVE_STRUCT_TM_TM_ZONE 1 + +/* Define to 1 if `struct utimbuf' is declared by . */ +#define HAVE_STRUCT_UTIMBUF 1 + +/* Define to 1 if you have the `sync' function. */ +#define HAVE_SYNC 1 + +/* Define to 1 if you have the `sysinfo' function. */ +/* #undef HAVE_SYSINFO */ + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_IOCTL_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_MMAN_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_PARAM_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_RESOURCE_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_SELECT_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_SOCKET_H 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_SYS_SOUNDCARD_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_STAT_H 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_SYS_SYSTEMINFO_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_TIMEB_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_TIME_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_TYPES_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_UN_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_UTSNAME_H 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_SYS_VLIMIT_H */ + +/* Define to 1 if you have that is POSIX.1 compatible. */ +#define HAVE_SYS_WAIT_H 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_SYS__MBSTATE_T_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_TERMCAP_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_TERMIOS_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_TERM_H 1 + +/* Define to 1 if you have the tiff library (-ltiff). */ +/* #undef HAVE_TIFF */ + +/* Define to 1 if `struct timeval' is declared by . */ +#define HAVE_TIMEVAL 1 + +/* Define to 1 if `tm_gmtoff' is member of `struct tm'. */ +#define HAVE_TM_GMTOFF 1 + +/* Define to 1 if your `struct tm' has `tm_zone'. Deprecated, use + `HAVE_STRUCT_TM_TM_ZONE' instead. */ +#define HAVE_TM_ZONE 1 + +/* Define to 1 if you have the `touchlock' function. */ +/* #undef HAVE_TOUCHLOCK */ + +/* Define to 1 if you don't have `tm_zone' but do have the external array + `tzname'. */ +/* #undef HAVE_TZNAME */ + +/* Define to 1 if you have the `tzset' function. */ +#define HAVE_TZSET 1 + +/* Define to 1 if you have the `ualarm' function. */ +#define HAVE_UALARM 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_UNISTD_H 1 + +/* Define to 1 if you have the `utimes' function. */ +#define HAVE_UTIMES 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_UTIME_H 1 + +/* Define to 1 if you have the `vfork' function. */ +#define HAVE_VFORK 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_VFORK_H */ + +/* Define to 1 if `fork' works. */ +#define HAVE_WORKING_FORK 1 + +/* Define to 1 if `vfork' works. */ +#define HAVE_WORKING_VFORK 1 + +/* Define to 1 if you want to use version 11 of X windows. Otherwise, Emacs + expects to use version 10. */ +/* #undef HAVE_X11 */ + +/* Define to 1 if you have the X11R5 or newer version of Xlib. */ +/* #undef HAVE_X11R5 */ + +/* Define to 1 if you have the X11R6 or newer version of Xlib. */ +/* #undef HAVE_X11R6 */ + +/* Define to 1 if you have the X11R6 or newer version of Xt. */ +/* #undef HAVE_X11XTR6 */ + +/* Define to 1 if the file /usr/lib64 exists. */ +/* #undef HAVE_X86_64_LIB64_DIR */ + +/* Define to 1 if you have the Xaw3d library (-lXaw3d). */ +/* #undef HAVE_XAW3D */ + +/* Define to 1 if you're using XFree386. */ +/* #undef HAVE_XFREE386 */ + +/* Define to 1 if you have the Xft library. */ +/* #undef HAVE_XFT */ + +/* Define to 1 if XIM is available */ +/* #undef HAVE_XIM */ + +/* Define to 1 if you have the XkbGetKeyboard function. */ +/* #undef HAVE_XKBGETKEYBOARD */ + +/* Define to 1 if you have the Xpm libary (-lXpm). */ +/* #undef HAVE_XPM */ + +/* Define to 1 if you have the `XrmSetDatabase' function. */ +/* #undef HAVE_XRMSETDATABASE */ + +/* Define to 1 if you have the `XScreenNumberOfScreen' function. */ +/* #undef HAVE_XSCREENNUMBEROFSCREEN */ + +/* Define to 1 if you have the `XScreenResourceString' function. */ +/* #undef HAVE_XSCREENRESOURCESTRING */ + +/* Define to 1 if you have the `XSetWMProtocols' function. */ +/* #undef HAVE_XSETWMPROTOCOLS */ + +/* Define to 1 if you have the SM library (-lSM). */ +/* #undef HAVE_X_SM */ + +/* Define to 1 if you want to use the X window system. */ +/* #undef HAVE_X_WINDOWS */ + +/* Define to 1 if you have the `__fpending' function. */ +/* #undef HAVE___FPENDING */ + +/* Define to support using a Hesiod database to find the POP server. */ +/* #undef HESIOD */ + +/* Define to support Kerberos-authenticated POP mail retrieval. */ +/* #undef KERBEROS */ + +/* Define to use Kerberos 5 instead of Kerberos 4. */ +/* #undef KERBEROS5 */ + +/* Define LD_SWITCH_X_SITE to contain any special flags your loader may need + to deal with X Windows. For instance, if you've defined HAVE_X_WINDOWS + above and your X libraries aren't in a place that your loader can find on + its own, you might want to add "-L/..." or something similar. */ +#define LD_SWITCH_X_SITE + +/* Define LD_SWITCH_X_SITE_AUX with an -R option in case it's needed (for + Solaris, for example). */ +#define LD_SWITCH_X_SITE_AUX + +/* Define to 1 if localtime caches TZ. */ +/* #undef LOCALTIME_CACHE */ + +/* Define to support POP mail retrieval. */ +#define MAIL_USE_POP 1 + +/* Define to 1 if your `struct nlist' has an `n_un' member. Obsolete, depend + on `HAVE_STRUCT_NLIST_N_UN_N_NAME */ +/* #undef NLIST_NAME_UNION */ + +/* Define to 1 if you don't have struct exception in math.h. */ +/* #undef NO_MATHERR */ + +/* Define to the address where bug reports for this package should be sent. */ +#define PACKAGE_BUGREPORT "" + +/* Define to the full name of this package. */ +#define PACKAGE_NAME "" + +/* Define to the full name and version of this package. */ +#define PACKAGE_STRING "" + +/* Define to the one symbol short name of this package. */ +#define PACKAGE_TARNAME "" + +/* Define to the version of this package. */ +#define PACKAGE_VERSION "" + +/* Define as `void' if your compiler accepts `void *'; otherwise define as + `char'. */ +#define POINTER_TYPE void + +/* Define to 1 if the C compiler supports function prototypes. */ +#define PROTOTYPES 1 + +/* Define REL_ALLOC if you want to use the relocating allocator for buffer + space. */ +/* #undef REL_ALLOC */ + +/* Define as the return type of signal handlers (`int' or `void'). */ +#define RETSIGTYPE void + +/* If using the C implementation of alloca, define if you know the + direction of stack growth for your system; otherwise it will be + automatically deduced at runtime. + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ +/* #undef STACK_DIRECTION */ + +/* Define to 1 if you have the ANSI C header files. */ +#define STDC_HEADERS 1 + +/* Define to 1 on System V Release 4. */ +/* #undef SVR4 */ + +/* Define to 1 if you can safely include both and . */ +#define TIME_WITH_SYS_TIME 1 + +/* Define to 1 if your declares `struct tm'. */ +/* #undef TM_IN_SYS_TIME */ + +/* Define to 1 for Encore UMAX. */ +/* #undef UMAX */ + +/* Define to 1 for Encore UMAX 4.3 that has instead of + . */ +/* #undef UMAX4_3 */ + +/* Define to the unexec source file name. */ +#define UNEXEC_SRC unexmacosx.c + +/* Define to 1 if we should use toolkit scroll bars. */ +#define USE_TOOLKIT_SCROLL_BARS 1 + +/* Define to 1 if we should use XIM, if it is available. */ +#define USE_XIM 1 + +/* Define to 1 if using an X toolkit. */ +/* #undef USE_X_TOOLKIT */ + +/* Define to the type of the 6th arg of XRegisterIMInstantiateCallback, either + XPointer or XPointer*. */ +/* #undef XRegisterIMInstantiateCallback_arg6 */ + +/* Define to 1 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 + +/* Number of bits in a file offset, on hosts where this is settable. */ +/* #undef _FILE_OFFSET_BITS */ + +/* Enable GNU extensions on systems that have them. */ +#ifndef _GNU_SOURCE +# define _GNU_SOURCE 1 +#endif + +/* Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2). */ +/* #undef _LARGEFILE_SOURCE */ + +/* Define for large files, on AIX-style hosts. */ +/* #undef _LARGE_FILES */ + +/* Define to rpl_ if the getopt replacement functions and variables should be + used. */ +#define __GETOPT_PREFIX rpl_ + +/* Define like PROTOTYPES; this can be used by system headers. */ +#define __PROTOTYPES 1 + +/* Define to compiler's equivalent of C99 restrict keyword. Don't define if + equivalent is `__restrict'. */ +/* #undef __restrict */ + +/* Define to compiler's equivalent of C99 restrict keyword in array + declarations. Define as empty for no equivalent. */ +#define __restrict_arr __restrict + +/* Define to the used machine dependent file. */ +#define config_machfile "m/powermac.h" + +/* Define to the used os dependent file. */ +#define config_opsysfile "s/darwin.h" + +/* Define to empty if `const' does not conform to ANSI C. */ +/* #undef const */ + +/* Define to a type if does not define. */ +/* #undef mbstate_t */ + +/* Define to `int' if does not define. */ +/* #undef pid_t */ + +/* Define to any substitute for sys_siglist. */ +/* #undef sys_siglist */ + +/* Define as `fork' if `vfork' does not work. */ +/* #undef vfork */ + +/* Define to empty if the keyword `volatile' does not work. Warning: valid + code using `volatile' can become incorrect without. Disable with care. */ +/* #undef volatile */ + + +/* If we're using any sort of window system, define some consequences. */ +#ifdef HAVE_X_WINDOWS +#define HAVE_WINDOW_SYSTEM +#define MULTI_KBOARD +#define HAVE_MOUSE +#endif + +/* If we're using the Carbon API on Mac OS X, define a few more + variables as well. */ +#ifdef HAVE_CARBON +#define HAVE_WINDOW_SYSTEM +#define HAVE_MOUSE +#endif + +/* Define USER_FULL_NAME to return a string + that is the user's full name. + It can assume that the variable `pw' + points to the password file entry for this user. + + At some sites, the pw_gecos field contains + the user's full name. If neither this nor any other + field contains the right thing, use pw_name, + giving the user's login name, since that is better than nothing. */ +#define USER_FULL_NAME pw->pw_gecos + +/* Define AMPERSAND_FULL_NAME if you use the convention + that & in the full name stands for the login id. */ +/* Turned on June 1996 supposing nobody will mind it. */ +#define AMPERSAND_FULL_NAME + +/* We have blockinput.h. */ +#define DO_BLOCK_INPUT + +/* Define HAVE_SOUND if we have sound support. We know it works + and compiles only on the specified platforms. For others, + it probably doesn't make sense to try. */ + +#if defined __FreeBSD__ || defined __NetBSD__ || defined __linux__ +#ifdef HAVE_MACHINE_SOUNDCARD_H +#define HAVE_SOUND 1 +#endif +#ifdef HAVE_SYS_SOUNDCARD_H +#define HAVE_SOUND 1 +#endif +#ifdef HAVE_SOUNDCARD_H +#define HAVE_SOUND 1 +#endif +#ifdef HAVE_ALSA +#define HAVE_SOUND 1 +#endif +#endif /* __FreeBSD__ || __NetBSD__ || __linux__ */ + +/* If using GNU, then support inline function declarations. */ +/* Don't try to switch on inline handling as detected by AC_C_INLINE + generally, because even if non-gcc compilers accept `inline', they + may reject `extern inline'. */ +#if defined (__GNUC__) && defined (OPTIMIZE) +#define INLINE __inline__ +#else +#define INLINE +#endif + +/* Include the os and machine dependent files. +#include config_opsysfile +#include config_machfile + */ + +/* Load in the conversion definitions if this system + needs them and the source file being compiled has not + said to inhibit this. There should be no need for you + to alter these lines. */ + +#ifdef SHORTNAMES +#ifndef NO_SHORTNAMES +#include "../shortnames/remap.h" +#endif /* not NO_SHORTNAMES */ +#endif /* SHORTNAMES */ + +/* If no remapping takes place, static variables cannot be dumped as + pure, so don't worry about the `static' keyword. */ +#ifdef NO_REMAP +/* #undef static */ +#endif + +/* Define `subprocesses' should be defined if you want to + have code for asynchronous subprocesses + (as used in M-x compile and M-x shell). + These do not work for some USG systems yet; + for the ones where they work, the s/SYSTEM.h file defines this flag. */ + +#ifndef VMS +#ifndef USG +/* #define subprocesses */ +#endif +#endif + +/* SIGTYPE is the macro we actually use. */ +#ifndef SIGTYPE +#define SIGTYPE RETSIGTYPE +#endif + +#ifdef emacs /* Don't do this for lib-src. */ +/* Tell regex.c to use a type compatible with Emacs. */ +#define RE_TRANSLATE_TYPE Lisp_Object +#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C) +#ifdef make_number +/* If make_number is a macro, use it. */ +#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) +#else +/* If make_number is a function, avoid it. */ +#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0)) +#endif +#endif + +/* Avoid link-time collision with system mktime if we will use our own. */ +#if ! HAVE_MKTIME || BROKEN_MKTIME +#define mktime emacs_mktime +#endif + +#define my_strftime nstrftime /* for strftime.c */ + +/* The rest of the code currently tests the CPP symbol BSTRING. + Override any claims made by the system-description files. + Note that on some SCO version it is possible to have bcopy and not bcmp. */ +/* #undef BSTRING */ +#if defined (HAVE_BCOPY) && defined (HAVE_BCMP) +#define BSTRING +#endif + +/* Some of the files of Emacs which are intended for use with other + programs assume that if you have a config.h file, you must declare + the type of getenv. + + This declaration shouldn't appear when alloca.s or Makefile.in + includes config.h. */ +#ifndef NOT_C_CODE +extern char *getenv (); +#endif + +/* These default definitions are good for almost all machines. + The exceptions override them in m/MACHINE.h. */ + +#ifndef BITS_PER_CHAR +#define BITS_PER_CHAR 8 +#endif + +#ifndef BITS_PER_SHORT +#define BITS_PER_SHORT 16 +#endif + +/* Note that lisp.h uses this in a preprocessor conditional, so it + would not work to use sizeof. That being so, we do all of them + without sizeof, for uniformity's sake. */ +#ifndef BITS_PER_INT +#define BITS_PER_INT 32 +#endif + +#ifndef BITS_PER_LONG +#ifdef _LP64 +#define BITS_PER_LONG 64 +#else +#define BITS_PER_LONG 32 +#endif +#endif + +/* Define if the compiler supports function prototypes. It may do so + but not define __STDC__ (e.g. DEC C by default) or may define it as + zero. */ +#define PROTOTYPES 1 +/* For mktime.c: */ +#ifndef __P +# if defined PROTOTYPES +# define __P(args) args +# else +# define __P(args) () +# endif /* GCC. */ +#endif /* __P */ + +/* Don't include "string.h" or in non-C code. */ +#ifndef NOT_C_CODE +#ifdef HAVE_STRING_H +#include "string.h" +#endif +#ifdef HAVE_STRINGS_H +#include "strings.h" /* May be needed for bcopy & al. */ +#endif +#ifdef HAVE_STDLIB_H +#include +#endif +#ifndef __GNUC__ +# ifdef HAVE_ALLOCA_H +# include +# else /* AIX files deal with #pragma. */ +# ifndef alloca /* predefined by HP cc +Olibcalls */ +char *alloca (); +# endif +# endif /* HAVE_ALLOCA_H */ +#endif /* __GNUC__ */ +#ifndef HAVE_SIZE_T +typedef unsigned size_t; +#endif +#endif /* NOT_C_CODE */ + +/* Define HAVE_X_I18N if we have usable i18n support. */ + +#ifdef HAVE_X11R6 +#define HAVE_X_I18N +#elif defined HAVE_X11R5 && !defined X11R5_INHIBIT_I18N +#define HAVE_X_I18N +#endif + +/* Define HAVE_X11R6_XIM if we have usable X11R6-style XIM support. */ + +#if defined HAVE_X11R6 && !defined INHIBIT_X11R6_XIM +#define HAVE_X11R6_XIM +#endif + +/* Should we enable expensive run-time checking of data types? */ +/* #undef ENABLE_CHECKING */ + +#if defined __GNUC__ && (__GNUC__ > 2 \ + || (__GNUC__ == 2 && __GNUC_MINOR__ >= 5)) +#define NO_RETURN __attribute__ ((__noreturn__)) +#else +#define NO_RETURN /* nothing */ +#endif + +/* These won't be used automatically yet. We also need to know, at least, + that the stack is continuous. */ +#ifdef __GNUC__ +# ifndef GC_SETJMP_WORKS + /* GC_SETJMP_WORKS is nearly always appropriate for GCC -- + see NON_SAVING_SETJMP in the target descriptions. */ + /* Exceptions (see NON_SAVING_SETJMP in target description) are ns32k, + SCO5 non-ELF (but Emacs specifies ELF) and SVR3 on x86. + Fixme: Deal with ns32k, SVR3. */ +# define GC_SETJMP_WORKS 1 +# endif +# ifndef GC_LISP_OBJECT_ALIGNMENT +# define GC_LISP_OBJECT_ALIGNMENT (__alignof__ (Lisp_Object)) +# endif +#endif + +#ifndef HAVE_BCOPY +#define bcopy(a,b,s) memcpy (b,a,s) +#endif +#ifndef HAVE_BZERO +#define bzero(a,s) memset (a,0,s) +#endif +#ifndef HAVE_BCMP +#define BCMP memcmp +#endif + +#endif /* EMACS_CONFIG_H */ + +/* +Local Variables: +mode: c +End: +*/ + diff --git a/mkimpcat.scm b/mkimpcat.scm old mode 100644 new mode 100755 index 08e33eb..c06e157 --- a/mkimpcat.scm +++ b/mkimpcat.scm @@ -25,7 +25,7 @@ (define (display* . args) (for-each (lambda (arg) (display arg op)) args) (newline op)) - (define (in-wb-vicinity . paths) (apply in-vicinity iv "../wb/" paths)) + (define (in-wb-vicinity . paths) (apply in-vicinity iv "../wb/c/" paths)) (define (in-xscm-vicinity . paths) (apply in-vicinity iv "../xscm-2.01/" paths)) (define (add-link feature . libs) (define syms '()) @@ -50,7 +50,7 @@ (write (cons from to) op) (newline op)) (define (add-source feature filename) - (cond ((file-exists? filename) + (cond ((file-exists? (string-append filename (scheme-file-suffix))) (display " " op) (write (list feature 'source filename) op) (newline op) @@ -60,6 +60,7 @@ (display* "#+" feature) (display* "(") (begin + (cond ((add-link 'hobbit (in-implementation-vicinity "hobbit" link:able-suffix)))) (cond ((add-link 'i/o-extensions (in-implementation-vicinity "ioext" link:able-suffix) (usr:lib "c")) @@ -75,7 +76,7 @@ link:able-suffix)))) (cond ((or (add-link 'db - (in-implementation-vicinity "db.so")) + (in-implementation-vicinity "wbscm.so")) (add-link 'db (in-implementation-vicinity "db" link:able-suffix) (in-implementation-vicinity "handle" link:able-suffix) @@ -89,7 +90,7 @@ (in-implementation-vicinity "scan" link:able-suffix) (usr:lib "c")) (add-link 'db - (in-wb-vicinity "db.so")) + (in-wb-vicinity "wbscm.so")) (add-link 'db (in-wb-vicinity "db" link:able-suffix) (in-wb-vicinity "handle" link:able-suffix) @@ -185,36 +186,25 @@ (add-alias '3rs 'r3rs) (add-alias '4rs 'r4rs) (add-alias '5rs 'r5rs) - (add-alias 'hobbit (in-implementation-vicinity "hobbit")) - (add-alias 'scmhob (in-implementation-vicinity "scmhob")) - (add-alias 'regex-case (in-implementation-vicinity "rgxcase")) - (add-alias 'url-filename (in-implementation-vicinity "urlfile")) - (add-source 'disarm (in-implementation-vicinity - (string-append "disarm" (scheme-file-suffix)))) + (add-source 'hobbit (in-implementation-vicinity "hobbit")) + (add-source 'scmhob (in-implementation-vicinity "scmhob")) + (add-source 'regex-case (in-implementation-vicinity "rgxcase")) + (add-source 'url-filename (in-implementation-vicinity "urlfile")) + (add-source 'disarm (in-implementation-vicinity "disarm")) (add-source 'build (in-implementation-vicinity "build")) - (add-source 'compile (in-implementation-vicinity - (string-append "compile" (scheme-file-suffix)))) + (add-source 'compile (in-implementation-vicinity "compile")) (or - (add-source 'wb-table - (in-implementation-vicinity - (string-append "wbtab" (scheme-file-suffix)))) - (add-source 'wb-table - (in-wb-vicinity - (string-append "wbtab" (scheme-file-suffix))))) + (add-source 'wb-table (in-implementation-vicinity "wbtab")) + (add-source 'wb-table (in-wb-vicinity "wbtab"))) (or - (add-source 'rwb-isam - (in-implementation-vicinity - (string-append "rwb-isam" (scheme-file-suffix)))) - (add-source 'rwb-isam - (in-wb-vicinity - (string-append "rwb-isam" (scheme-file-suffix))))) + (add-source 'rwb-isam (in-implementation-vicinity "rwb-isam")) + (add-source 'rwb-isam (in-wb-vicinity "rwb-isam"))) (display* ")") ) (display* "#+" 'primitive-hygiene) (display* "(") - (add-source 'macro (in-implementation-vicinity - (string-append "Macro" (scheme-file-suffix)))) + (add-source 'macro (in-implementation-vicinity "Macro")) (display* ")") (add-links 'dld diff --git a/patchlvl.h b/patchlvl.h index f206945..25ba416 100644 --- a/patchlvl.h +++ b/patchlvl.h @@ -4,11 +4,11 @@ # for alpha release, "b" for beta release, "c", and so on), and the # trailing number is the patchlevel. */ # /* This next line sets VERSION when included from the Makefile */ -VERSION=5e5 +VERSION=5f2 #endif #ifndef SCMVERSION -# define SCMVERSION "5e5" +# define SCMVERSION "5f2" #endif #ifdef nosve # define INIT_FILE_NAME "Init"SCMVERSION"_scm"; diff --git a/pi.c b/pi.c old mode 100644 new mode 100755 diff --git a/pi.scm b/pi.scm old mode 100644 new mode 100755 diff --git a/platform.txi b/platform.txi old mode 100644 new mode 100755 diff --git a/posix.c b/posix.c old mode 100644 new mode 100755 diff --git a/pre-crt0.c b/pre-crt0.c old mode 100644 new mode 100755 diff --git a/r4rstest.scm b/r4rstest.scm old mode 100644 new mode 100755 index b10cbd4..ec8af05 --- a/r4rstest.scm +++ b/r4rstest.scm @@ -203,6 +203,12 @@ (do ((x x (cdr x)) (sum 0 (+ sum (car x)))) ((null? x) sum)))) +(test 25 'do (let ((x '(1 3 5 7 9)) + (sum 0)) + (do ((x x (cdr x))) + ((null? x)) + (set! sum (+ sum (car x)))) + sum)) (test 1 'let (let foo () 1)) (test '((6 1 3) (-5 -2)) 'let (let loop ((numbers '(3 -2 1 6 -5)) @@ -551,7 +557,12 @@ (test 0 +) (test 4 * 4) (test 1 *) - +(test 1 / 1) +(test -1 / -1) +(test 2 / 6 3) +(test -3 / 6 -2) +(test -3 / -6 2) +(test 3 / -6 -2) (test -1 - 3 4) (test -3 - 3) (test 7 abs -7) @@ -649,9 +660,9 @@ (test #t 'max (inexact? (max f3.9 4))) (test f4.0 max f3.9 4) (test f4.0 exact->inexact 4) - (test f4.0 exact->inexact 4.0) + (test f4.0 exact->inexact f4.0) (test 4 inexact->exact 4) - (test 4 inexact->exact 4.0) + (test 4 inexact->exact f4.0) (test (- f4.0) round (- f4.5)) (test (- f4.0) round (- f3.5)) (test (- f4.0) round (- f3.9)) @@ -744,10 +755,9 @@ (ok? (testit xx))) (cond ((not ok?) (display "Number readback failure for ") - (display `(+ ,x (* ,j ,eps))) - (newline) - (display xx) - (newline) + (display `(+ ,x (* ,j ,eps))) (newline) + (display xx) (newline) + (display (string->number (number->string xx))) (newline) (set! all-ok? #f)) ;; (else (display xx) (newline)) ))))) @@ -762,6 +772,18 @@ "0.1" "0.01" "0.001" "1.0e-20" "1.0e-50" "1.0e-100"))) res)) + (define (float-rw-range-test) + (define success #t) + (do ((cnt -323 (+ 1 cnt))) + ((> cnt 308) success) + (let* ((estr (string-append "1.e" (number->string cnt))) + (num (string->number estr)) + (str (number->string num))) + (cond ((or (>= (string-length str) 10) + (not (equal? (string->number str) num))) + (set! success #f) + (for-each write (list estr num str (string->number str)))))))) + (SECTION 6 5 6) (test #t 'float-print-test (float-print-test f0.0)) (test #t 'mult-float-print-test (mult-float-print-test f1.0)) @@ -772,7 +794,8 @@ (test #t 'mult-float-print-test (mult-float-print-test (string->number "3.1415926535897931"))) (test #t 'mult-float-print-test (mult-float-print-test - (string->number "2.7182818284590451"))))) + (string->number "2.7182818284590451"))) + (test #t float-rw-range-test))) (define (test-bignum) (define tb @@ -782,6 +805,7 @@ (define b3-3 (string->number "33333333333333333333")) (define b3-2 (string->number "33333333333333333332")) (define b3-0 (string->number "33333333333333333330")) + (define b1-1 (string->number "11111111111111111111")) (define b2-0 (string->number "2177452800")) (newline) (display ";testing bignums; ") @@ -817,6 +841,14 @@ (test #t 'remainder (tb (string->number "281474976710655325431") 65535)) (test #t 'remainder (tb (string->number "281474976710655325430") 65535)) + (test b1-1 gcd b3-3 b1-1) + (test 1 gcd b3-2 b1-1) + (test 1 gcd b3-0 b1-1) + (test 3 gcd b3-3 b3-0) + + (test b3-3 lcm b3-3 b1-1) + (test b3-3 lcm -3 b1-1) + (let ((n (string->number "30414093201713378043612608166064768844377641568960512"))) (and n (exact? n) @@ -1101,10 +1133,11 @@ (test '#() make-vector 0 'a) (SECTION 6 9) (test #t procedure? car) -;(test #f procedure? 'car) +(test #f procedure? 'car) (test #t procedure? (lambda (x) (* x x))) (test #f procedure? '(lambda (x) (* x x))) (test #t call-with-current-continuation procedure?) +(test #t procedure? /) (test 7 apply + (list 3 4)) (test 7 apply (lambda (a b) (+ a b)) (list 3 4)) (test 17 apply + 10 (list 3 4)) diff --git a/ramap.c b/ramap.c old mode 100644 new mode 100755 index 0cedfad..d406f9e --- a/ramap.c +++ b/ramap.c @@ -595,7 +595,7 @@ SCM sc2array(s, ra, prot) if (NUMBERP(s)) break; goto mismatch; #endif - mismatch: ARRAY_V(res) = make_vector(MAKINUM(1), s); + mismatch: ARRAY_V(res) = make_vector(MAKINUM(1L), s); return res; } aset(ARRAY_V(res), s, INUM0); diff --git a/record.c b/record.c old mode 100644 new mode 100755 index 55f8f47..9311261 --- a/record.c +++ b/record.c @@ -277,7 +277,6 @@ static int recprin1(exp, port, writing) { SCM names, printer = RTD_PRINTER(REC_RTD(exp)); SCM argv[3]; - sizet i; if (NIMP(printer)) { argv[0] = exp; argv[1] = port; @@ -298,26 +297,20 @@ static int recprin1(exp, port, writing) scm_iprin1(RTD_NAME(REC_RTD(exp)), port, 0); if (writing) { lputc(':', port); - scm_intprint(((long)REC_RTD(exp))>>1, 16, port); - } - for (i = 1; i < NUMDIGS(exp); i++) { - lputc(' ', port); - scm_iprin1(CAR(names), port, 0); - names = CDR(names); - lputc(' ', port); - scm_iprin1(VELTS(exp)[i], port, writing); + scm_intprint(((long)(exp))>>1, 16, port); } - lputc(')', port); -/* - lputs("#', port); - for (i = 1; i < NUMDIGS(exp); i++) { +#ifdef SCM_SHOW_RECORD_FIELDS + { + sizet i; + for (i = 1; i < NUMDIGS(exp); i++) { + lputc(' ', port); + scm_iprin1(CAR(names), port, 0); + names = CDR(names); lputc(' ', port); scm_iprin1(VELTS(exp)[i], port, writing); - } - lputc('>', port); -*/ + }} +#endif + lputc(')', port); return 1; } diff --git a/repl.c b/repl.c old mode 100644 new mode 100755 index 5e5ad10..fc81cde --- a/repl.c +++ b/repl.c @@ -150,7 +150,7 @@ void scm_intprint(n, radix, port) SCM port; { char num_buf[INTBUFLEN]; - lfwrite(num_buf, (sizet)sizeof(char), iint2str(n, radix, num_buf), port); + lfwrite(num_buf, (sizet)sizeof(char), ilong2str(n, radix, num_buf), port); } void scm_ipruk(hdr, ptr, port) @@ -329,9 +329,10 @@ taloop: } lputc(')', port); break; - case tc7_Vbool: case tc7_VfixN8: case tc7_VfixZ8: - case tc7_VfixN16: case tc7_VfixZ16: case tc7_VfixN32: case tc7_VfixZ32: + case tc7_VfixN8: case tc7_VfixZ8: case tc7_VfixN16: case tc7_VfixZ16: + case tc7_VfixN32: case tc7_VfixZ32: case tc7_VfixN64: case tc7_VfixZ64: case tc7_VfloR32: case tc7_VfloC32: case tc7_VfloR64: case tc7_VfloC64: + case tc7_Vbool: raprin1(exp, port, writing); break; case tcs_subrs: @@ -493,8 +494,8 @@ SCM wait_for_input(args) port = port1; ports = args; while (1) { - ASRTER(NIMP(port) && OPINPORTP(port) && (BUF0 & SCM_PORTFLAGS(port)), - port, pos, s_wfi); +/* ASRTER(NIMP(port) && OPINPORTP(port) && (BUF0 & SCM_PORTFLAGS(port)), */ +/* port, pos, s_wfi); */ if (CRDYP(port) || feof(STREAM(port))) timeout = 0; if (NULLP(ports)) break; if (ARG5 <= pos) pos = ARGn; @@ -583,7 +584,7 @@ int scm_io_error(port, what) #ifdef HAVE_PIPE # ifdef EPIPE if (EPIPE==errno) { - if (verbose > 2) { + if (scm_verbose > 2) { err_head("WARNING"); lputs(";;", cur_errp); lputs(what, cur_errp); @@ -1508,7 +1509,7 @@ SCM scm_file_position(port, pos) scm_port_table[i].col = 1; } else { - if (2 <= verbose) + if (2 <= scm_verbose) scm_warn("Setting file position for tracked port: ", "", port); SCM_PORTFLAGS(port) &= (~TRACKED); } @@ -1552,7 +1553,7 @@ void growth_mon(obj, size, units, grewp) char *units; int grewp; { - if (verbose > 2) + if (scm_verbose > 2) { lputs((grewp ? "; grew " : "; shrank "), sys_errp); lputs(obj, sys_errp); @@ -1560,7 +1561,7 @@ void growth_mon(obj, size, units, grewp) scm_intprint(size, -10, sys_errp); lputc(' ', sys_errp); lputs(units, sys_errp); - if ((verbose > 4) && (obj==s_heap)) heap_report(); + if ((scm_verbose > 4) && (obj==s_heap)) heap_report(); lputs("\n; ", sys_errp); } } @@ -1568,7 +1569,7 @@ void growth_mon(obj, size, units, grewp) void gc_start(what) const char *what; { - if (verbose > 4) { + if (scm_verbose > 4) { lputs(";GC(", sys_errp); lputs(what, sys_errp); lputs(") ", sys_errp); @@ -1584,7 +1585,7 @@ void gc_end() { gc_rt = INUM(my_time()) - gc_rt; gc_time_taken = gc_time_taken + gc_rt; - if (verbose > 4) { + if (scm_verbose > 4) { scm_intprint(time_in_msec(gc_rt), -10, sys_errp); lputs(".ms cpu, ", sys_errp); scm_intprint(gc_cells_collected, -10, sys_errp); @@ -1609,7 +1610,7 @@ void scm_egc_end() } void repl_report() { - if (verbose > 2) { + if (scm_verbose > 2) { lfflush(cur_outp); lputs(";Evaluation took ", cur_errp); scm_intprint(time_in_msec(INUM(my_time())-rt), -10, cur_errp); @@ -1623,7 +1624,7 @@ void repl_report() lputs(" env, ", cur_errp); scm_intprint(mallocated - lmallocated, -10, cur_errp); lputs(".B other\n", cur_errp); - if (verbose > 3) { + if (scm_verbose > 3) { lputc(';', cur_errp); scm_intprint(scm_gcs, -10, cur_errp); lputs( " gc, ", cur_errp); @@ -1702,7 +1703,7 @@ void scm_ecache_report() } void exit_report() { - if (verbose > 2) { + if (scm_verbose > 2) { lputs(";Totals: ", cur_errp); scm_intprint(time_in_msec(INUM(my_time())), -10, cur_errp); lputs(".ms my time, ", cur_errp); @@ -1714,7 +1715,7 @@ void exit_report() SCM prolixity(arg) SCM arg; { - int old = verbose; + int old = scm_verbose; if (!UNBNDP(arg)) { if (FALSEP(arg)) scm_verbose = 1; else scm_verbose = INUM(arg); @@ -1733,11 +1734,11 @@ SCM repl() while(1) { if (OPOUTPORTP(cur_inp)) { /* This case for curses window */ lfflush(cur_outp); - if (verbose) lputs(PROMPT, cur_inp); + if (scm_verbose) lputs(PROMPT, cur_inp); lfflush(cur_inp); } else { - if (verbose) lputs(PROMPT, cur_outp); + if (scm_verbose) lputs(PROMPT, cur_outp); lfflush(cur_outp); } lcells_allocated = cells_allocated; @@ -1771,7 +1772,7 @@ SCM repl() x = cons(x, EOL); repl_report(); if (IMP(x)) - {if (verbose > 2) lputs(";;no values\n", cur_outp);} + {if (scm_verbose > 2) lputs(";;no values\n", cur_outp);} else if (IMP(CDR(x))) { scm_iprin1(CAR(x), cur_outp, 1); lputc('\n', cur_outp); @@ -1826,7 +1827,7 @@ static void ints_viol_iprin(num) int num; { char num_buf[INTBUFLEN]; - sizet i = iint2str(num+0L, 10, num_buf); + sizet i = ilong2str(num+0L, 10, num_buf); num_buf[i] = 0; fputs(num_buf, stderr); } diff --git a/requires.scm b/requires.scm old mode 100644 new mode 100755 diff --git a/rgx.c b/rgx.c old mode 100644 new mode 100755 index df5e360..fabbb8a --- a/rgx.c +++ b/rgx.c @@ -31,7 +31,7 @@ #endif static char rcsid[] = - "$Id: rgx.c,v 1.19 2008/01/31 03:32:33 jaffer Exp $"; + "$Id: rgx.c,v 1.20 2013/03/14 04:42:23 jaffer Exp $"; #ifdef HAVE_ALLOCA # include @@ -586,7 +586,7 @@ SCM lstringedit(prog, editspec, args) count = CAR(CDR(args)); ASRTER(INUMP(count)||(count==BOOL_T), count, ARG4, s_stringedit); } else - count = MAKINUM(1); + count = MAKINUM(1L); /* process the editspec - break it into a list of dotted pairs * of integers for substrings to be inserted and diff --git a/rope.c b/rope.c old mode 100644 new mode 100755 index 4c482a4..d31b0cb --- a/rope.c +++ b/rope.c @@ -163,13 +163,13 @@ double num2dbl(num, pos, s_caller) if (REALP(num)) return REALPART(num); if (scm_narn==num) return REALPART(num); #ifdef BIGDIG - if (BIGP(num)) return big2dbl(num); + if (BIGP(num)) return int2dbl(num); #endif errout: wta(num, pos, s_caller); } #endif - /* Convert (arrays of) strings to SCM */ + /* Convert string to SCM */ SCM makfromstr(src, len) const char *src; sizet len; @@ -181,6 +181,7 @@ SCM makfromstr(src, len) while (len--) *dst++ = *src++; return s; } + /* Convert null-terminated string to SCM */ SCM makfrom0str(src) const char *src; { @@ -269,12 +270,12 @@ int scm_ldprog(path) /* Get byte address of SCM array */ #ifdef ARRAYS long aind P((SCM ra, SCM args, const char *what)); -unsigned long scm_addr(args, s_name) +void* scm_addr(args, s_name) SCM args; const char *s_name; { long pos; - unsigned long ptr = 0; /* gratuitous assignment squelches cc warn. */ + void* ptr = 0; /* gratuitous assignment squelches cc warn. */ SCM v; ASRTGO(NIMP(args), wna); v = CAR(args); @@ -299,29 +300,29 @@ unsigned long scm_addr(args, s_name) } switch TYP7(v) { case tc7_string: - ptr = (unsigned long)&(CHARS(v)[pos]); + ptr = (void*)&(CHARS(v)[pos]); break; # ifdef FLOATS # ifdef SINGLES case tc7_VfloC32: pos = 2 * pos; - case tc7_VfloR32: ptr = (unsigned long)&(((float *)CDR(v))[pos]); + case tc7_VfloR32: ptr = (void*)&(((float *)CDR(v))[pos]); break; # endif case tc7_VfloC64: pos = 2 * pos; - case tc7_VfloR64: ptr = (unsigned long)&(((double *)CDR(v))[pos]); + case tc7_VfloR64: ptr = (void*)&(((double *)CDR(v))[pos]); break; # endif case tc7_Vbool: ASRTGO(0==(pos%LONG_BIT), outrng); pos = pos/LONG_BIT; case tc7_VfixN32: case tc7_VfixZ32: - case tc7_vector: ptr = (unsigned long)&(VELTS(v)[pos]); + case tc7_vector: ptr = (void*)&(VELTS(v)[pos]); break; case tc7_VfixN16: - case tc7_VfixZ16: ptr = (unsigned long)&(((short *)CDR(v))[pos]); + case tc7_VfixZ16: ptr = (void*)&(((short *)CDR(v))[pos]); break; case tc7_VfixN8: - case tc7_VfixZ8: ptr = (unsigned long)&(((char *)CDR(v))[pos]); + case tc7_VfixZ8: ptr = (void*)&(((char *)CDR(v))[pos]); break; outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_name); default: @@ -330,12 +331,12 @@ unsigned long scm_addr(args, s_name) } return ptr; } -unsigned long scm_base_addr(v, s_name) +void* scm_base_addr(v, s_name) SCM v; const char *s_name; { long pos = 0; - unsigned long ptr = 0; /* gratuitous assignment squelches cc warn. */ + void* ptr = 0; /* gratuitous assignment squelches cc warn. */ if (IMP(v)) {goto badarg;} else if (ARRAYP(v)) { pos = ARRAY_BASE(v); @@ -343,30 +344,30 @@ unsigned long scm_base_addr(v, s_name) } switch TYP7(v) { case tc7_string: - ptr = (unsigned long)&(CHARS(v)[pos]); + ptr = (void*)&(CHARS(v)[pos]); break; # ifdef FLOATS # ifdef SINGLES case tc7_VfloC32: pos = 2 * pos; case tc7_VfloR32: - ptr = (unsigned long)&(((float *)CDR(v))[pos]); + ptr = (void*)&(((float *)CDR(v))[pos]); break; # endif case tc7_VfloC64: pos = 2 * pos; - case tc7_VfloR64: ptr = (unsigned long)&(((double *)CDR(v))[pos]); + case tc7_VfloR64: ptr = (void*)&(((double *)CDR(v))[pos]); break; # endif case tc7_Vbool: ASRTGO(0==(pos%LONG_BIT), outrng); pos = pos/LONG_BIT; case tc7_VfixN32: case tc7_VfixZ32: - case tc7_vector: ptr = (unsigned long)&(VELTS(v)[pos]); + case tc7_vector: ptr = (void*)&(VELTS(v)[pos]); break; case tc7_VfixN16: - case tc7_VfixZ16: ptr = (unsigned long)&(((short *)CDR(v))[pos]); + case tc7_VfixZ16: ptr = (void*)&(((short *)CDR(v))[pos]); break; case tc7_VfixN8: - case tc7_VfixZ8: ptr = (unsigned long)&(((char *)CDR(v))[pos]); + case tc7_VfixZ8: ptr = (void*)&(((char *)CDR(v))[pos]); break; outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_name); default: @@ -415,9 +416,6 @@ SCM scm_gc_protect(obj) long len; ASRTER(NIMP(scm_uprotects), MAKINUM(20), NALLOC, "protects"); if (IMP(obj)) return obj; - for (len = LENGTH(scm_uprotects);len--;) { - if (obj==VELTS(scm_uprotects)[len]) return obj; - } len = LENGTH(scm_uprotects); if (scm_protidx >= len) resizuve(scm_uprotects, MAKINUM(len + (len>>2))); VELTS(scm_uprotects)[scm_protidx++] = obj; diff --git a/rwb-isam.scm b/rwb-isam.scm old mode 100644 new mode 100755 index 962a97b..21c1b85 --- a/rwb-isam.scm +++ b/rwb-isam.scm @@ -23,14 +23,8 @@ (require 'byte-number) (require 'relational-database) ;for make-relational-system -;;; WB-SEG:LOCKS has one extra location at end for loop end test -(defvar wb-seg:locks (let ((locks (make-vector (+ 1 wb:num-segs) #f))) - (do ((i (+ -2 (vector-length locks)) (+ -1 i))) - ((negative? i) locks) - (vector-set! locks i (make-arbiter i))))) -(defvar wb-seg:files (make-vector (+ 1 wb:num-segs) #f)) -(defvar wb-seg:roots (make-vector (+ 1 wb:num-segs) #f)) -(defvar wb-seg:mut?s (make-vector (+ 1 wb:num-segs) #f)) +(init-wb 75 150 2048) + ;@ (define rwb-isam ;; foiled indentation so etags will recognize definitions @@ -80,88 +74,58 @@ ((or (negative? k) (null? lst)) ans) (set-cdr! tail (list (car lst)))))))) -;;;; Segments - -(define (find-free-seg) - (do ((i 0 (+ 1 i)) - (arb (vector-ref wb-seg:locks 0) - (vector-ref wb-seg:locks (+ 1 i)))) - ((or (not arb) (try-arbiter arb)) - (and arb i)))) -(define (release-seg seg) - (and seg - (release-arbiter (vector-ref wb-seg:locks seg)) - #f)) - ;;;; Create, open, write, sync, or close database. -(define (seg-open-base seg filename writable?) - (vector-set! wb-seg:files seg filename) - (vector-set! wb-seg:mut?s seg writable?) - (vector-set! wb-seg:roots seg (open-db seg root-name)) - (cond ((wb:err? (vector-ref wb-seg:roots seg)) - (close-base seg) - #f) - (else seg))) - ;;; Because B-trees grow in depth only very slowly, we might as well ;;; put everything into one B-tree named "rwb". (define (make-base filename dim types) - (define seg (find-free-seg)) - (cond ((not seg) #f) - ((wb:err? (make-seg seg filename 2048)) (release-seg seg) #f) - ((wb:err? (open-seg seg filename 2)) (release-seg seg) #f) + (define seg (make-seg filename 2048)) + (cond ((not seg) + (slib:error 'make-base "couldn't make new base" filename) + #f) ((or (wb:err? (bt:put! (create-db seg #\T root-name) free-id "1")) - (wb:err? (bt:put! (open-bt seg 0 1) "base-table" "rwb-isam"))) - (release-seg seg) + (wb:err? (bt:put! (open-bt seg 0 1) "base-table" "wb-table"))) (slib:error 'make-base "couldn't modify new base" filename) #f) - (else (seg-open-base seg filename #t)))) + (else seg))) (define (open-base filename writable?) - (define seg (find-free-seg)) - (cond ((wb:err? (open-seg seg filename (if writable? 2 0))) - (release-seg seg) #f) - (else (seg-open-base seg filename writable?)))) + (open-seg filename writable?)) (define (write-base seg filename) - (cond ((and filename - (equal? filename (vector-ref wb-seg:files seg))) + (cond ((and filename (equal? filename (SEG:STR seg))) (let ((status (close-seg seg #f))) (cond ((wb:err? status) #f) - ((wb:err? (open-seg seg filename 2)) #f) - (else #t)))) + (else + (set! seg (open-seg filename #t)) + (cond ((not seg) #f) + (else #t)))))) (else ;;(slib:error 'write-base "WB can't change database filename" filename) #f))) (define (sync-base seg) - (and seg (write-base seg (vector-ref wb-seg:files seg)))) + (and seg (write-base seg (SEG:STR seg)))) (define (close-base seg) - (cond ((wb:err? (close-seg seg #f)) - (let ((status (close-seg seg #t))) - (release-seg seg) - (not (wb:err? status)))) - (else (release-seg seg) #t))) + (not (wb:err? (close-seg seg #f)))) ;;;; Make, open, and destroy tables. (define (make-table seg dim types) - (and (vector-ref wb-seg:mut?s seg) - (let* ((tns (bt:rem (vector-ref wb-seg:roots seg) free-id)) + (and (SEG:MUTABLE? seg) + (let* ((root (open-db seg root-name)) + (tns (bt:rem root free-id)) (base-id (and (string? tns) (string->number tns)))) (cond ((not tns) (slib:error 'make-table 'free-id "in use?") #f) ((not base-id) - (bt:put (vector-ref wb-seg:roots seg) free-id tns) + (bt:put root free-id tns) (slib:error 'make-table "free-id corrupted" base-id) #f) - ((not (bt:put (vector-ref wb-seg:roots seg) - free-id - (number->string (+ 1 base-id)))) + ((not (bt:put root free-id (number->string (+ 1 base-id)))) (slib:error 'make-table "free-id lock broken") #f) (else base-id))))) diff --git a/sc2.c b/sc2.c old mode 100644 new mode 100755 diff --git a/scl.c b/scl.c index 2fb2d17..d7fbf0d 100644 --- a/scl.c +++ b/scl.c @@ -1,5 +1,5 @@ /* "scl.c" non-IEEE utility functions and non-integer arithmetic. - * Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997, 2005, 2006 Free Software Foundation, Inc. + * Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997, 2005, 2006, 2013, 2014 Free Software Foundation, Inc. * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as @@ -25,15 +25,21 @@ # include # endif -static double big2scaldbl P((SCM b, int expt)); static SCM bigdblop P((int op, SCM b, double re, double im)); -static SCM inex_divbigbig P((SCM a, SCM b)); +static SCM inex_divintbig P((SCM a, SCM b)); +# ifndef BIGDIG static int apx_log10 P((double x)); static double lpow10 P((double x, int n)); +# endif static sizet idbl2str P((double f, char *a)); +static sizet pdbl2str P((double f, char *a, sizet ch)); static sizet iflo2str P((SCM flt, char *str)); static void safe_add_1 P((double f, double *fsum)); static long scm_twos_power P((SCM n)); +static double mantexp2dbl P((SCM manstr, int expo)); +static double pmantexp2dbl P((SCM bmant, int expo)); +static SCM ex2in P((SCM z)); +static SCM ilog P((unsigned long m, SCM b, SCM k, unsigned long *n)); static char s_makrect[] = "make-rectangular", s_makpolar[] = "make-polar", s_magnitude[] = "magnitude", s_angle[] = "angle", @@ -63,29 +69,171 @@ static char s_list_tail[] = "list-tail"; static char s_str2list[] = "string->list"; static char s_st_copy[] = "string-copy", s_st_fill[] = "string-fill!"; static char s_vect2list[] = "vector->list", s_ve_fill[] = "vector-fill!"; -static char s_intexpt[] = "integer-expt"; -static char str_inf0[] = "inf.0"; +static char str_inf0[] = "inf.0", str_nan0[] = "nan.0", str_0[] = "0.0"; +static char s_intexpt[] = "integer-expt", s_cintlog[] = "ceiling-integer-log"; +static char s_dfloat_parts[] = "double-float-parts"; +#define s_intlog (&s_cintlog[8]) /*** NUMBERS -> STRINGS ***/ #ifdef FLOATS static int dbl_mant_dig = 0; static double max_dbl_int; /* Integers less than or equal to max_dbl_int are representable exactly as doubles. */ -static double dbl_eps; + +int inf2str(f, a) + double f; + char *a; +{ + sizet ch = 0; + if (f < 0.0) a[ch++] = '-'; + else if (f > 0.0) a[ch++] = '+'; + else { + a[ch++] = '+'; + strcpy(&a[ch], str_nan0); + return ch+sizeof(str_nan0)-1; + } + strcpy(&a[ch], str_inf0); + return ch+sizeof(str_inf0)-1; +} + +/* idbl2str() is the top level double-to-string conversion */ +static sizet idbl2str(f, a) + double f; + char *a; +{ + sizet ch = 0; + if (f==0.0) {strcpy(a, str_0); return sizeof(str_0)-1;} + if (f==2*f) return inf2str(f, a); + if (f < 0.0) {f = -f;a[ch++]='-';} + else if (f > 0.0) ; + else return inf2str(f, a); + return pdbl2str(f, a, ch); +} + +static double llog2 = .30102999566398114; /* log10(2) */ + +/* There are also temporary strings used in number->string conversion. */ +void strrecy(str) + SCM str; +{ + if (IMP(str) || !STRINGP(str)) return; + DEFER_INTS; + must_free(CHARS(str), (sizet)LENGTH(str)); + CAR(str) = MAKINUM(1); + CDR(str) = INUM0; + ALLOW_INTS; +} + +# ifdef BIGDIG + +/* The useful extent of bignums used in floating-point conversions is */ +/* limited. Recycle them explicitly, rather than waiting for GC. */ + +void bigrecy(bgnm) + SCM bgnm; +{ + if (IMP(bgnm) || !BIGP(bgnm)) return; + DEFER_INTS; + must_free(CHARS(bgnm), (sizet)NUMDIGS(bgnm)*sizeof(BIGDIG)); + CAR(bgnm) = INUM0; + CDR(bgnm) = INUM0; + ALLOW_INTS; +} + +/* can convert to string accurately with bignums */ +/* f > 0 */ +/* DBL_MIN_EXP = -1021 */ +/* dbl_mant_dig = 53 */ +static sizet pdbl2str(f, a, ch) + double f; + char *a; + sizet ch; +{ + SCM mant, quo, num; + sizet dp = ch; + int e2, point, ndig = dbl_mant_dig; + /* code from scm_dfloat_parts() */ + double dman = frexp(f, &e2); +# ifdef DBL_MIN_EXP + if (e2 < DBL_MIN_EXP) + ndig -= DBL_MIN_EXP - e2; +# endif + e2 -= ndig; + mant = dbl2big(ldexp(dman, ndig)); + point = ceil(e2*llog2); + /* if (scm_verbose > 1) printf("mantissa = %g -> #x%s; e2 = %d -> %d; point = %d; ndig = %d -> %d\n", dman, CHARS(number2string(mant, MAKINUM(16))), e2+ndig, e2, point, dbl_mant_dig, ndig); */ + if (e2 >= 0) { + /* try first with starved precision */ + { + num = scm_ash(mant, MAKINUM(e2 - point)); + bigrecy(mant); + quo = scm_round_quotient(num, VELTS(pows5)[(long) point]); + if (pmantexp2dbl(quo, point) != f) { + bigrecy(quo); quo = num; + num = scm_ash(quo, MAKINUM(1L)); + bigrecy(quo); + quo = scm_round_quotient(num, VELTS(pows5)[(long) --point]); + } + } + } else { /* e2 <= 0 */ + /* try first with starved precision */ + { + SCM den = scm_ash(MAKINUM(1L), MAKINUM(point - e2)); + num = product(mant, VELTS(pows5)[- (long) point]); + bigrecy(mant); + quo = scm_round_quotient(num, den); + if (pmantexp2dbl(quo, point) != f) { + bigrecy(quo); quo = num; + point--; + num = product(quo, MAKINUM(10)); + if (mant != MAKINUM(1)) bigrecy(quo); + quo = scm_round_quotient(num, den); + } + bigrecy(den); + } + } + bigrecy(num); + a[ch++] = '.'; + /* if (sizeof(UBIGLONG)>=sizeof(double)) /\* Is ulong larger than mantissa? *\/ */ + /* ch += iulong2str(num2ulong(quo, (char *)ARG1, s_number2string), 10, &a[ch]); */ + /* else */ { + SCM str = number2string(quo, MAKINUM(10)); + int len = LENGTH(str), i = 0; + bigrecy(quo); + point += len - 1; + while (i < len) a[ch++] = CHARS(str)[i++]; + strrecy(str); + } + a[dp] = a[dp+1]; a[++dp] = '.'; +# ifdef ENGNOT + while ((dp+1 < ch) && (point+9999)%3) { a[dp] = a[dp+1]; a[++dp] = '.'; point--; } +# endif /* ENGNOT */ + while ('0'==a[--ch]); ch++; + if (point != 0) { + a[ch++] = 'e'; + return ch + ilong2str(point, 10, &a[ch]); + } else return ch; +} +# else /* ~BIGDIG */ + +/* DBL2STR_FUZZ is a somewhat arbitrary guard against + round off error in scaling f and fprec. */ +# define DBL2STR_FUZZ 0.9 +int dblprec; +/* static double dbl_eps; */ double dbl_prec(x) double x; { int expt; double frac = frexp(x, &expt); -# ifdef DBL_MIN_EXP +# ifdef DBL_MIN_EXP if (0.0==x || expt < DBL_MIN_EXP) /* gradual underflow */ return ldexp(1.0, - dbl_mant_dig) * ldexp(1.0, DBL_MIN_EXP); -# endif +# endif if (1.0==frac) return ldexp(1.0, expt - dbl_mant_dig + 1); return ldexp(1.0, expt - dbl_mant_dig); } -static double llog2 = 0.3010299956639812; /* log10(2) */ static int apx_log10(x) double x; { @@ -116,51 +264,17 @@ static double lpow10(x, n) return x/p10[-n]; } -int inf2str(f, a) - double f; - char *a; -{ - sizet ch = 0; - if (f < 0.0) a[ch++] = '-'; - else if (f > 0.0) a[ch++] = '+'; - else { - a[ch++] = '0'; a[ch++] = '/'; a[ch++] = '0'; - return ch; - } - while (str_inf0[ch - 1]) { - a[ch] = str_inf0[ch - 1]; - ch++; - } -/* # ifdef COMPACT_INFINITY_NOTATION */ -/* else a[ch++] = '0'; */ -/* # else */ -/* a[ch++] = (f != f) ? '0' : '1'; */ -/* # endif */ -/* a[ch++] = '/'; a[ch++] = '0'; */ - return ch; -} - -/* DBL2STR_FUZZ is a somewhat arbitrary guard against - round off error in scaling f and fprec. */ -# define DBL2STR_FUZZ 0.9 -int dblprec; -static sizet idbl2str(f, a) +/* f is finite and positive */ +static sizet pdbl2str(f, a, ch) double f; char *a; + sizet ch; { double fprec = dbl_prec(f); - int efmt, dpt, d, i, exp; - sizet ch = 0; - - if (f==0.0) {exp = 0; goto zero;} /*{a[0]='0'; a[1]='.'; a[2]='0'; return 3;}*/ - if (f==2*f) return inf2str(f, a); - if (f < 0.0) {f = -f;a[ch++]='-';} - else if (f > 0.0) ; - else return inf2str(f, a); - exp = apx_log10(f); + int efmt, dpt, d, i, exp = apx_log10(f); f = lpow10(f, -exp); fprec = lpow10(fprec, -exp); -# ifdef DBL_MIN_10_EXP /* Prevent random unnormalized values, as from +# ifdef DBL_MIN_10_EXP /* Prevent random unnormalized values, as from make-uniform-vector, from causing infinite loops, but try to print gradually underflowing numbers. */ while (f < 1.0) { @@ -173,18 +287,18 @@ static sizet idbl2str(f, a) fprec /= 10.0; if (exp++ > DBL_MAX_10_EXP) return inf2str(f, a); } -# else +# else while (f < 1.0) {f *= 10.0; fprec *= 10.0; exp--;} while (f > 10.0) {f /= 10.0; fprec /= 10.0; exp++;} -# endif +# endif fprec *= 0.5; if (f+fprec >= 10.0) {f = 1.0; exp++;} - zero: -# ifdef ENGNOT + /* zero: */ +# ifdef ENGNOT dpt = (exp+9999)%3; exp -= dpt++; efmt = 1; -# else +# else efmt = (exp < -3) || (exp > dblprec+2); if (!efmt) if (exp < 0) { @@ -196,7 +310,7 @@ static sizet idbl2str(f, a) dpt = exp+1; else dpt = 1; -# endif +# endif for (i = 30; i--;) { /* printf(" f = %.20g, fprec = %.20g, i = %d\n", f, fprec, i); */ @@ -214,7 +328,7 @@ static sizet idbl2str(f, a) } if (dpt > 0) -# ifndef ENGNOT +# ifndef ENGNOT if ((dpt > 4) && (exp > 6)) { d = (a[0]=='-'?2:1); for (i = ch++; i > d; i--) @@ -222,7 +336,7 @@ static sizet idbl2str(f, a) a[d] = '.'; efmt = 1; } else -# endif +# endif { while (--dpt) a[ch++] = '0'; a[ch++] = '.'; @@ -242,6 +356,7 @@ static sizet idbl2str(f, a) } return ch; } +# endif /* ~BIGDIG */ static sizet iflo2str(flt, str) SCM flt; @@ -263,7 +378,7 @@ static sizet iflo2str(flt, str) } #endif /* FLOATS */ -sizet iuint2str(num, rad, p) +sizet iulong2str(num, rad, p) unsigned long num; int rad; char *p; @@ -281,16 +396,16 @@ sizet iuint2str(num, rad, p) } return j; } -sizet iint2str(num, rad, p) +sizet ilong2str(num, rad, p) long num; int rad; char *p; { if ((num < 0) && !(rad < 0)) { *p++ = '-'; - return 1 + iuint2str((unsigned long) -num, rad, p); + return 1 + iulong2str((unsigned long) -num, rad, p); } - return iuint2str((unsigned long) num, rad < 0 ? -rad : rad, p); + return iulong2str((unsigned long) num, rad < 0 ? -rad : rad, p); } #ifdef BIGDIG static SCM big2str(b, radix) @@ -329,6 +444,7 @@ static SCM big2str(b, radix) for (i = j;j < LENGTH(ss);j++) s[ch+j-i] = s[j]; /* jeh */ resizuve(ss, (SCM)MAKINUM(ch+LENGTH(ss)-i)); /* jeh */ } + bigrecy(t); return ss; } #endif @@ -364,7 +480,7 @@ SCM number2string(x, radix) #endif { char num_buf[INTBUFLEN]; - return makfromstr(num_buf, iint2str(INUM(x), (int)INUM(radix), num_buf)); + return makfromstr(num_buf, ilong2str(INUM(x), (int)INUM(radix), num_buf)); } } /* These print routines are stubbed here so that repl.c doesn't need @@ -406,17 +522,17 @@ int bigprint(exp, port, writing) SCM istr2int(str, len, radix) char *str; long len; - register long radix; + register int radix; { - sizet j; register sizet k, blen = 1; - sizet i = 0; + sizet i = 0, j; int c; SCM res; register BIGDIG *ds; - register unsigned long t2; + register UBIGLONG t2; if (0 >= len) return BOOL_F; /* zero length */ + /* Estimate number of digits; will trim during finish */ if (10==radix) j = 1+(84*len)/(BITSPERDIG*25); else j = (8 < radix) ? 1+(4*len)/BITSPERDIG : 1+(3*len)/BITSPERDIG; switch (str[0]) { /* leading sign */ @@ -425,6 +541,7 @@ SCM istr2int(str, len, radix) } res = mkbig(j, '-'==str[0]); ds = BDIGITS(res); + /* clear allocated digits */ for (k = j;k--;) ds[k] = 0; do { switch (c = str[i++]) { @@ -441,9 +558,9 @@ SCM istr2int(str, len, radix) k = 0; t2 = c; moretodo: - while(k < blen) { -/* printf("k = %d, blen = %d, t2 = %ld, ds[k] = %d\n", k, blen, t2, ds[k]);*/ - t2 += ds[k]*radix; + /* Add t2 into temp bignum */ + while (k < blen) { + t2 += ((UBIGLONG)ds[k])*radix; ds[k++] = BIGLO(t2); t2 = BIGDN(t2); } @@ -463,7 +580,7 @@ SCM istr2int(str, len, radix) SCM istr2int(str, len, radix) register char *str; long len; - register long radix; + register int radix; { register long n = 0, ln; register int c; @@ -514,31 +631,114 @@ SCM istr2int(str, len, radix) #ifdef FLOATS # ifdef BIGDIG -static char twostab[] = {4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0}; -static long scm_twos_power(n) - SCM n; -{ - long d, c = 0; - int d4; -# ifdef BIGDIG - if (NINUMP(n)) { - BIGDIG *ds; - int i = 0; - ds = BDIGITS(n); - while (0==(d = ds[i++])) c += BITSPERDIG; - goto out; + +/* [Jaffer] */ +/* In Clinger's "How to Read Floating-Point Numbers Accurately" */ +/* the key issue is that successive rounding does not have the */ +/* same effect as one rounding operation. With bignums it is */ +/* a simple matter to accumulate digits without rounding. */ +/* The approach here is to compute the binary value without rounding, */ +/* then round explicitly when scaling the bigint to fit into the */ +/* mantissa. */ + +/* manstr is the mantissa with the decimal point removed and point + (the exponent) adjusted appropriately */ +double mantexp2dbl(manstr, point) + SCM manstr; + int point; +{ + SCM bmant = istr2int(CHARS(manstr), LENGTH(manstr), 10L); + double val = pmantexp2dbl(bmant, point); + bigrecy(bmant); + return val; +} +double pmantexp2dbl(bmant, point) + SCM bmant; + int point; +{ + double ans; + if (BOOL_F == bmant) return REAL(scm_narn); + if (point >= 0) { + SCM quo, num = product(bmant, VELTS(pows5)[(long) point]); + int bex = INUM(scm_intlength(num)) - dbl_mant_dig; + if (bex > 0) { + SCM den = scm_ash(MAKINUM(1L), MAKINUM(bex)); + quo = scm_round_quotient(num, den); + bigrecy(den); + } + else + quo = scm_ash(num, MAKINUM(- bex)); + /* quo may not be a bignum */ + if (INUMP(quo)) ans = ldexp((double)(INUM(quo)), bex + point); + else { + sizet i = NUMDIGS(quo); + sizet j = i - (dbl_mant_dig + BITSPERDIG - 1)/BITSPERDIG; + BIGDIG *digits = BDIGITS(quo); + ans = 0.0; + while (i-- > j) ans = digits[i] + ldexp(ans, BITSPERDIG); + bex += j * BITSPERDIG; + ans = ldexp(ans, bex + point); + } + if (num != quo) bigrecy(quo); + if (bmant != MAKINUM(1L)) bigrecy(num); + return ans; + } else { + int maxpow = LENGTH(pows5) - 1; + SCM scl = (-point <= maxpow) ? + VELTS(pows5)[(long) -point] : + product(VELTS(pows5)[(long)maxpow], VELTS(pows5)[(long)-point-maxpow]); + int bex = /* bex < 0 */ + INUM(scm_intlength(bmant)) - INUM(scm_intlength(scl)) - dbl_mant_dig; + SCM num = scm_ash(bmant, MAKINUM(-bex)); + SCM quo = scm_round_quotient(num, scl); + if (INUM(scm_intlength(quo)) > dbl_mant_dig) { + bex++; /* too many bits of quotient */ + quo = scm_round_quotient(num, scm_ash(scl, MAKINUM(1L))); + } + if (-point > maxpow) bigrecy(scl); + bigrecy(num); + ans = ldexp(int2dbl(quo), bex + point); + bigrecy(quo); + return ans; } +} + +# else /* def BIGDIG */ + +double mantexp2dbl(manstr, point) + SCM manstr; + int point; +{ + register int c, i = 0; + double res = 0.0; + char *str = CHARS(manstr); + int len = LENGTH(manstr); + do { /* check initial digits */ + switch (c = str[i]) { + case DIGITS: + c = c - '0'; + res = res * 10 + c; + break; + case 'D': case 'E': case 'F': + case 'd': case 'e': case 'f': + default: + goto out1; + } + } while (++i < len); + out1: + if (point >= 0) + while (point--) res *= 10.0; + else + while (point++) { +# ifdef _UNICOS + res *= 0.1; +# else + res /= 10.0; # endif - d = INUM(n); - if (0==d) return 0; - out: - do { - d4 = 15 & d; - c += twostab[d4]; - d >>= 4; - } while (0==d4); - return c; + } + return res; } + # endif /* def BIGDIG */ SCM istr2flo(str, len, radix) @@ -546,37 +746,38 @@ SCM istr2flo(str, len, radix) register long len; register long radix; { - register int c, i = 0; - double lead_sgn = 0.0; + register int c, i = 0, j = 0; + int lead_sgn = 0; double res = 0.0, tmp = 0.0; int flg = 0; int point = 0; - SCM second; + int shrtp = 0; + SCM second, manstr; + char *mant; if (i >= len) return BOOL_F; /* zero length */ switch (*str) { /* leading sign */ - case '-': lead_sgn = -1.0; i++; break; - case '+': lead_sgn = 1.0; i++; break; + case '-': lead_sgn = -1; i++; break; + case '+': lead_sgn = 1; i++; break; } if (i==len) return BOOL_F; /* bad if lone `+' or `-' */ - if (6==len && ('+'==str[0] || '-'==str[0])) - if (0==strcmp(str_inf0, &str[1])) + if (6==len && ('+'==str[0] || '-'==str[0])) { + if (0==strcasecmp(str_inf0, &str[1])) return makdbl(1./0. * ('+'==str[0] ? 1 : -1), 0.0); - + else if (0==strcasecmp(str_nan0, &str[1])) + return scm_narn; + } if (str[i]=='i' || str[i]=='I') { /* handle `+i' and `-i' */ - if (lead_sgn==0.0) return BOOL_F; /* must have leading sign */ + if (lead_sgn==0) return BOOL_F; /* must have leading sign */ if (++i < len) return BOOL_F; /* `i' not last character */ - return makdbl(0.0, lead_sgn); - } - /* # ifdef COMPACT_INFINITY_NOTATION */ - if (0.0 != lead_sgn && str[i]=='/') { - res = 1; - flg = 1; - goto out1; + return makdbl(0.0, (double)lead_sgn); } - /* # endif */ + + manstr = makstr(len); + mant = CHARS(manstr); + do { /* check initial digits */ switch (c = str[i]) { case DIGITS: @@ -593,6 +794,7 @@ SCM istr2flo(str, len, radix) c = c-'a'+10; accum1: if (c >= radix) return BOOL_F; /* bad digit for radix */ + mant[j++] = str[i]; res = res * radix + c; flg = 1; /* res is valid */ break; @@ -607,16 +809,15 @@ SCM istr2flo(str, len, radix) /* By here, must have seen a digit, or must have next char be a `.' with radix==10 */ - if (!flg) - if (!(str[i]=='.' && radix==10)) - return BOOL_F; + if ((!flg) && (!(str[i]=='.' && radix==10))) return BOOL_F; while (str[i]=='#') { /* optional sharps */ res *= radix; + mant[j++] = '0'; if (++i==len) goto done; } - if (str[i]=='/') { + if (str[i]=='/' && i+1 < len) { while (++i < len) { switch (c = str[i]) { case DIGITS: @@ -640,6 +841,7 @@ SCM istr2flo(str, len, radix) if (i < len) while (str[i]=='#') { /* optional sharps */ tmp *= radix; + mant[j++] = '0'; if (++i==len) break; } res /= tmp; @@ -654,6 +856,7 @@ SCM istr2flo(str, len, radix) point--; res = res*10.0 + c-'0'; flg = 1; + mant[j++] = str[i]; break; default: goto out3; @@ -668,60 +871,56 @@ SCM istr2flo(str, len, radix) } switch (str[i]) { /* exponent */ + case 'f': case 'F': + case 's': case 'S': + shrtp = !0; case 'd': case 'D': case 'e': case 'E': - case 'f': case 'F': - case 'l': case 'L': - case 's': case 'S': { - int expsgn = 1, expon = 0; - if (radix != 10) return BOOL_F; /* only in radix 10 */ - if (++i==len) return BOOL_F; /* bad exponent */ - switch (str[i]) { - case '-': expsgn=(-1); - case '+': if (++i==len) return BOOL_F; /* bad exponent */ - } - if (str[i] < '0' || str[i] > '9') return BOOL_F; /* bad exponent */ - do { - switch (c = str[i]) { - case DIGITS: - expon = expon*10 + c-'0'; - /* if (expon > MAXEXP) */ - /* if (1==expsgn || expon > (MAXEXP + dblprec + 1)) */ - /* return BOOL_F; /\* exponent too large *\/ */ - break; - default: - goto out4; + case 'l': case 'L': { + int expsgn = 1, expon = 0; + if (radix != 10) return BOOL_F; /* only in radix 10 */ + if (++i==len) return BOOL_F; /* bad exponent */ + switch (str[i]) { + case '-': expsgn=(-1); + case '+': if (++i==len) return BOOL_F; /* bad exponent */ } - } while (++i < len); - out4: - point += expsgn*expon; - } + if (str[i] < '0' || str[i] > '9') return BOOL_F; /* bad exponent */ + do { + switch (c = str[i]) { + case DIGITS: + expon = expon*10 + c-'0'; + /* if (expon > MAXEXP) */ + /* if (1==expsgn || expon > (MAXEXP + dblprec + 1)) */ + /* return BOOL_F; /\* exponent too large *\/ */ + break; + default: + goto out4; + } + } while (++i < len); + out4: + point += expsgn*expon; + } } adjust: - if (point >= 0) - while (point--) res *= 10.0; - else -# ifdef _UNICOS - while (point++) res *= 0.1; -# else - while (point++) res /= 10.0; -# endif + mant[j] = 0; + manstr = resizuve(manstr, MAKINUM(j)); + if (radix == 10) res = mantexp2dbl(manstr, point); done: /* at this point, we have a legitimate floating point result */ - if (lead_sgn==-1.0) res = -res; - if (i==len) return makdbl(res, 0.0); + if (lead_sgn==-1) res = -res; + if (i==len) return shrtp ? makflo(res) : makdbl(res, 0.0); if (str[i]=='i' || str[i]=='I') { /* pure imaginary number */ - if (lead_sgn==0.0) return BOOL_F; /* must have leading sign */ + if (lead_sgn==0) return BOOL_F; /* must have leading sign */ if (++i < len) return BOOL_F; /* `i' not last character */ return makdbl(0.0, res); } switch (str[i++]) { - case '-': lead_sgn = -1.0; break; - case '+': lead_sgn = 1.0; break; + case '-': lead_sgn = -1; break; + case '+': lead_sgn = 1; break; case '@': { /* polar input for complex number */ /* get a `real' for angle */ second = istr2flo(&str[i], (long)(len-i), radix); @@ -737,7 +936,7 @@ SCM istr2flo(str, len, radix) /* at this point, last char must be `i' */ if (str[len-1] != 'i' && str[len-1] != 'I') return BOOL_F; /* handles `x+i' and `x-i' */ - if (i==(len-1)) return makdbl(res, lead_sgn); + if (i==(len-1)) return makdbl(res, (double)lead_sgn); /* get a `ureal' for complex part */ second = istr2flo(&str[i], (long)((len-i)-1), radix); if (IMP(second)) return BOOL_F; @@ -1003,9 +1202,10 @@ SCM equal(x, y) if (smobs[i].equalp) return (smobs[i].equalp)(x, y); else return BOOL_F; } - case tc7_Vbool: case tc7_VfixN8: case tc7_VfixZ8: - case tc7_VfixN16: case tc7_VfixZ16: case tc7_VfixN32: case tc7_VfixZ32: - case tc7_VfloR32: case tc7_VfloC32: case tc7_VfloC64: case tc7_VfloR64: { + case tc7_VfixN8: case tc7_VfixZ8: case tc7_VfixN16: case tc7_VfixZ16: + case tc7_VfixN32: case tc7_VfixZ32: case tc7_VfixN64: case tc7_VfixZ64: + case tc7_VfloR32: case tc7_VfloC32: case tc7_VfloC64: case tc7_VfloR64: + case tc7_Vbool: { SCM (*pred)() = smobs[0x0ff & (tc16_array>>8)].equalp; if (pred) return (*pred)(x, y); else return BOOL_F; @@ -1035,21 +1235,50 @@ SCM scm_complex_p(obj) } # ifdef BIGDIG +static char twostab[] = {4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0}; +static long scm_twos_power(n) + SCM n; +{ + long d, c = 0; + int d4; +# ifdef BIGDIG + if (NINUMP(n)) { + BIGDIG *ds; + int i = 0; + ds = BDIGITS(n); + while (0==(d = ds[i++])) c += BITSPERDIG; + goto out; + } +# endif + d = INUM(n); + if (0==d) return 0; + out: + do { + d4 = 15 & d; + c += twostab[d4]; + d >>= 4; + } while (0==d4); + return c; +} + int scm_bigdblcomp(b, d) SCM b; double d; { - sizet dlen, blen; + int dlen = 99; + sizet blen = 0; int dneg = d < 0 ? 1 : 0; int bneg = BIGSIGN(b) ? 1 : 0; if (bneg < dneg) return -1; if (bneg > dneg) return 1; - frexp(d, &dlen); - blen = INUM(scm_intlength(b)); + if (!(d==2*d && d != 0.0)) { + frexp(d, &dlen); + blen = INUM(scm_intlength(b)); + } if (blen > dlen) return dneg ? 1 : -1; if (blen < dlen) return dneg ? -1 : 1; if ((blen <= dbl_mant_dig) || (blen - scm_twos_power(b)) <= dbl_mant_dig) { - double bd = big2dbl(b); + double bd = int2dbl(b); if (bd > d) return -1; if (bd < d) return 1; return 0; @@ -1357,7 +1586,7 @@ SCM negativep(x) } static char s_exactprob[] = "not representable as inexact"; -SCM lmax(x, y) +SCM scm_max(x, y) SCM x, y; { #ifdef FLOATS @@ -1382,7 +1611,7 @@ SCM lmax(x, y) ASRTGO(REALP(y), bady); big_dbl: if (-1 != scm_bigdblcomp(x, REALPART(y))) return y; - z = big2dbl(x); + z = int2dbl(x); ASRTER(0==scm_bigdblcomp(x, z), x, s_exactprob, s_max); return makdbl(z, 0.0); } @@ -1441,7 +1670,7 @@ SCM lmax(x, y) return ((long)x < (long)y) ? y : x; } -SCM lmin(x, y) +SCM scm_min(x, y) SCM x, y; { #ifdef FLOATS @@ -1466,7 +1695,7 @@ SCM lmin(x, y) ASRTGO(REALP(y), bady); big_dbl: if (1 != scm_bigdblcomp(x, REALPART(y))) return y; - z = big2dbl(x); + z = int2dbl(x); ASRTER(0==scm_bigdblcomp(x, z), x, s_exactprob, s_min); return makdbl(z, 0.0); } @@ -1549,7 +1778,7 @@ SCM sum(x, y) return addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0); } ASRTGO(INEXP(y), bady); - bigreal: return makdbl(big2dbl(x)+REALPART(y), CPLXP(y)?IMAG(y):0.0); + bigreal: return makdbl(int2dbl(x)+REALPART(y), CPLXP(y)?IMAG(y):0.0); } ASRTGO(INEXP(x), badx); # else @@ -1647,7 +1876,7 @@ SCM difference(x, y) if (NINUMP(x)) { # ifndef RECKLESS if (!(NIMP(x))) - badx: wta(x, (char *)ARG1, s_difference); + badx: wta(x, (char *)ARG1, s_difference); # endif if (UNBNDP(y)) { # ifdef BIGDIG @@ -1666,12 +1895,12 @@ SCM difference(x, y) if (BIGP(x)) { if (BIGP(y)) return (NUMDIGS(x) < NUMDIGS(y)) ? addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) : - addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0); + addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0); ASRTGO(INEXP(y), bady); - return makdbl(big2dbl(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0); + return makdbl(int2dbl(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0); } ASRTGO(INEXP(x), badx); - if (BIGP(y)) return makdbl(REALPART(x)-big2dbl(y), CPLXP(x)?IMAG(x):0.0); + if (BIGP(y)) return makdbl(REALPART(x)-int2dbl(y), CPLXP(x)?IMAG(x):0.0); ASRTGO(INEXP(y), bady); # else ASRTGO(INEXP(x), badx); @@ -1701,12 +1930,12 @@ SCM difference(x, y) } # ifndef RECKLESS if (!(INEXP(y))) - bady: wta(y, (char *)ARG2, s_difference); + bady: wta(y, (char *)ARG2, s_difference); # endif # else # ifndef RECKLESS if (!(NIMP(y) && INEXP(y))) - bady: wta(y, (char *)ARG2, s_difference); + bady: wta(y, (char *)ARG2, s_difference); # endif # endif return makdbl(INUM(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0); @@ -1739,7 +1968,7 @@ SCM difference(x, y) if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) - bady: wta(y, (char *)ARG2, s_difference); + bady: wta(y, (char *)ARG2, s_difference); # endif { # ifndef DIGSTOOBIG @@ -1932,7 +2161,7 @@ SCM divide(x, y) # endif if (UNBNDP(y)) { # ifdef BIGDIG - if (BIGP(x)) return makdbl(1.0/big2dbl(x), 0.0); + if (BIGP(x)) return inex_divintbig(MAKINUM(1L), x); # endif /* reciprocal */ ASRTGO(INEXP(x), badx); @@ -1953,19 +2182,23 @@ SCM divide(x, y) if (z < 0) z = -z; if (z < BIGRAD) { SCM w = copybig(x, BIGSIGN(x) ? (y>0) : (y<0)); - return divbigdig(BDIGITS(w), NUMDIGS(w), (BIGDIG)z) ? - bigdblop('/', x, INUM(y), 0.0) : normbig(w); + int sts = divbigdig(BDIGITS(w), NUMDIGS(w), (BIGDIG)z); + if (sts) { + bigrecy(w); + return bigdblop('/', x, INUM(y), 0.0); + } + else return normbig(w); } # ifndef DIGSTOOBIG z = pseudolong(z); z = divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&z, DIGSPERLONG, - BIGSIGN(x) ? (y>0) : (y<0), 3); + BIGSIGN(x) ? (y>0) : (y<0), 4); # else { BIGDIG zdigs[DIGSPERLONG]; longdigs(z, zdigs); z = divbigbig(BDIGITS(x), NUMDIGS(x), zdigs, DIGSPERLONG, - BIGSIGN(x) ? (y>0) : (y<0), 3); + BIGSIGN(x) ? (y>0) : (y<0), 4); } # endif return z ? z : bigdblop('/', x, INUM(y), 0.0); @@ -1973,8 +2206,8 @@ SCM divide(x, y) ASRTGO(NIMP(y), bady); if (BIGP(y)) { z = divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), - BIGSIGN(x) ^ BIGSIGN(y), 3); - return z ? z : inex_divbigbig(x, y); + BIGSIGN(x) ^ BIGSIGN(y), 4); + return z ? z : inex_divintbig(x, y); } ASRTGO(INEXP(y), bady); return bigdblop('/', x, REALPART(y), CPLXP(y) ? IMAG(y) : 0.0); @@ -2020,7 +2253,7 @@ SCM divide(x, y) if (NINUMP(y)) { # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if (BIGP(y)) return bigdblop('\\', y, INUM(x), 0.0); + if (BIGP(y)) return inex_divintbig(x, y); /* bigdblop('\\', y, INUM(x), 0.0); */ # ifndef RECKLESS if (!(INEXP(y))) bady: wta(y, (char *)ARG2, s_divide); @@ -2064,25 +2297,29 @@ SCM divide(x, y) if (z < 0) z = -z; if (z < BIGRAD) { SCM w = copybig(x, BIGSIGN(x) ? (y>0) : (y<0)); - if (divbigdig(BDIGITS(w), NUMDIGS(w), (BIGDIG)z)) goto ov; + int sts = divbigdig(BDIGITS(w), NUMDIGS(w), (BIGDIG)z); + if (sts) { + bigrecy(w); + goto ov; + } return w; } # ifndef DIGSTOOBIG z = pseudolong(z); z = divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&z, DIGSPERLONG, - BIGSIGN(x) ? (y>0) : (y<0), 3); + BIGSIGN(x) ? (y>0) : (y<0), 4); # else { BIGDIG zdigs[DIGSPERLONG]; longdigs(z, zdigs); z = divbigbig(BDIGITS(x), NUMDIGS(x), zdigs, DIGSPERLONG, - BIGSIGN(x) ? (y>0) : (y<0), 3); + BIGSIGN(x) ? (y>0) : (y<0), 4); } # endif } else { ASRTGO(NIMP(y) && BIGP(y), bady); z = divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), - BIGSIGN(x) ^ BIGSIGN(y), 3); + BIGSIGN(x) ^ BIGSIGN(y), 4); } if (!z) goto ov; return z; @@ -2123,11 +2360,50 @@ SCM divide(x, y) } } +SCM ilog(m, b, k, n) + unsigned long m; + SCM b, k; + unsigned long *n; +{ + /* printf("call ilog %ld ", m); scm_iprin1(b, cur_outp, 0); printf(" "); scm_iprin1(k, cur_outp, 0); printf("\n"); */ + if (BOOL_T==lessp(k, b)) return k; + *n += m; + { + SCM q = ilog(2*m, product(b, b), lquotient(k, b), n); + /* printf("return ilog "); scm_iprin1(q, cur_outp, 0); printf("\n"); */ + if (BOOL_T==lessp(q, b)) return q; + *n += m; + return lquotient(q, b); + } +} + +SCM scm_intlog(base, k) + SCM base, k; +{ + unsigned long n = 1; + ASRTER(INUMP(base) || (NIMP(base) && BIGP(base)), base, ARG1, s_intlog); + ASRTER(BOOL_T==lessp(MAKINUM(1L), base), base, OUTOFRANGE, s_intlog); + ASRTER((INUMP(k) && k > 0) || (NIMP(k) && TYP16(k)==tc16_bigpos), k, ARG2, s_intlog); + if (BOOL_T==lessp(k, base)) return INUM0; + ilog(1, base, lquotient(k, base), &n); + return MAKINUM(n); +} + +#ifdef INUMS_ONLY +# define eqv eqp +#endif +SCM scm_cintlog(base, k) + SCM base, k; +{ + SCM il = scm_intlog(base, k); + return (BOOL_T==eqv(k, scm_intexpt(base, il))) ? il : sum(MAKINUM(1L), il); +} + SCM scm_intexpt(z1, z2) SCM z1, z2; { SCM acc = MAKINUM(1L); - int recip = 0; + long iz2; #ifdef FLOATS double dacc, dz1; #endif @@ -2135,25 +2411,20 @@ SCM scm_intexpt(z1, z2) ASRTER(INUMP(z2), z2, ARG2, s_intexpt); if (acc==z1) return z1; if (MAKINUM(-1L)==z1) return BOOL_F==evenp(z2)?z1:acc; - z2 = INUM(z2); - if (z2 < 0) { - z2 = -z2; - recip = 1; /* z1 = divide(z1, UNDEFINED); */ + iz2 = INUM(z2); + if (iz2 < 0L) { + iz2 = -iz2; + z1 = divide(z1, UNDEFINED); } if (INUMP(z1)) { - long tmp, iacc = 1, iz1 = INUM(z1); -#ifdef FLOATS - if (recip) { dz1 = iz1; goto flocase; } -#endif + long tmp, iacc = 1L, iz1 = INUM(z1); while (1) { - if (0==z2) { + if (0L==iz2) { acc = long2num(iacc); break; } - if (0==iz1) - if (0==recip) return z1; - else goto overflow; - if (1==z2) { + if (0L==iz1) return z1; + if (1L==iz2) { tmp = iacc*iz1; if (tmp/iacc != iz1) { overflow: @@ -2165,20 +2436,20 @@ SCM scm_intexpt(z1, z2) acc = long2num(tmp); break; } - if (z2 & 1) { + if (iz2 & 1) { tmp = iacc*iz1; if (tmp/iacc != iz1) goto overflow; iacc = tmp; - z2 = z2 - 1; /* so jumping to gencase works */ + iz2 = iz2 - 1L; /* so jumping to gencase works */ } tmp = iz1*iz1; if (tmp/iz1 != iz1) goto overflow; iz1 = tmp; - z2 >>= 1; + iz2 >>= 1; } #ifndef RECKLESS if (FALSEP(acc)) - errout: wta(UNDEFINED, (char *)OVFLOW, s_intexpt); + errout: wta(UNDEFINED, (char *)OVFLOW, s_intexpt); #endif goto ret; } @@ -2186,27 +2457,50 @@ SCM scm_intexpt(z1, z2) #ifdef FLOATS if (REALP(z1)) { dz1 = REALPART(z1); - flocase: dacc = 1.0; while(1) { - if (0==z2) break; - if (1==z2) {dacc = dacc*dz1; break;} - if (z2 & 1) dacc = dacc*dz1; + if (0L==iz2) break; + if (1L==iz2) {dacc = dacc*dz1; break;} + if (iz2 & 1) dacc = dacc*dz1; dz1 = dz1*dz1; - z2 >>= 1; + iz2 >>= 1; } - return makdbl(recip ? 1.0/dacc : dacc, 0.0); + return makdbl(dacc, 0.0); } #endif gencase: - while(1) { - if (0==z2) break; - if (1==z2) {acc = product(acc, z1); break;} - if (z2 & 1) acc = product(acc, z1); - z1 = product(z1, z1); - z2 >>= 1; + { + SCM tz1 = z1; + while(1) { + SCM tmp; + if (0L==iz2) break; + if (1L==iz2) { + tmp = acc; + acc = product(tmp, tz1); +#ifdef BIGDIG + bigrecy(tmp); +#endif + break; + } + if (iz2 & 1) { + tmp = acc; + acc = product(tmp, tz1); +#ifdef BIGDIG + bigrecy(tmp); +#endif + } + tmp = tz1; + tz1 = product(tmp, tmp); +#ifdef BIGDIG + if (tmp != z1 && tmp != acc) bigrecy(tmp); +#endif + iz2 >>= 1; + } +#ifdef BIGDIG + if (tz1 != acc && tz1 != z1) bigrecy(tz1); +#endif } - ret: return recip ? divide(acc, UNDEFINED) : acc; + ret: return acc; } #ifdef FLOATS @@ -2258,7 +2552,7 @@ void two_doubles(z1, z2, sstring, xy) else { # ifdef BIGDIG ASRTGO(NIMP(z1), badz1); - if (BIGP(z1)) xy->x = big2dbl(z1); + if (BIGP(z1)) xy->x = int2dbl(z1); else { # ifndef RECKLESS if (!(REALP(z1))) @@ -2274,7 +2568,7 @@ void two_doubles(z1, z2, sstring, xy) else { # ifdef BIGDIG ASRTGO(NIMP(z2), badz2); - if (BIGP(z2)) xy->y = big2dbl(z2); + if (BIGP(z2)) xy->y = int2dbl(z2); else { # ifndef RECKLESS if (!(REALP(z2))) @@ -2425,7 +2719,7 @@ SCM ex2in(z) ASRTGO(NIMP(z), badz); if (INEXP(z)) return z; # ifdef BIGDIG - if (BIGP(z)) return makdbl(big2dbl(z), 0.0); + if (BIGP(z)) return makdbl(int2dbl(z), 0.0); # endif badz: wta(z, (char *)ARG1, s_ex2in); } @@ -2508,50 +2802,50 @@ SCM dbl2big(d) BIGDIG *digits; SCM ans; double u = (d < 0)?-d:d; + ASRTER(u == u && u != u/2, makdbl(d, 0.0), OVFLOW, "dbl2big"); while (0 != floor(u)) {u /= BIGRAD;i++;} ans = mkbig(i, d < 0); digits = BDIGITS(ans); while (i--) { - u *= BIGRAD; + u = ldexp(u, BITSPERDIG); c = floor(u); u -= c; digits[i] = c; } - ASRTER(0==u, INUM0, OVFLOW, "dbl2big"); - return ans; + ASRTER(0==u, makdbl(d, 0.0), OVFLOW, "dbl2big"); + return normbig(ans); } -double big2dbl(b) +/* This turns out to need explicit rounding for bignums */ +double int2dbl(b) SCM b; { - double ans = 0.0; - sizet i = NUMDIGS(b); - BIGDIG *digits = BDIGITS(b); - while (i--) ans = digits[i] + BIGRAD*ans; - if (tc16_bigneg==TYP16(b)) return -ans; - return ans; -} -static double big2scaldbl(b, expt) - SCM b; - int expt; -{ - double ans = 0.0; - int i = NUMDIGS(b) - 1; - BIGDIG *digits = BDIGITS(b); - while (i > (expt/BITSPERDIG)) { - ans = digits[i] + BIGRAD*ans; - i--; - } - ans = ldexp(ans, BITSPERDIG - expt); - /* - if (expt = (expt % BITSPERDIG)) { - ans = (digits[i] >> expt) + - (1L << (BITSPERDIG - expt))*ans; - } - if ((1L << (BITSPERDIG - expt - 1)) & digits[i]) - ans += 1; - */ - if (tc16_bigneg==TYP16(b)) return -ans; - return ans; + if (INUMP(b)) return (double)(INUM(b)); + { + SCM num = scm_iabs(b), quo = num; + int bex = INUM(scm_intlength(num)) - dbl_mant_dig; + double ans = 0.0; + if (bex > 0) { + SCM den = scm_ash(MAKINUM(1L), MAKINUM(bex)); + quo = scm_round_quotient(num, den); + bigrecy(den); + } + /* quo may not be a bignum */ + if (INUMP(quo)) + ans = ldexp((double)(INUM(quo)), bex); + else { + sizet i = NUMDIGS(quo); + sizet j = i - (dbl_mant_dig + BITSPERDIG - 1)/BITSPERDIG; + BIGDIG *digits = BDIGITS(quo); + if (j < 0) j = 0; + while (i-- > j) ans = digits[i] + ldexp(ans, BITSPERDIG); + bex += j * BITSPERDIG; + if (bex > 0) ans = ldexp(ans, bex); + } + if (num != b) bigrecy(num); + if (quo != b) bigrecy(quo); + if (tc16_bigneg==TYP16(b)) return -ans; + return ans; + } } static SCM bigdblop(op, b, re, im) int op; @@ -2561,54 +2855,65 @@ static SCM bigdblop(op, b, re, im) double bm = 0.0; int i = 0; if (NUMDIGS(b)*BITSPERDIG < DBL_MAX_EXP) { - bm = big2dbl(b); + bm = int2dbl(b); } else { i = INUM(scm_intlength(b)); if (i < DBL_MAX_EXP) { i = 0; - bm = big2dbl(b); + bm = int2dbl(b); } else { i = i + 1 - DBL_MAX_EXP; - bm = big2scaldbl(b, i); + bm = ldexp(int2dbl(b), -i); } } switch (op) { case '*': return makdbl(ldexp(bm*re, i), 0.0==im ? 0.0 : ldexp(bm*im, i)); - case '/': { - double d = re*re + im*im; - return makdbl(ldexp(bm*(re/d), i), ldexp(-bm*(im/d), i)); - } + case '/': + if (0.0==im) return makdbl(bm/re, 0.0); + { + double d = re*re + im*im; + return makdbl(ldexp(bm*(re/d), i), ldexp(-bm*(im/d), i)); + } case '\\': return makdbl(ldexp(re/bm, -i), 0.0==im ? 0.0 : ldexp(im/bm, -i)); default: return UNSPECIFIED; } } -static SCM inex_divbigbig(a, b) +/* now able to return unnomalized doubles. */ +static SCM inex_divintbig(a, b) SCM a, b; { double r; - if ((NUMDIGS(a)*BITSPERDIG < DBL_MAX_EXP) && - (NUMDIGS(b)*BITSPERDIG < DBL_MAX_EXP)) - r = big2dbl(a) / big2dbl(b); - else { - int i = INUM(scm_intlength(a)); - int j = INUM(scm_intlength(b)); - i = (i > j) ? i : j; - if (i < DBL_MAX_EXP) - r = big2dbl(a) / big2dbl(b); - else { - i = i + 1 - DBL_MAX_EXP; - r = big2scaldbl(a, i) / big2scaldbl(b, i); + { + int sgn = (((INUMP(a) ? (INUM(a) < 0):BIGSIGN(a))==0) ^ + (BIGSIGN(b)==0)) ? -1 : 1; + SCM ma = scm_abs(a); + SCM mb = scm_abs(b); + int la = INUM(scm_intlength(ma)); + int lb = INUM(scm_intlength(mb)); + if (la <= DBL_MAX_EXP && lb <= DBL_MAX_EXP) { + r = int2dbl(a) / int2dbl(b); + } + else if (la > DBL_MAX_EXP && lb > DBL_MAX_EXP) { + int k = (la > lb ? la : lb) - DBL_MAX_EXP; + r = sgn * + int2dbl(scm_ash(ma, MAKINUM(-k))) / + int2dbl(scm_ash(mb, MAKINUM(-k))); + } else if (la > lb) { + int k = la - DBL_MAX_EXP; + r = sgn * ldexp(int2dbl(scm_ash(ma, MAKINUM(-k))) / int2dbl(mb), k); + } else { + int k = lb - DBL_MAX_EXP; + r = sgn * ldexp(int2dbl(ma) / int2dbl(scm_ash(mb, MAKINUM(-k))), -k); } } return makdbl(r, 0.0); } -static char s_dfloat_parts[] = "double-float-parts"; SCM scm_dfloat_parts(f) SCM f; { @@ -2629,42 +2934,10 @@ SCM scm_make_dfloat(mant, expt) double dmant = num2dbl(mant, (char *)ARG1, s_make_dfloat); int e = INUM(expt); ASRTER(INUMP(expt), expt, ARG2, s_make_dfloat); - ASRTER((dmant < 0 ? -dmant : dmant)<=max_dbl_int, mant, + ASRTER((dmant < 0 ? -dmant : dmant) <= max_dbl_int, mant, OUTOFRANGE, s_make_dfloat); return makdbl(ldexp(dmant, e), 0.0); } -static char s_next_dfloat[] = "next-double-float"; -SCM scm_next_dfloat(f1, f2) - SCM f1, f2; -{ - int e, neg = 0; - double d1 = num2dbl(f1, (char *)ARG1, s_next_dfloat); - double dif = num2dbl(f2, (char *)ARG2, s_next_dfloat) - d1; - double d = frexp(d1, &e), eps = dbl_eps; - if (d1 < 0) {neg = 1; dif = -dif; d = -d;} - if (dif > 0) { -# ifdef DBL_MIN_EXP - if (e < DBL_MIN_EXP) - eps = ldexp(eps, DBL_MIN_EXP - e); - else if (0.0==d) - eps = ldexp(1.0, DBL_MIN_EXP - dbl_mant_dig); -# endif - d = ldexp(d + eps, e); - } - else if (dif < 0) { -# ifdef DBL_MIN_EXP - if (e < DBL_MIN_EXP) - eps = ldexp(eps, DBL_MIN_EXP - e); - else if (0.0==d) - eps = ldexp(-1.0, DBL_MIN_EXP - dbl_mant_dig); -# endif - if (0.5==d) eps *= 0.5; - d = ldexp(d - eps, e); - } - else if (0.0==dif) - return f1; - return makdbl(neg ? -d : d, 0.0); -} # endif #endif @@ -2812,8 +3085,8 @@ static iproc subr1s[] = { static iproc asubrs[] = { {s_difference, difference}, {s_divide, divide}, - {s_max, lmax}, - {s_min, lmin}, + {s_max, scm_max}, + {s_min, scm_min}, {s_sum, sum}, {s_product, product}, {0, 0}}; @@ -2826,7 +3099,6 @@ static iproc subr2s[] = { {s_expt, expt}, # ifdef BIGDIG {s_make_dfloat, scm_make_dfloat}, - {s_next_dfloat, scm_next_dfloat}, # endif #endif #ifdef INUMS_ONLY @@ -2837,6 +3109,8 @@ static iproc subr2s[] = { {s_assv, assv}, #endif {s_intexpt, scm_intexpt}, + {s_intlog, scm_intlog}, + {s_cintlog, scm_cintlog}, {s_list_tail, list_tail}, {s_ve_fill, vector_fill}, {s_st_fill, string_fill}, @@ -2926,9 +3200,10 @@ void init_scl() IMAG(scm_narn) = 0.0/0.0; ALLOW_INTS; # endif -# ifdef DBL_DIG +# ifndef BIGDIG +# ifdef DBL_DIG dblprec = (DBL_DIG > 20) ? 20 : DBL_DIG; -# else +# else { /* determine floating point precision */ double f = 0.1; volatile double fsum = 1.0+f; @@ -2939,7 +3214,8 @@ void init_scl() } dblprec = dblprec-1; } -# endif /* DBL_DIG */ +# endif /* DBL_DIG */ +# endif /* !BIGDIG */ # ifdef DBL_MANT_DIG dbl_mant_dig = DBL_MANT_DIG; # else @@ -2957,7 +3233,9 @@ void init_scl() # endif /* DBL_MANT_DIG */ max_dbl_int = pow(2.0, dbl_mant_dig - 1.0); max_dbl_int = max_dbl_int + (max_dbl_int - 1.0); - dbl_eps = ldexp(1.0, - dbl_mant_dig); + /* dbl_eps = ldexp(1.0, - dbl_mant_dig); */ sysintern("double-float-mantissa-length", MAKINUM(dbl_mant_dig)); + sysintern("bigdbl:powers-of-5", + pows5 = make_vector(MAKINUM(326), MAKINUM(1))); #endif } diff --git a/scm.1 b/scm.1 old mode 100644 new mode 100755 index 5ab0180..47c1f35 --- a/scm.1 +++ b/scm.1 @@ -1,5 +1,5 @@ .\" dummy line -.TH SCM "April 2006" +.TH SCM 1 "February 2008" .UC 4 .SH NAME scm \- a Scheme Language Interpreter @@ -330,17 +330,17 @@ enhancements, internal representations, and how to extend or include .I scm in other programs. .SH AUTHORS -Aubrey Jaffer (jaffer @ alum.mit.edu) +Aubrey Jaffer (agj@alum.mit.edu) .br -Radey Shouman (shouman @ ne.mediaone.net) +Radey Shouman .SH BUGS .SH SEE ALSO The SCM home-page: .br -http://swissnet.ai.mit.edu/~jaffer/SCM.html +http://people.csail.mit.edu/jaffer/SCM.html .PP The Scheme specifications for details on specific procedures -(http://swissnet.ai.mit.edu/ftpdir/scheme-reports/) or +(http://groups.csail.mit.edu/mac/ftpdir/scheme-reports) or .PP IEEE Std 1178-1990, .br diff --git a/scm.c b/scm.c old mode 100644 new mode 100755 index f226db1..5c0f8e1 --- a/scm.c +++ b/scm.c @@ -166,7 +166,7 @@ void process_signals() /* printf("process_signals; output_deferred=%d\n", output_deferred); fflush(stdout); */ if (output_deferred) { output_deferred = 0; - /* if (NIMP(sys_errp) && OPOUTPORTP(sys_errp)) lfflush(sys_errp); */ + if (NIMP(sys_errp) && OPOUTPORTP(sys_errp)) lfflush(sys_errp); } for (n = 0; SIG_deferred && n < NUM_SIGNALS; n++) { if (SIG_deferred & mask) { @@ -544,6 +544,8 @@ static void init_sig1(scm_err, signo, handler) void init_signals() { #ifdef WINSIGNALS + /* Added to allow gcc -O2 to work. */ + volatile unsigned long dont_optimize_me = (unsigned long)scmable_signal; init_sig1(INT_SIGNAL, SIGINT, win32_sigint); #else # ifdef SIGINT @@ -861,6 +863,7 @@ SCM scm_execpath(newpath) strncpy(execpath, CHARS(newpath), LENGTH(newpath) + 1); return retval; } +/* Return 0 if getcwd() returns 0. */ char *scm_find_execpath(argc, argv, script_arg) int argc; const char * const *argv; @@ -916,12 +919,26 @@ SCM lsystem(cmd) } #endif +extern char **environ; /* The Linux man page says this + declaration is necessary. */ char s_getenv[] = "getenv"; char *getenv(); -SCM lgetenv(nam) +SCM scm_getenv(nam) SCM nam; { char *val; + if (UNBNDP(nam)) { + char **nvrnmnt = environ; + SCM lst = EOL; + do { + char *eql = strchr(*nvrnmnt, '='); + ASRTER(eql, makfrom0str(*nvrnmnt), "Bad environ", s_getenv); + lst = cons(cons(makfromstr(*nvrnmnt, eql - *nvrnmnt), + makfrom0str(eql + 1)), + lst); + } while (*++nvrnmnt); + return lst; + } ASRTER(NIMP(nam) && STRINGP(nam), nam, ARG1, s_getenv); val = getenv(CHARS(nam)); if (!val) return BOOL_F; @@ -968,7 +985,6 @@ static iproc subr0s[] = { #endif {0, 0}}; static iproc subr1s[] = { - {s_getenv, lgetenv}, #ifndef _Windows {s_system, lsystem}, #endif @@ -1002,6 +1018,7 @@ void init_features() init_iprocs(subr0s, tc7_subr_0); init_iprocs(subr1s, tc7_subr_1); make_subr(s_execpath, tc7_subr_1o, scm_execpath); + make_subr(s_getenv, tc7_subr_1o, scm_getenv); #ifdef SIGALRM # ifdef SIGPROF make_subr(s_setitimer, tc7_subr_3, scm_setitimer); diff --git a/scm.doc b/scm.doc old mode 100644 new mode 100755 index 23a90d9..874cadd --- a/scm.doc +++ b/scm.doc @@ -1,4 +1,4 @@ -SCM(April 2006) SCM(April 2006) +SCM(1) SCM(1) @@ -16,7 +16,7 @@ SYNOPSIS DESCRIPTION Scm is a Scheme interpreter. - Upon startup scm loads the file specified by by the environment vari- + Upon startup scm loads the file specified by by the environment vari‐ able SCM_INIT_PATH or by the parameter IMPLINIT in the makefile (or scmfig.h) if SCM_INIT_PATH is not defined. The makefiles attempt to set IMPLINIT to "Init.scm" in the source directory. @@ -48,7 +48,7 @@ OPTIONS -eexpression -cexpression - specifies that the scheme expression expression is to be evalu- + specifies that the scheme expression expression is to be evalu‐ ated. These options are inspired by perl and sh respectively. On Amiga systems the entire option and argument need to be enclosed in quotes. For instance "-e(newline)". @@ -94,13 +94,13 @@ OPTIONS -q (quiet mode) specifies that scm will print no extra information. This is the same as -p0. - -m specifies that subsequent loads, evaluations, and user interac- + -m specifies that subsequent loads, evaluations, and user interac‐ tions will be with R4RS macro capability. To use a specific R4RS - macro implementation from SLIB (instead of SLIB’s default) put -r + macro implementation from SLIB (instead of SLIB's default) put -r macropackage before -m on the command line. - -u specifies that subsequent loads, evaluations, and user interac- - tions will be without R4RS macro capability. R4RS macro capabil- + -u specifies that subsequent loads, evaluations, and user interac‐ + tions will be without R4RS macro capability. R4RS macro capabil‐ ity can be restored by a subsequent -m on the command line or from Scheme code. @@ -112,69 +112,69 @@ OPTIONS subsequent options. If scm is started from a tty, it will assume that it should be interactive unless given a subsequent -b option. - -b specifies that scm should run non-interactively. That means that - scm will terminate after processing the command line or if there + -b specifies that scm should run non-interactively. That means that + scm will terminate after processing the command line or if there are errors. - -s specifies, by analogy with sh, that further options are to be + -s specifies, by analogy with sh, that further options are to be treated as program arguments. - -- specifies that there are no more options on the command line. ENVIRONMENT VARIABLES SCM_INIT_PATH - is the pathname where scm will look for its initialization code. + is the pathname where scm will look for its initialization code. The default is the file "Init.scm" in the source directory. SCHEME_LIBRARY_PATH is the SLIB Scheme library directory. - HOME is the directory where "Init.scm" will look for the user initial- + HOME is the directory where "Init.scm" will look for the user initial‐ ization file "ScmInit.scm". SCHEME VARIABLES *argv* - contains the list of arguments to the program. *argv* can change - during argument processing. This list is suitable for use as an + contains the list of arguments to the program. *argv* can change + during argument processing. This list is suitable for use as an argument to SLIB getopt. *R4RS-macro* - controls whether loading and interaction support R4RS macros. - Define this in "ScmInit.scm" or files specified on the command + controls whether loading and interaction support R4RS macros. + Define this in "ScmInit.scm" or files specified on the command line. This can be overridden by subsequent -m and -u options. *interactive* - controls interactivity as explained for the -i and -b options. - Define this in "ScmInit.scm" or files specified on the command + controls interactivity as explained for the -i and -b options. + Define this in "ScmInit.scm" or files specified on the command line. This can be overridden by subsequent -i and -b options. EXAMPLES % scm foo.scm arg1 arg2 arg3 - Load and execute the contents of foo.scm. Parameters arg1 arg2 + Load and execute the contents of foo.scm. Parameters arg1 arg2 and arg3 are stored in the global list *argv*. % scm -f foo.scm arg1 arg2 arg3 The same. % scm -s foo.scm arg1 arg2 - Set *argv* to ("foo.scm" "arg1" "arg2") and enter interactive ses- + Set *argv* to ("foo.scm" "arg1" "arg2") and enter interactive ses‐ sion. - % scm -e ’(display (list-ref *argv* *optind*))’ bar - Print ‘‘bar’’ + % scm -e '(display (list-ref *argv* *optind*))' bar + Print ``bar'' % scm -rpretty-print -r format -i Load pretty-print and format and enter interactive mode. % scm -r5 - Load dynamic-wind, values, and R4RS macros and enter interactive + Load dynamic-wind, values, and R4RS macros and enter interactive (with macros) mode. % scm -r5 -r4 Like above but rev4-optional-procedures are also loaded. FEATURES - Runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS, + Runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS, Unix and similar systems. Support for ASCII and EBCDIC character sets. Conforms to Revised^5 Report on the Algorithmic Language Scheme and the @@ -182,48 +182,48 @@ FEATURES Support for SICP, R2RS, R3RS, and R4RS scheme code. - Many Common Lisp functions: logand, logor, logxor, lognot, ash, log- - count, integer-length, bit-extract, defmacro, macroexpand, macroex- + Many Common Lisp functions: logand, logor, logxor, lognot, ash, log‐ + count, integer-length, bit-extract, defmacro, macroexpand, macroex‐ pand1, gentemp, defvar, force-output, software-type, get-decoded-time, get-internal-run-time, get-internal-real-time, delete-file, rename- file, copy-tree, acons, and eval. - Char-code-limit, most-positive-fixnum, most-negative-fixnum, and inter- + Char-code-limit, most-positive-fixnum, most-negative-fixnum, and inter‐ nal-time-units-per-second constants. *Features* and *load-pathname* variables. Arrays and bit-vectors. String ports and software emulation ports. I/O extensions providing most of ANSI C and POSIX.1 facilities. - User definable responses to interrupts and errors, Process-synchroniza- + User definable responses to interrupts and errors, Process-synchroniza‐ tion primitives, String regular expression matching, and the CURSES screen management package. Available add-on packages including an interactive debugger, database, X-window graphics, BGI graphics, Motif, and Open-Windows packages. - A compiler (HOBBIT, available separately) and dynamic linking of com- + A compiler (HOBBIT, available separately) and dynamic linking of com‐ piled modules. - Setable levels of monitoring and timing information printed interac- - tively (the ‘verbose’ function). Restart, quit, and exec. + Setable levels of monitoring and timing information printed interac‐ + tively (the `verbose' function). Restart, quit, and exec. FILES scm.texi - Texinfo documentation of scm enhancements, internal representa- + Texinfo documentation of scm enhancements, internal representa‐ tions, and how to extend or include scm in other programs. AUTHORS - Aubrey Jaffer (jaffer @ alum.mit.edu) - Radey Shouman (shouman @ ne.mediaone.net) + Aubrey Jaffer (agj@alum.mit.edu) + Radey Shouman BUGS SEE ALSO The SCM home-page: - http://swissnet.ai.mit.edu/~jaffer/SCM.html + http://people.csail.mit.edu/jaffer/SCM.html The Scheme specifications for details on specific procedures - (http://swissnet.ai.mit.edu/ftpdir/scheme-reports/) or + (http://groups.csail.mit.edu/mac/ftpdir/scheme-reports) or IEEE Std 1178-1990, IEEE Standard for the Scheme Programming Language, @@ -243,4 +243,4 @@ SEE ALSO -4th Berkeley Distribution SCM(April 2006) +4th Berkeley Distribution February 2008 SCM(1) diff --git a/scm.h b/scm.h old mode 100644 new mode 100755 index 763f2b2..e759d7d --- a/scm.h +++ b/scm.h @@ -100,8 +100,6 @@ typedef struct { int (*print)P((SCM exp, SCM port, int writing)); SCM (*equalp)P((SCM, SCM)); int (*fputc)P((int c, FILE *p)); -/* int (*fputs)P((char *s, FILE *p)); */ -/* sizet (*fwrite)P((char *s, sizet siz, sizet num, FILE *p)); */ int (*fputs)P((const char *s, FILE *p)); sizet (*fwrite)P((const void *s, sizet siz, sizet num, FILE *p)); int (*fflush)P((FILE *stream)); @@ -339,14 +337,14 @@ SCM_EXPORT long tc16_env, tc16_ident; /* markers for various static environment frame types */ /* FIXME these need to be exported somehow to Scheme */ #ifdef CAUTIOUS -# define SCM_ENV_FILENAME MAKINUM(1) -# define SCM_ENV_PROCNAME MAKINUM(2) +# define SCM_ENV_FILENAME MAKINUM(1L) +# define SCM_ENV_PROCNAME MAKINUM(2L) #endif -#define SCM_ENV_DOC MAKINUM(3) -#define SCM_ENV_ANNOTATION MAKINUM(4) -#define SCM_ENV_CONSTANT MAKINUM(5) -#define SCM_ENV_SYNTAX MAKINUM(6) -#define SCM_ENV_END MAKINUM(7) +#define SCM_ENV_DOC MAKINUM(3L) +#define SCM_ENV_ANNOTATION MAKINUM(4L) +#define SCM_ENV_CONSTANT MAKINUM(5L) +#define SCM_ENV_SYNTAX MAKINUM(6L) +#define SCM_ENV_END MAKINUM(7L) #define PORTP(x) (TYP7(x)==tc7_port) #define OPPORTP(x) (((0x7f | OPN) & CAR(x))==(tc7_port | OPN)) @@ -497,9 +495,11 @@ SCM_EXPORT long tc16_array; case tc7_subr_2o:case tc7_lsubr_2:case tc7_lsubr #define tcs_symbols tc7_ssymbol:case tc7_msymbol #define tcs_bignums tc16_bigpos:case tc16_bigneg -#define tcs_uves tc7_string:case tc7_Vbool:case tc7_VfixN8:case tc7_VfixZ8:\ - case tc7_VfixN16:case tc7_VfixZ16:case tc7_VfixN32:case tc7_VfixZ32:\ - case tc7_VfloR32:case tc7_VfloC32:case tc7_VfloR64:case tc7_VfloC64 +#define tcs_uves tc7_string:\ + case tc7_VfixN8:case tc7_VfixZ8:case tc7_VfixN16:case tc7_VfixZ16:\ + case tc7_VfixN32:case tc7_VfixZ32:case tc7_VfixN64:case tc7_VfixZ64:\ + case tc7_VfloR32:case tc7_VfloC32:case tc7_VfloR64:case tc7_VfloC64:\ + case tc7_Vbool #define tc3_cons_nimcar 0 #define tc3_cons_imcar 2:case 4:case 6 @@ -511,23 +511,20 @@ SCM_EXPORT long tc16_array; #define tc7_msymbol 7 #define tc7_string 13 #define tc7_vector 15 -#define tc7_Vbool 21 - -/* 23 */ - -#define tc7_VfixN8 29 -#define tc7_VfixZ8 31 -#define tc7_VfixN16 37 -#define tc7_VfixZ16 39 -#define tc7_VfixN32 45 -#define tc7_VfixZ32 47 +#define tc7_VfixN8 21 +#define tc7_VfixZ8 23 +#define tc7_VfixN16 29 +#define tc7_VfixZ16 31 +#define tc7_VfixN32 37 +#define tc7_VfixZ32 39 +#define tc7_VfixN64 45 +#define tc7_VfixZ64 47 #define tc7_VfloR32 53 #define tc7_VfloC32 55 #define tc7_VfloR64 61 #define tc7_VfloC64 63 - -/* 69 */ +#define tc7_Vbool 69 #define tc7_port 71 #define tc7_contin 77 @@ -625,7 +622,8 @@ SCM_EXPORT SCM sys_protects[]; #define flo0 sys_protects[20] #define scm_uprotects sys_protects[21] #define scm_narn sys_protects[22] -#define NUM_PROTECTS 23 +#define pows5 sys_protects[23] +#define NUM_PROTECTS 24 /* now for connects between source files */ @@ -639,6 +637,7 @@ SCM_EXPORT scm_gra finals_gra; SCM_EXPORT unsigned char upcase[], downcase[]; SCM_EXPORT SCM symhash; SCM_EXPORT int symhash_dim; +SCM_EXPORT int no_symhash_gc; /* Set when linking code produced by Hobbit compiler. */ SCM_EXPORT long heap_cells; SCM_EXPORT CELLPTR heap_org; SCM_EXPORT VOLATILE SCM freelist; @@ -844,6 +843,7 @@ SCM_EXPORT SCM numberp P((SCM x)); SCM_EXPORT SCM exactp P((SCM x)); SCM_EXPORT SCM inexactp P((SCM x)); SCM_EXPORT SCM eqp P((SCM x, SCM y)); +SCM_EXPORT SCM eqv P((SCM x, SCM y)); SCM_EXPORT SCM lessp P((SCM x, SCM y)); SCM_EXPORT SCM greaterp P((SCM x, SCM y)); SCM_EXPORT SCM leqp P((SCM x, SCM y)); @@ -853,12 +853,13 @@ SCM_EXPORT SCM positivep P((SCM x)); SCM_EXPORT SCM negativep P((SCM x)); SCM_EXPORT SCM oddp P((SCM n)); SCM_EXPORT SCM evenp P((SCM n)); -SCM_EXPORT SCM lmax P((SCM x, SCM y)); -SCM_EXPORT SCM lmin P((SCM x, SCM y)); +SCM_EXPORT SCM scm_max P((SCM x, SCM y)); +SCM_EXPORT SCM scm_min P((SCM x, SCM y)); SCM_EXPORT SCM sum P((SCM x, SCM y)); SCM_EXPORT SCM difference P((SCM x, SCM y)); SCM_EXPORT SCM product P((SCM x, SCM y)); SCM_EXPORT SCM divide P((SCM x, SCM y)); +SCM_EXPORT SCM scm_round_quotient P((SCM x, SCM y)); SCM_EXPORT SCM lquotient P((SCM x, SCM y)); SCM_EXPORT SCM scm_iabs P((SCM x)); SCM_EXPORT SCM scm_abs P((SCM x)); @@ -871,13 +872,15 @@ SCM_EXPORT SCM istring2number P((char *str, long len, long radix)); SCM_EXPORT SCM string2number P((SCM str, SCM radix)); SCM_EXPORT SCM istr2flo P((char *str, long len, long radix)); SCM_EXPORT SCM mkbig P((sizet nlen, int sign)); +SCM_EXPORT void bigrecy P((SCM bgnm)); SCM_EXPORT SCM mkstrport P((SCM pos, SCM str, long modes, char *caller)); SCM_EXPORT SCM mksafeport P((int maxlen, SCM port)); SCM_EXPORT int reset_safeport P((SCM sfp, int maxlen, SCM port)); SCM_EXPORT SCM long2big P((long n)); SCM_EXPORT SCM ulong2big P((unsigned long n)); SCM_EXPORT SCM big2inum P((SCM b, sizet l)); -SCM_EXPORT sizet iint2str P((long num, int rad, char *p)); +SCM_EXPORT sizet ilong2str P((long num, int rad, char *p)); +SCM_EXPORT sizet iulong2str P((unsigned long num, int rad, char *p)); SCM_EXPORT SCM floequal P((SCM x, SCM y)); SCM_EXPORT SCM uve_equal P((SCM u, SCM v)); SCM_EXPORT SCM uve_read P((SCM v, SCM port)); @@ -893,7 +896,7 @@ SCM_EXPORT SCM array_rank P((SCM ra)); SCM_EXPORT SCM array_contents P((SCM ra, SCM strict)); SCM_EXPORT int bigprint P((SCM exp, SCM port, int writing)); SCM_EXPORT int floprint P((SCM sexp, SCM port, int writing)); -SCM_EXPORT SCM istr2int P((char *str, long len, long radix)); +SCM_EXPORT SCM istr2int P((char *str, long len, int radix)); SCM_EXPORT SCM istr2bve P((char *str, long len)); SCM_EXPORT void scm_ipruk P((char *hdr, SCM ptr, SCM port)); SCM_EXPORT SCM charp P((SCM x)); @@ -973,7 +976,7 @@ SCM_EXPORT SCM scm_port_line P((SCM port)); SCM_EXPORT SCM scm_port_col P((SCM port)); SCM_EXPORT void scm_line_msg P((SCM file, SCM linum, SCM port)); SCM_EXPORT void scm_err_line P((const char *what, SCM file, SCM linum, SCM port)); -SCM_EXPORT SCM lgetenv P((SCM nam)); +SCM_EXPORT SCM scm_getenv P((SCM nam)); SCM_EXPORT SCM prog_args P((void)); SCM_EXPORT SCM makacro P((SCM code)); SCM_EXPORT SCM makmacro P((SCM code)); @@ -1010,6 +1013,8 @@ SCM_EXPORT SCM scm_logand P((SCM x, SCM y)); SCM_EXPORT SCM scm_logior P((SCM x, SCM y)); SCM_EXPORT SCM scm_lognot P((SCM n)); SCM_EXPORT SCM scm_intexpt P((SCM z1, SCM z2)); +SCM_EXPORT SCM scm_intlog P((SCM base, SCM k)); +SCM_EXPORT SCM scm_cintlog P((SCM base, SCM k)); SCM_EXPORT SCM scm_ash P((SCM n, SCM cnt)); SCM_EXPORT SCM scm_bitfield P((SCM n, SCM start, SCM end)); SCM_EXPORT SCM scm_logcount P((SCM n)); @@ -1037,14 +1042,14 @@ SCM_EXPORT SCM scm_evstr P((char *str)); SCM_EXPORT void scm_ldstr P((char *str)); SCM_EXPORT int scm_ldfile P((char *path)); SCM_EXPORT int scm_ldprog P((char *path)); -SCM_EXPORT unsigned long scm_addr P((SCM args, const char *name)); -SCM_EXPORT unsigned long scm_base_addr P((SCM v, const char *name)); +SCM_EXPORT void* scm_addr P((SCM args, const char *name)); +SCM_EXPORT void* scm_base_addr P((SCM v, const char *name)); SCM_EXPORT int scm_cell_p P((SCM x)); #ifdef FLOATS SCM_EXPORT SCM makdbl P((double x, double y)); SCM_EXPORT SCM dbl2big P((double d)); -SCM_EXPORT double big2dbl P((SCM b)); +SCM_EXPORT double int2dbl P((SCM b)); SCM_EXPORT double scm_truncate P((double x)); SCM_EXPORT double scm_round P((double x)); SCM_EXPORT double floident P((double x)); @@ -1057,10 +1062,10 @@ SCM_EXPORT SCM normbig P((SCM b)); SCM_EXPORT SCM copybig P((SCM b, int sign)); SCM_EXPORT SCM addbig P((BIGDIG *x, sizet nx, int xsgn, SCM bigy, int sgny)); SCM_EXPORT SCM mulbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn)); -SCM_EXPORT unsigned int divbigdig P((BIGDIG *ds, sizet h, BIGDIG div)); +SCM_EXPORT UBIGLONG divbigdig P((BIGDIG *ds, sizet h, BIGDIG div)); SCM_EXPORT SCM divbigint P((SCM x, long z, int sgn, int mode)); SCM_EXPORT SCM divbigbig P((BIGDIG *x, sizet nx, BIGDIG *y, sizet ny, int sgn, - int modes)); + int mode)); SCM_EXPORT long pseudolong P((long x)); #endif SCM_EXPORT int bigcomp P((SCM x, SCM y)); @@ -1107,27 +1112,27 @@ SCM_EXPORT SCM scm_trace, scm_trace_env; # define ASRTGO(_cond, _label) if (SCM_EXPECT_FALSE(!(_cond))) goto _label; #endif -#define ARGn 1 -#define ARG1 2 -#define ARG2 3 -#define ARG3 4 -#define ARG4 5 -#define ARG5 6 +#define ARGn 1L +#define ARG1 2L +#define ARG2 3L +#define ARG3 4L +#define ARG4 5L +#define ARG5 6L /* following must match entry indexes in errmsgs[] */ -#define WNA 7 -#define OVFLOW 8 -#define OUTOFRANGE 9 -#define NALLOC 10 -#define THRASH 11 -#define EXIT 12 -#define HUP_SIGNAL 13 -#define INT_SIGNAL 14 -#define FPE_SIGNAL 15 -#define BUS_SIGNAL 16 -#define SEGV_SIGNAL 17 -#define ALRM_SIGNAL 18 -#define VTALRM_SIGNAL 19 -#define PROF_SIGNAL 20 +#define WNA 7L +#define OVFLOW 8L +#define OUTOFRANGE 9L +#define NALLOC 10L +#define THRASH 11L +#define EXIT 12L +#define HUP_SIGNAL 13L +#define INT_SIGNAL 14L +#define FPE_SIGNAL 15L +#define BUS_SIGNAL 16L +#define SEGV_SIGNAL 17L +#define ALRM_SIGNAL 18L +#define VTALRM_SIGNAL 19L +#define PROF_SIGNAL 20L #define EVAL(x, env, venv) (IMP(x)?(x):ceval((x), (SCM)(env), (SCM)(venv))) #define SIDEVAL(x, env, venv) if (NIMP(x)) ceval((x), (SCM)(env), (SCM)(venv)) diff --git a/scm.info b/scm.info old mode 100644 new mode 100755 index f1a693a..ac9f9dd --- a/scm.info +++ b/scm.info @@ -1,16 +1,16 @@ -This is scm.info, produced by makeinfo version 4.8 from scm.texi. +This is scm-5f2.info, produced by makeinfo version 4.13 from scm.texi. | -This manual is for SCM (version 5e5, February 2008), and algorithmic | -language Scheme implementation. +This manual is for SCM (version 5f1, May 2013), an implementation of | +the algorithmic language Scheme. Copyright (C) 1990-2007 Free Software Foundation, Inc. - Permission is granted to copy, distribute and/or modify this | - document under the terms of the GNU Free Documentation License, | - Version 1.2 or any later version published by the Free Software | - Foundation; with no Invariant Sections, no Front-Cover Texts, and | - no Back-Cover Texts. A copy of the license is included in the | - section entitled "GNU Free Documentation License." | + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, no Front-Cover Texts, and + no Back-Cover Texts. A copy of the license is included in the + section entitled "GNU Free Documentation License." INFO-DIR-SECTION The Algorithmic Language Scheme START-INFO-DIR-ENTRY @@ -18,22 +18,22 @@ START-INFO-DIR-ENTRY END-INFO-DIR-ENTRY  -File: scm.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir) - +File: scm-5f2.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir) + | SCM *** -This manual is for SCM (version 5e5, February 2008), and algorithmic | -language Scheme implementation. +This manual is for SCM (version 5f1, May 2013), an implementation of | +the algorithmic language Scheme. Copyright (C) 1990-2007 Free Software Foundation, Inc. - Permission is granted to copy, distribute and/or modify this | - document under the terms of the GNU Free Documentation License, | - Version 1.2 or any later version published by the Free Software | - Foundation; with no Invariant Sections, no Front-Cover Texts, and | - no Back-Cover Texts. A copy of the license is included in the | - section entitled "GNU Free Documentation License." | + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, no Front-Cover Texts, and + no Back-Cover Texts. A copy of the license is included in the + section entitled "GNU Free Documentation License." * Menu: @@ -46,15 +46,15 @@ Copyright (C) 1990-2007 Free Software Foundation, Inc. * Index::  -File: scm.info, Node: Overview, Next: Installing SCM, Prev: Top, Up: Top - +File: scm-5f2.info, Node: Overview, Next: Installing SCM, Prev: Top, Up: Top + | 1 Overview ********** -SCM is a portable Scheme implementation written in C. SCM provides a | +SCM is a portable Scheme implementation written in C. SCM provides a machine independent platform for [JACAL], a symbolic algebra system. -SCM supports and requires the SLIB Scheme library. SCM, SLIB, and | -JACAL are GNU projects. | +SCM supports and requires the SLIB Scheme library. SCM, SLIB, and +JACAL are GNU projects. * Menu: @@ -64,8 +64,8 @@ JACAL are GNU projects. | * Bibliography::  -File: scm.info, Node: SCM Features, Next: SCM Authors, Prev: Overview, Up: Overview - +File: scm-5f2.info, Node: SCM Features, Next: SCM Authors, Prev: Overview, Up: Overview + | 1.1 Features ============ @@ -105,7 +105,7 @@ File: scm.info, Node: SCM Features, Next: SCM Authors, Prev: Overview, Up: O database, X-window graphics, BGI graphics, Motif, and Open-Windows packages. - * The Hobbit compiler and dynamic linking of compiled modules. | + * The Hobbit compiler and dynamic linking of compiled modules. * User definable responses to interrupts and errors, Process-syncronization primitives. Setable levels of monitoring @@ -113,12 +113,12 @@ File: scm.info, Node: SCM Features, Next: SCM Authors, Prev: Overview, Up: O function). `Restart', `quit', and `exec'.  -File: scm.info, Node: SCM Authors, Next: Copying, Prev: SCM Features, Up: Overview - +File: scm-5f2.info, Node: SCM Authors, Next: Copying, Prev: SCM Features, Up: Overview + | 1.2 Authors =========== -Aubrey Jaffer (agj @ alum.mit.edu) +Aubrey Jaffer (agj@alum.mit.edu) Most of SCM. Radey Shouman @@ -142,8 +142,8 @@ There are many other contributors to SCM. They are acknowledged in the file `ChangeLog', a log of changes that have been made to scm.  -File: scm.info, Node: Copying, Next: Bibliography, Prev: SCM Authors, Up: Overview - +File: scm-5f2.info, Node: Copying, Next: Bibliography, Prev: SCM Authors, Up: Overview + | 1.3 Copyright ============= @@ -159,27 +159,27 @@ Authors have assigned their SCM copyrights to: * GNU Free Documentation License:: Copying this Manual  -File: scm.info, Node: The SCM License, Next: SIOD copyright, Prev: Copying, Up: Copying - +File: scm-5f2.info, Node: The SCM License, Next: SIOD copyright, Prev: Copying, Up: Copying + | 1.3.1 The SCM License --------------------- -This program is free software: you can redistribute it and/or modify it | -under the terms of the GNU Lesser General Public License as published | -by the Free Software Foundation, either version 3 of the License, or | +This program is free software: you can redistribute it and/or modify it +under the terms of the GNU Lesser General Public License as published +by the Free Software Foundation, either version 3 of the License, 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 -Lesser General Public License for more details. | +Lesser General Public License for more details. -You should have received a copy of the GNU Lesser General Public | -License along with this program. If not, see | -`http://www.gnu.org/licenses/'. | +You should have received a copy of the GNU Lesser General Public +License along with this program. If not, see +`http://www.gnu.org/licenses/'.  -File: scm.info, Node: SIOD copyright, Next: GNU Free Documentation License, Prev: The SCM License, Up: Copying +File: scm-5f2.info, Node: SIOD copyright, Next: GNU Free Documentation License, Prev: The SCM License, Up: Copying | 1.3.2 SIOD copyright -------------------- @@ -213,439 +213,493 @@ Paradigm Associates Inc Cambridge, MA 02138  -File: scm.info, Node: GNU Free Documentation License, Prev: SIOD copyright, Up: Copying - | -1.3.3 GNU Free Documentation License | ------------------------------------- | - | - Version 1.2, November 2002 | - | - Copyright (C) 2000,2001,2002 Free Software Foundation, Inc. | - 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA | - | - Everyone is permitted to copy and distribute verbatim copies | - of this license document, but changing it is not allowed. | - | - 0. PREAMBLE | - | - The purpose of this License is to make a manual, textbook, or other | - functional and useful document "free" in the sense of freedom: to | - assure everyone the effective freedom to copy and redistribute it, | - with or without modifying it, either commercially or | - noncommercially. Secondarily, this License preserves for the | - author and publisher a way to get credit for their work, while not | - being considered responsible for modifications made by others. | - | - This License is a kind of "copyleft", which means that derivative | - works of the document must themselves be free in the same sense. | - It complements the GNU General Public License, which is a copyleft | - license designed for free software. | - | - We have designed this License in order to use it for manuals for | - free software, because free software needs free documentation: a | - free program should come with manuals providing the same freedoms | - that the software does. But this License is not limited to | - software manuals; it can be used for any textual work, regardless | - of subject matter or whether it is published as a printed book. | - We recommend this License principally for works whose purpose is | - instruction or reference. | - | - 1. APPLICABILITY AND DEFINITIONS | - | - This License applies to any manual or other work, in any medium, | - that contains a notice placed by the copyright holder saying it | - can be distributed under the terms of this License. Such a notice | - grants a world-wide, royalty-free license, unlimited in duration, | - to use that work under the conditions stated herein. The | - "Document", below, refers to any such manual or work. Any member | - of the public is a licensee, and is addressed as "you". You | - accept the license if you copy, modify or distribute the work in a | - way requiring permission under copyright law. | - | - A "Modified Version" of the Document means any work containing the | - Document or a portion of it, either copied verbatim, or with | - modifications and/or translated into another language. | - | - A "Secondary Section" is a named appendix or a front-matter section | - of the Document that deals exclusively with the relationship of the | - publishers or authors of the Document to the Document's overall | - subject (or to related matters) and contains nothing that could | - fall directly within that overall subject. (Thus, if the Document | - is in part a textbook of mathematics, a Secondary Section may not | - explain any mathematics.) The relationship could be a matter of | - historical connection with the subject or with related matters, or | - of legal, commercial, philosophical, ethical or political position | - regarding them. | - | - The "Invariant Sections" are certain Secondary Sections whose | - titles are designated, as being those of Invariant Sections, in | - the notice that says that the Document is released under this | - License. If a section does not fit the above definition of | - Secondary then it is not allowed to be designated as Invariant. | - The Document may contain zero Invariant Sections. If the Document | - does not identify any Invariant Sections then there are none. | - | - The "Cover Texts" are certain short passages of text that are | - listed, as Front-Cover Texts or Back-Cover Texts, in the notice | - that says that the Document is released under this License. A | - Front-Cover Text may be at most 5 words, and a Back-Cover Text may | - be at most 25 words. | - | - A "Transparent" copy of the Document means a machine-readable copy, | - represented in a format whose specification is available to the | - general public, that is suitable for revising the document | - straightforwardly with generic text editors or (for images | - composed of pixels) generic paint programs or (for drawings) some | - widely available drawing editor, and that is suitable for input to | - text formatters or for automatic translation to a variety of | - formats suitable for input to text formatters. A copy made in an | - otherwise Transparent file format whose markup, or absence of | - markup, has been arranged to thwart or discourage subsequent | - modification by readers is not Transparent. An image format is | - not Transparent if used for any substantial amount of text. A | - copy that is not "Transparent" is called "Opaque". | - | - Examples of suitable formats for Transparent copies include plain | - ASCII without markup, Texinfo input format, LaTeX input format, | - SGML or XML using a publicly available DTD, and | - standard-conforming simple HTML, PostScript or PDF designed for | - human modification. Examples of transparent image formats include | - PNG, XCF and JPG. Opaque formats include proprietary formats that | - can be read and edited only by proprietary word processors, SGML or | - XML for which the DTD and/or processing tools are not generally | - available, and the machine-generated HTML, PostScript or PDF | - produced by some word processors for output purposes only. | - | - The "Title Page" means, for a printed book, the title page itself, | - plus such following pages as are needed to hold, legibly, the | - material this License requires to appear in the title page. For | - works in formats which do not have any title page as such, "Title | - Page" means the text near the most prominent appearance of the | - work's title, preceding the beginning of the body of the text. | - | - A section "Entitled XYZ" means a named subunit of the Document | - whose title either is precisely XYZ or contains XYZ in parentheses | - following text that translates XYZ in another language. (Here XYZ | - stands for a specific section name mentioned below, such as | - "Acknowledgements", "Dedications", "Endorsements", or "History".) | - To "Preserve the Title" of such a section when you modify the | - Document means that it remains a section "Entitled XYZ" according | - to this definition. | - | - The Document may include Warranty Disclaimers next to the notice | - which states that this License applies to the Document. These | - Warranty Disclaimers are considered to be included by reference in | - this License, but only as regards disclaiming warranties: any other | - implication that these Warranty Disclaimers may have is void and | - has no effect on the meaning of this License. | - | - 2. VERBATIM COPYING | - | - You may copy and distribute the Document in any medium, either | - commercially or noncommercially, provided that this License, the | - copyright notices, and the license notice saying this License | - applies to the Document are reproduced in all copies, and that you | - add no other conditions whatsoever to those of this License. You | - may not use technical measures to obstruct or control the reading | - or further copying of the copies you make or distribute. However, | - you may accept compensation in exchange for copies. If you | - distribute a large enough number of copies you must also follow | - the conditions in section 3. | - | - You may also lend copies, under the same conditions stated above, | - and you may publicly display copies. | - | - 3. COPYING IN QUANTITY | - | - If you publish printed copies (or copies in media that commonly | - have printed covers) of the Document, numbering more than 100, and | - the Document's license notice requires Cover Texts, you must | - enclose the copies in covers that carry, clearly and legibly, all | - these Cover Texts: Front-Cover Texts on the front cover, and | - Back-Cover Texts on the back cover. Both covers must also clearly | - and legibly identify you as the publisher of these copies. The | - front cover must present the full title with all words of the | - title equally prominent and visible. You may add other material | - on the covers in addition. Copying with changes limited to the | - covers, as long as they preserve the title of the Document and | - satisfy these conditions, can be treated as verbatim copying in | - other respects. | - | - If the required texts for either cover are too voluminous to fit | - legibly, you should put the first ones listed (as many as fit | - reasonably) on the actual cover, and continue the rest onto | - adjacent pages. | - | - If you publish or distribute Opaque copies of the Document | - numbering more than 100, you must either include a | - machine-readable Transparent copy along with each Opaque copy, or | - state in or with each Opaque copy a computer-network location from | - which the general network-using public has access to download | - using public-standard network protocols a complete Transparent | - copy of the Document, free of added material. If you use the | - latter option, you must take reasonably prudent steps, when you | - begin distribution of Opaque copies in quantity, to ensure that | - this Transparent copy will remain thus accessible at the stated | - location until at least one year after the last time you | - distribute an Opaque copy (directly or through your agents or | - retailers) of that edition to the public. | - | - It is requested, but not required, that you contact the authors of | - the Document well before redistributing any large number of | - copies, to give them a chance to provide you with an updated | - version of the Document. | - | - 4. MODIFICATIONS | - | - You may copy and distribute a Modified Version of the Document | - under the conditions of sections 2 and 3 above, provided that you | - release the Modified Version under precisely this License, with | - the Modified Version filling the role of the Document, thus | - licensing distribution and modification of the Modified Version to | - whoever possesses a copy of it. In addition, you must do these | - things in the Modified Version: | - | - A. Use in the Title Page (and on the covers, if any) a title | - distinct from that of the Document, and from those of | - previous versions (which should, if there were any, be listed | - in the History section of the Document). You may use the | - same title as a previous version if the original publisher of | - that version gives permission. | - | - B. List on the Title Page, as authors, one or more persons or | - entities responsible for authorship of the modifications in | - the Modified Version, together with at least five of the | - principal authors of the Document (all of its principal | - authors, if it has fewer than five), unless they release you | - from this requirement. | - | - C. State on the Title page the name of the publisher of the | - Modified Version, as the publisher. | - | - D. Preserve all the copyright notices of the Document. | - | - E. Add an appropriate copyright notice for your modifications | - adjacent to the other copyright notices. | - | - F. Include, immediately after the copyright notices, a license | - notice giving the public permission to use the Modified | - Version under the terms of this License, in the form shown in | - the Addendum below. | - | - G. Preserve in that license notice the full lists of Invariant | - Sections and required Cover Texts given in the Document's | - license notice. | - | - H. Include an unaltered copy of this License. | - | - I. Preserve the section Entitled "History", Preserve its Title, | - and add to it an item stating at least the title, year, new | - authors, and publisher of the Modified Version as given on | - the Title Page. If there is no section Entitled "History" in | - the Document, create one stating the title, year, authors, | - and publisher of the Document as given on its Title Page, | - then add an item describing the Modified Version as stated in | - the previous sentence. | - | - J. Preserve the network location, if any, given in the Document | - for public access to a Transparent copy of the Document, and | - likewise the network locations given in the Document for | - previous versions it was based on. These may be placed in | - the "History" section. You may omit a network location for a | - work that was published at least four years before the | - Document itself, or if the original publisher of the version | - it refers to gives permission. | - | - K. For any section Entitled "Acknowledgements" or "Dedications", | - Preserve the Title of the section, and preserve in the | - section all the substance and tone of each of the contributor | - acknowledgements and/or dedications given therein. | - | - L. Preserve all the Invariant Sections of the Document, | - unaltered in their text and in their titles. Section numbers | - or the equivalent are not considered part of the section | - titles. | - | - M. Delete any section Entitled "Endorsements". Such a section | - may not be included in the Modified Version. | - | - N. Do not retitle any existing section to be Entitled | - "Endorsements" or to conflict in title with any Invariant | - Section. | - | - O. Preserve any Warranty Disclaimers. | - | - If the Modified Version includes new front-matter sections or | - appendices that qualify as Secondary Sections and contain no | - material copied from the Document, you may at your option | - designate some or all of these sections as invariant. To do this, | - add their titles to the list of Invariant Sections in the Modified | - Version's license notice. These titles must be distinct from any | - other section titles. | - | - You may add a section Entitled "Endorsements", provided it contains | - nothing but endorsements of your Modified Version by various | - parties--for example, statements of peer review or that the text | - has been approved by an organization as the authoritative | - definition of a standard. | - | - You may add a passage of up to five words as a Front-Cover Text, | - and a passage of up to 25 words as a Back-Cover Text, to the end | - of the list of Cover Texts in the Modified Version. Only one | - passage of Front-Cover Text and one of Back-Cover Text may be | - added by (or through arrangements made by) any one entity. If the | - Document already includes a cover text for the same cover, | - previously added by you or by arrangement made by the same entity | - you are acting on behalf of, you may not add another; but you may | - replace the old one, on explicit permission from the previous | - publisher that added the old one. | - | - The author(s) and publisher(s) of the Document do not by this | - License give permission to use their names for publicity for or to | - assert or imply endorsement of any Modified Version. | - | - 5. COMBINING DOCUMENTS | - | - You may combine the Document with other documents released under | - this License, under the terms defined in section 4 above for | - modified versions, provided that you include in the combination | - all of the Invariant Sections of all of the original documents, | - unmodified, and list them all as Invariant Sections of your | - combined work in its license notice, and that you preserve all | - their Warranty Disclaimers. | - | - The combined work need only contain one copy of this License, and | - multiple identical Invariant Sections may be replaced with a single | - copy. If there are multiple Invariant Sections with the same name | - but different contents, make the title of each such section unique | - by adding at the end of it, in parentheses, the name of the | - original author or publisher of that section if known, or else a | - unique number. Make the same adjustment to the section titles in | - the list of Invariant Sections in the license notice of the | - combined work. | - | - In the combination, you must combine any sections Entitled | - "History" in the various original documents, forming one section | - Entitled "History"; likewise combine any sections Entitled | - "Acknowledgements", and any sections Entitled "Dedications". You | - must delete all sections Entitled "Endorsements." | - | - 6. COLLECTIONS OF DOCUMENTS | - | - You may make a collection consisting of the Document and other | - documents released under this License, and replace the individual | - copies of this License in the various documents with a single copy | - that is included in the collection, provided that you follow the | - rules of this License for verbatim copying of each of the | - documents in all other respects. | - | - You may extract a single document from such a collection, and | - distribute it individually under this License, provided you insert | - a copy of this License into the extracted document, and follow | - this License in all other respects regarding verbatim copying of | - that document. | - | - 7. AGGREGATION WITH INDEPENDENT WORKS | - | - A compilation of the Document or its derivatives with other | - separate and independent documents or works, in or on a volume of | - a storage or distribution medium, is called an "aggregate" if the | - copyright resulting from the compilation is not used to limit the | - legal rights of the compilation's users beyond what the individual | - works permit. When the Document is included in an aggregate, this | - License does not apply to the other works in the aggregate which | - are not themselves derivative works of the Document. | - | - If the Cover Text requirement of section 3 is applicable to these | - copies of the Document, then if the Document is less than one half | - of the entire aggregate, the Document's Cover Texts may be placed | - on covers that bracket the Document within the aggregate, or the | - electronic equivalent of covers if the Document is in electronic | - form. Otherwise they must appear on printed covers that bracket | - the whole aggregate. | - | - 8. TRANSLATION | - | - Translation is considered a kind of modification, so you may | - distribute translations of the Document under the terms of section | - 4. Replacing Invariant Sections with translations requires special | - permission from their copyright holders, but you may include | - translations of some or all Invariant Sections in addition to the | - original versions of these Invariant Sections. You may include a | - translation of this License, and all the license notices in the | - Document, and any Warranty Disclaimers, provided that you also | - include the original English version of this License and the | - original versions of those notices and disclaimers. In case of a | - disagreement between the translation and the original version of | - this License or a notice or disclaimer, the original version will | - prevail. | - | - If a section in the Document is Entitled "Acknowledgements", | - "Dedications", or "History", the requirement (section 4) to | - Preserve its Title (section 1) will typically require changing the | - actual title. | - | - 9. TERMINATION | - | - You may not copy, modify, sublicense, or distribute the Document | - except as expressly provided for under this License. Any other | - attempt to copy, modify, sublicense or distribute the Document is | - void, and will automatically terminate your rights under this | - License. However, parties who have received copies, or rights, | - from you under this License will not have their licenses | - terminated so long as such parties remain in full compliance. | - | - 10. FUTURE REVISIONS OF THIS LICENSE | - | - The Free Software Foundation may publish new, revised versions of | - the GNU Free Documentation License from time to time. Such new | - versions will be similar in spirit to the present version, but may | - differ in detail to address new problems or concerns. See | - `http://www.gnu.org/copyleft/'. | - | - Each version of the License is given a distinguishing version | - number. If the Document specifies that a particular numbered | - version of this License "or any later version" applies to it, you | - have the option of following the terms and conditions either of | - that specified version or of any later version that has been | - published (not as a draft) by the Free Software Foundation. If | - the Document does not specify a version number of this License, | - you may choose any version ever published (not as a draft) by the | - Free Software Foundation. | - | -ADDENDUM: How to use this License for your documents | -==================================================== | - | -To use this License in a document you have written, include a copy of | -the License in the document and put the following copyright and license | -notices just after the title page: | - | - Copyright (C) YEAR YOUR NAME. | - Permission is granted to copy, distribute and/or modify this document | - under the terms of the GNU Free Documentation License, Version 1.2 | - or any later version published by the Free Software Foundation; | - with no Invariant Sections, no Front-Cover Texts, and no Back-Cover | - Texts. A copy of the license is included in the section entitled ``GNU - Free Documentation License''. | - | -If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, | -replace the "with...Texts." line with this: | - | - with the Invariant Sections being LIST THEIR TITLES, with | - the Front-Cover Texts being LIST, and with the Back-Cover Texts | - being LIST. | - | -If you have Invariant Sections without Cover Texts, or some other | -combination of the three, merge those two alternatives to suit the | -situation. | - | -If your document contains nontrivial examples of program code, we | -recommend releasing these examples in parallel under your choice of | -free software license, such as the GNU General Public License, to | -permit their use in free software. | +File: scm-5f2.info, Node: GNU Free Documentation License, Prev: SIOD copyright, Up: Copying | +1.3.3 GNU Free Documentation License +------------------------------------ + + Version 1.3, 3 November 2008 + + Copyright (C) 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. + `http://fsf.org/' + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + 0. PREAMBLE + + The purpose of this License is to make a manual, textbook, or other + functional and useful document "free" in the sense of freedom: to + assure everyone the effective freedom to copy and redistribute it, + with or without modifying it, either commercially or + noncommercially. Secondarily, this License preserves for the + author and publisher a way to get credit for their work, while not + being considered responsible for modifications made by others. + + This License is a kind of "copyleft", which means that derivative + works of the document must themselves be free in the same sense. + It complements the GNU General Public License, which is a copyleft + license designed for free software. + + We have designed this License in order to use it for manuals for + free software, because free software needs free documentation: a + free program should come with manuals providing the same freedoms + that the software does. But this License is not limited to + software manuals; it can be used for any textual work, regardless + of subject matter or whether it is published as a printed book. + We recommend this License principally for works whose purpose is + instruction or reference. + + 1. APPLICABILITY AND DEFINITIONS + + This License applies to any manual or other work, in any medium, + that contains a notice placed by the copyright holder saying it + can be distributed under the terms of this License. Such a notice + grants a world-wide, royalty-free license, unlimited in duration, + to use that work under the conditions stated herein. The + "Document", below, refers to any such manual or work. Any member + of the public is a licensee, and is addressed as "you". You + accept the license if you copy, modify or distribute the work in a + way requiring permission under copyright law. + + A "Modified Version" of the Document means any work containing the + Document or a portion of it, either copied verbatim, or with + modifications and/or translated into another language. + + A "Secondary Section" is a named appendix or a front-matter section + of the Document that deals exclusively with the relationship of the + publishers or authors of the Document to the Document's overall + subject (or to related matters) and contains nothing that could + fall directly within that overall subject. (Thus, if the Document + is in part a textbook of mathematics, a Secondary Section may not + explain any mathematics.) The relationship could be a matter of + historical connection with the subject or with related matters, or + of legal, commercial, philosophical, ethical or political position + regarding them. + + The "Invariant Sections" are certain Secondary Sections whose + titles are designated, as being those of Invariant Sections, in + the notice that says that the Document is released under this + License. If a section does not fit the above definition of + Secondary then it is not allowed to be designated as Invariant. + The Document may contain zero Invariant Sections. If the Document + does not identify any Invariant Sections then there are none. + + The "Cover Texts" are certain short passages of text that are + listed, as Front-Cover Texts or Back-Cover Texts, in the notice + that says that the Document is released under this License. A + Front-Cover Text may be at most 5 words, and a Back-Cover Text may + be at most 25 words. + + A "Transparent" copy of the Document means a machine-readable copy, + represented in a format whose specification is available to the + general public, that is suitable for revising the document + straightforwardly with generic text editors or (for images + composed of pixels) generic paint programs or (for drawings) some + widely available drawing editor, and that is suitable for input to + text formatters or for automatic translation to a variety of + formats suitable for input to text formatters. A copy made in an + otherwise Transparent file format whose markup, or absence of + markup, has been arranged to thwart or discourage subsequent + modification by readers is not Transparent. An image format is + not Transparent if used for any substantial amount of text. A + copy that is not "Transparent" is called "Opaque". + + Examples of suitable formats for Transparent copies include plain + ASCII without markup, Texinfo input format, LaTeX input format, + SGML or XML using a publicly available DTD, and + standard-conforming simple HTML, PostScript or PDF designed for + human modification. Examples of transparent image formats include + PNG, XCF and JPG. Opaque formats include proprietary formats that + can be read and edited only by proprietary word processors, SGML or + XML for which the DTD and/or processing tools are not generally + available, and the machine-generated HTML, PostScript or PDF + produced by some word processors for output purposes only. + + The "Title Page" means, for a printed book, the title page itself, + plus such following pages as are needed to hold, legibly, the + material this License requires to appear in the title page. For + works in formats which do not have any title page as such, "Title + Page" means the text near the most prominent appearance of the + work's title, preceding the beginning of the body of the text. + + The "publisher" means any person or entity that distributes copies + of the Document to the public. + + A section "Entitled XYZ" means a named subunit of the Document + whose title either is precisely XYZ or contains XYZ in parentheses + following text that translates XYZ in another language. (Here XYZ + stands for a specific section name mentioned below, such as + "Acknowledgements", "Dedications", "Endorsements", or "History".) + To "Preserve the Title" of such a section when you modify the + Document means that it remains a section "Entitled XYZ" according + to this definition. + + The Document may include Warranty Disclaimers next to the notice + which states that this License applies to the Document. These + Warranty Disclaimers are considered to be included by reference in + this License, but only as regards disclaiming warranties: any other + implication that these Warranty Disclaimers may have is void and + has no effect on the meaning of this License. + + 2. VERBATIM COPYING + + You may copy and distribute the Document in any medium, either + commercially or noncommercially, provided that this License, the + copyright notices, and the license notice saying this License + applies to the Document are reproduced in all copies, and that you + add no other conditions whatsoever to those of this License. You + may not use technical measures to obstruct or control the reading + or further copying of the copies you make or distribute. However, + you may accept compensation in exchange for copies. If you + distribute a large enough number of copies you must also follow + the conditions in section 3. + + You may also lend copies, under the same conditions stated above, + and you may publicly display copies. + + 3. COPYING IN QUANTITY + + If you publish printed copies (or copies in media that commonly + have printed covers) of the Document, numbering more than 100, and + the Document's license notice requires Cover Texts, you must + enclose the copies in covers that carry, clearly and legibly, all + these Cover Texts: Front-Cover Texts on the front cover, and + Back-Cover Texts on the back cover. Both covers must also clearly + and legibly identify you as the publisher of these copies. The + front cover must present the full title with all words of the + title equally prominent and visible. You may add other material + on the covers in addition. Copying with changes limited to the + covers, as long as they preserve the title of the Document and + satisfy these conditions, can be treated as verbatim copying in + other respects. + + If the required texts for either cover are too voluminous to fit + legibly, you should put the first ones listed (as many as fit + reasonably) on the actual cover, and continue the rest onto + adjacent pages. + + If you publish or distribute Opaque copies of the Document + numbering more than 100, you must either include a + machine-readable Transparent copy along with each Opaque copy, or + state in or with each Opaque copy a computer-network location from + which the general network-using public has access to download + using public-standard network protocols a complete Transparent + copy of the Document, free of added material. If you use the + latter option, you must take reasonably prudent steps, when you + begin distribution of Opaque copies in quantity, to ensure that + this Transparent copy will remain thus accessible at the stated + location until at least one year after the last time you + distribute an Opaque copy (directly or through your agents or + retailers) of that edition to the public. + + It is requested, but not required, that you contact the authors of + the Document well before redistributing any large number of + copies, to give them a chance to provide you with an updated + version of the Document. + + 4. MODIFICATIONS + + You may copy and distribute a Modified Version of the Document + under the conditions of sections 2 and 3 above, provided that you + release the Modified Version under precisely this License, with + the Modified Version filling the role of the Document, thus + licensing distribution and modification of the Modified Version to + whoever possesses a copy of it. In addition, you must do these + things in the Modified Version: + + A. Use in the Title Page (and on the covers, if any) a title + distinct from that of the Document, and from those of + previous versions (which should, if there were any, be listed + in the History section of the Document). You may use the + same title as a previous version if the original publisher of + that version gives permission. + + B. List on the Title Page, as authors, one or more persons or + entities responsible for authorship of the modifications in + the Modified Version, together with at least five of the + principal authors of the Document (all of its principal + authors, if it has fewer than five), unless they release you + from this requirement. + + C. State on the Title page the name of the publisher of the + Modified Version, as the publisher. + + D. Preserve all the copyright notices of the Document. + + E. Add an appropriate copyright notice for your modifications + adjacent to the other copyright notices. + + F. Include, immediately after the copyright notices, a license + notice giving the public permission to use the Modified + Version under the terms of this License, in the form shown in + the Addendum below. + + G. Preserve in that license notice the full lists of Invariant + Sections and required Cover Texts given in the Document's + license notice. + + H. Include an unaltered copy of this License. + + I. Preserve the section Entitled "History", Preserve its Title, + and add to it an item stating at least the title, year, new + authors, and publisher of the Modified Version as given on + the Title Page. If there is no section Entitled "History" in + the Document, create one stating the title, year, authors, + and publisher of the Document as given on its Title Page, + then add an item describing the Modified Version as stated in + the previous sentence. + + J. Preserve the network location, if any, given in the Document + for public access to a Transparent copy of the Document, and + likewise the network locations given in the Document for + previous versions it was based on. These may be placed in + the "History" section. You may omit a network location for a + work that was published at least four years before the + Document itself, or if the original publisher of the version + it refers to gives permission. + + K. For any section Entitled "Acknowledgements" or "Dedications", + Preserve the Title of the section, and preserve in the + section all the substance and tone of each of the contributor + acknowledgements and/or dedications given therein. + + L. Preserve all the Invariant Sections of the Document, + unaltered in their text and in their titles. Section numbers + or the equivalent are not considered part of the section + titles. + + M. Delete any section Entitled "Endorsements". Such a section + may not be included in the Modified Version. + + N. Do not retitle any existing section to be Entitled + "Endorsements" or to conflict in title with any Invariant + Section. + + O. Preserve any Warranty Disclaimers. + + If the Modified Version includes new front-matter sections or + appendices that qualify as Secondary Sections and contain no + material copied from the Document, you may at your option + designate some or all of these sections as invariant. To do this, + add their titles to the list of Invariant Sections in the Modified + Version's license notice. These titles must be distinct from any + other section titles. + + You may add a section Entitled "Endorsements", provided it contains + nothing but endorsements of your Modified Version by various + parties--for example, statements of peer review or that the text + has been approved by an organization as the authoritative + definition of a standard. + + You may add a passage of up to five words as a Front-Cover Text, + and a passage of up to 25 words as a Back-Cover Text, to the end + of the list of Cover Texts in the Modified Version. Only one + passage of Front-Cover Text and one of Back-Cover Text may be + added by (or through arrangements made by) any one entity. If the + Document already includes a cover text for the same cover, + previously added by you or by arrangement made by the same entity + you are acting on behalf of, you may not add another; but you may + replace the old one, on explicit permission from the previous + publisher that added the old one. + + The author(s) and publisher(s) of the Document do not by this + License give permission to use their names for publicity for or to + assert or imply endorsement of any Modified Version. + + 5. COMBINING DOCUMENTS + + You may combine the Document with other documents released under + this License, under the terms defined in section 4 above for + modified versions, provided that you include in the combination + all of the Invariant Sections of all of the original documents, + unmodified, and list them all as Invariant Sections of your + combined work in its license notice, and that you preserve all + their Warranty Disclaimers. + + The combined work need only contain one copy of this License, and + multiple identical Invariant Sections may be replaced with a single + copy. If there are multiple Invariant Sections with the same name + but different contents, make the title of each such section unique + by adding at the end of it, in parentheses, the name of the + original author or publisher of that section if known, or else a + unique number. Make the same adjustment to the section titles in + the list of Invariant Sections in the license notice of the + combined work. + + In the combination, you must combine any sections Entitled + "History" in the various original documents, forming one section + Entitled "History"; likewise combine any sections Entitled + "Acknowledgements", and any sections Entitled "Dedications". You + must delete all sections Entitled "Endorsements." + + 6. COLLECTIONS OF DOCUMENTS + + You may make a collection consisting of the Document and other + documents released under this License, and replace the individual + copies of this License in the various documents with a single copy + that is included in the collection, provided that you follow the + rules of this License for verbatim copying of each of the + documents in all other respects. + + You may extract a single document from such a collection, and + distribute it individually under this License, provided you insert + a copy of this License into the extracted document, and follow + this License in all other respects regarding verbatim copying of + that document. + + 7. AGGREGATION WITH INDEPENDENT WORKS + + A compilation of the Document or its derivatives with other + separate and independent documents or works, in or on a volume of + a storage or distribution medium, is called an "aggregate" if the + copyright resulting from the compilation is not used to limit the + legal rights of the compilation's users beyond what the individual + works permit. When the Document is included in an aggregate, this + License does not apply to the other works in the aggregate which + are not themselves derivative works of the Document. + + If the Cover Text requirement of section 3 is applicable to these + copies of the Document, then if the Document is less than one half + of the entire aggregate, the Document's Cover Texts may be placed + on covers that bracket the Document within the aggregate, or the + electronic equivalent of covers if the Document is in electronic + form. Otherwise they must appear on printed covers that bracket + the whole aggregate. + + 8. TRANSLATION + + Translation is considered a kind of modification, so you may + distribute translations of the Document under the terms of section + 4. Replacing Invariant Sections with translations requires special + permission from their copyright holders, but you may include + translations of some or all Invariant Sections in addition to the + original versions of these Invariant Sections. You may include a + translation of this License, and all the license notices in the + Document, and any Warranty Disclaimers, provided that you also + include the original English version of this License and the + original versions of those notices and disclaimers. In case of a + disagreement between the translation and the original version of + this License or a notice or disclaimer, the original version will + prevail. + + If a section in the Document is Entitled "Acknowledgements", + "Dedications", or "History", the requirement (section 4) to + Preserve its Title (section 1) will typically require changing the + actual title. + + 9. TERMINATION + + You may not copy, modify, sublicense, or distribute the Document + except as expressly provided under this License. Any attempt + otherwise to copy, modify, sublicense, or distribute it is void, + and will automatically terminate your rights under this License. + + However, if you cease all violation of this License, then your + license from a particular copyright holder is reinstated (a) + provisionally, unless and until the copyright holder explicitly + and finally terminates your license, and (b) permanently, if the + copyright holder fails to notify you of the violation by some + reasonable means prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is + reinstated permanently if the copyright holder notifies you of the + violation by some reasonable means, this is the first time you have + received notice of violation of this License (for any work) from + that copyright holder, and you cure the violation prior to 30 days + after your receipt of the notice. + + Termination of your rights under this section does not terminate + the licenses of parties who have received copies or rights from + you under this License. If your rights have been terminated and + not permanently reinstated, receipt of a copy of some or all of + the same material does not give you any rights to use it. + + 10. FUTURE REVISIONS OF THIS LICENSE + + The Free Software Foundation may publish new, revised versions of + the GNU Free Documentation License from time to time. Such new + versions will be similar in spirit to the present version, but may + differ in detail to address new problems or concerns. See + `http://www.gnu.org/copyleft/'. + + Each version of the License is given a distinguishing version + number. If the Document specifies that a particular numbered + version of this License "or any later version" applies to it, you + have the option of following the terms and conditions either of + that specified version or of any later version that has been + published (not as a draft) by the Free Software Foundation. If + the Document does not specify a version number of this License, + you may choose any version ever published (not as a draft) by the + Free Software Foundation. If the Document specifies that a proxy + can decide which future versions of this License can be used, that + proxy's public statement of acceptance of a version permanently + authorizes you to choose that version for the Document. + + 11. RELICENSING + + "Massive Multiauthor Collaboration Site" (or "MMC Site") means any + World Wide Web server that publishes copyrightable works and also + provides prominent facilities for anybody to edit those works. A + public wiki that anybody can edit is an example of such a server. + A "Massive Multiauthor Collaboration" (or "MMC") contained in the + site means any set of copyrightable works thus published on the MMC + site. + + "CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0 + license published by Creative Commons Corporation, a not-for-profit + corporation with a principal place of business in San Francisco, + California, as well as future copyleft versions of that license + published by that same organization. + + "Incorporate" means to publish or republish a Document, in whole or + in part, as part of another Document. + + An MMC is "eligible for relicensing" if it is licensed under this + License, and if all works that were first published under this + License somewhere other than this MMC, and subsequently + incorporated in whole or in part into the MMC, (1) had no cover + texts or invariant sections, and (2) were thus incorporated prior + to November 1, 2008. + + The operator of an MMC Site may republish an MMC contained in the + site under CC-BY-SA on the same site at any time before August 1, + 2009, provided the MMC is eligible for relicensing. + + +ADDENDUM: How to use this License for your documents +==================================================== + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and license +notices just after the title page: + + Copyright (C) YEAR YOUR NAME. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.3 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. + +If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, +replace the "with...Texts." line with this: + + with the Invariant Sections being LIST THEIR TITLES, with + the Front-Cover Texts being LIST, and with the Back-Cover Texts + being LIST. + +If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + +If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of +free software license, such as the GNU General Public License, to +permit their use in free software. +  -File: scm.info, Node: Bibliography, Prev: Copying, Up: Overview +File: scm-5f2.info, Node: Bibliography, Prev: Copying, Up: Overview | 1.4 Bibliography ================ @@ -659,7 +713,7 @@ File: scm.info, Node: Bibliography, Prev: Copying, Up: Overview the Algorithmic Language Scheme. `ACM Lisp Pointers' Volume IV, Number 3 (July-September 1991), pp. 1-55. - *Note Top: (r4rs)Top. + *note Top: (r4rs)Top. [R5RS] Richard Kelsey and William Clinger and Jonathan (Rees, editors) @@ -667,7 +721,7 @@ File: scm.info, Node: Bibliography, Prev: Copying, Up: Overview `Higher-Order and Symbolic Computation' Volume 11, Number 1 (1998), pp. 7-105, and `ACM SIGPLAN Notices' 33(9), September 1998. - *Note Top: (r5rs)Top. + *note Top: (r5rs)Top. [Exrename] William Clinger Hygienic Macros Through Explicit Renaming `Lisp @@ -690,13 +744,13 @@ File: scm.info, Node: Bibliography, Prev: Copying, Up: Overview Todd R. Eigenschink, Dave Love, and Aubrey Jaffer. SLIB, The Portable Scheme Library. Version 2c8, June 2000. - *Note Top: (slib)Top. + *note Top: (slib)Top. [JACAL] Aubrey Jaffer. JACAL Symbolic Mathematics System. Version 1b0, Sep 1999. - *Note Top: (jacal)Top. + *note Top: (jacal)Top. `scm.texi' `scm.info' @@ -709,42 +763,118 @@ File: scm.info, Node: Bibliography, Prev: Copying, Up: Overview Documentation of the Xlib - SCM Language X Interface.  -File: scm.info, Node: Installing SCM, Next: Operational Features, Prev: Overview, Up: Top - +File: scm-5f2.info, Node: Installing SCM, Next: Operational Features, Prev: Overview, Up: Top + | 2 Installing SCM **************** +SCM runs on a wide variety of platforms. "Distributions" is the | +starting point for all platforms. The process described in "GNU | +configure and make" will work on most Unix and GNU/Linux platforms. If | +it works for you, then you may skip the later sections of "Installing | +SCM". | + | * Menu: -* Making SCM:: Bootstrapping. -* SLIB:: REQUIREd reading. +* Distributions:: Source and Binaries +* GNU configure and make:: For Unix and GNU/Linux * Building SCM:: -* Installing Dynamic Linking:: -* Configure Module Catalog:: -* Saving Images:: Make Fast-Booting Executables -* Automatic C Preprocessor Definitions:: -* Problems Compiling:: -* Problems Linking:: -* Problems Running:: -* Testing:: -* Reporting Problems:: +* Saving Executable Images:: For Faster Startup +* Installation:: +* Troubleshooting and Testing::  -File: scm.info, Node: Making SCM, Next: SLIB, Prev: Installing SCM, Up: Installing SCM - -2.1 Making SCM -============== +File: scm-5f2.info, Node: Distributions, Next: GNU configure and make, Prev: Installing SCM, Up: Installing SCM + | +2.1 Distributions | +================= | -The SCM distribution has "Makefile" which contains rules for making -"scmlit", a "bare-bones" version of SCM sufficient for running `build'. -`build' is used to compile (or create scripts to compile) full -featured versions (*note Building SCM::). +The SCM homepage contains links to precompiled binaries and source | +distributions. | -Makefiles are not portable to the majority of platforms. If `Makefile' -works for you, good; If not, I don't want to hear about it. If you -need to compile SCM without build, there are several ways to proceed: +Downloads and instructions for installing the precompiled binaries are | +at `http://people.csail.mit.edu/jaffer/SCM#QuickStart'. | + | +If there is no precompiled binary for your platform, you may be able to | +build from the source distribution. The rest of these instructions | +deal with building and installing SCM and SLIB from sources. | + | +Download (both SCM and SLIB of) either the last release or current | +development snapshot from | +`http://people.csail.mit.edu/jaffer/SCM#BuildFromSource'. | + | +Unzip both the SCM and SLIB zips. For example, if you are working in | +`/usr/local/src/', this will create directories `/usr/local/src/scm/' | +and `/usr/local/src/slib/'. | + | + +File: scm-5f2.info, Node: GNU configure and make, Next: Building SCM, Prev: Distributions, Up: Installing SCM + | +2.2 GNU configure and make | +========================== | + | +`scm/configure' and `slib/configure' are Shell scripts which create the | +files `scm/config.status' and `slib/config.status' on Unix and MinGW | +systems. | + | +The `config.status' files are used (included) by the Makefile to | +control where the packages will be installed by `make install'. With | +GNU shell (bash) and utilities, the following commands should build and | +install SCM and SLIB: | + | + bash$ (cd slib; ./configure --prefix=/usr/local/) | + bash$ (cd scm | + > ./configure --prefix=/usr/local/ | + > make scmlit | + > sudo make all | + > sudo make install) | + bash$ (cd slib; sudo make install) | + | +If the install commands worked, skip to *note Testing::. | + | +If `configure' doesn't work on your system, make `scm/config.status' | +and `slib/config.status' be empty files. | + | +For additional help on using the `configure' script, run | +`./configure --help'. | + | +`make all' will attempt to create a dumped executable (*note Saving | +Executable Images::), which has very small startup latency. If that | +fails, it will try to compile an ordinary `scm' executable. | + | +Note that the compilation output may contain error messages; be | +concerned only if the `make install' transcripts contain errors. | + | +`sudo' runs the command after it as user "root". On recent GNU/Linux | +systems, dumping requires that `make all' be run as user root; hence | +the use of `sudo'. | + | +`make install' requires root privileges if you are installing to | +standard Unix locations as specified to (or defaulted by) | +`./configure'. Note that this is independent of whether you did | +`sudo make all' or `make all'. | + | +* Menu: + | +* Making scmlit:: +* Makefile targets:: + | + +File: scm-5f2.info, Node: Making scmlit, Next: Makefile targets, Prev: GNU configure and make, Up: GNU configure and make + | +2.2.1 Making scmlit | +------------------- | + | +The SCM distribution `Makefile' contains rules for making "scmlit", a | +"bare-bones" version of SCM sufficient for running `build'. `build' is | +a Scheme program used to compile (or create scripts to compile) full | +featured versions of SCM (*note Building SCM::). To create scmlit, run | +`make scmlit' in the `scm/' directory. | + | +Makefiles are not portable to the majority of platforms. If you need | +to compile SCM without `scmlit', there are several ways to proceed: | - * Use the build (http://swiss.csail.mit.edu/~jaffer/buildscm.html) + * Use the build (http://people.csail.mit.edu/jaffer/buildscm.html) web page to create custom batch scripts for compiling SCM. * Use SCM on a different platform to run `build' to create a script @@ -755,51 +885,115 @@ need to compile SCM without build, there are several ways to proceed: * Create your own script or `Makefile'. - -File: scm.info, Node: SLIB, Next: Building SCM, Prev: Making SCM, Up: Installing SCM - -2.2 SLIB -======== - -[SLIB] is a portable Scheme library meant to provide compatibility and -utility functions for all standard Scheme implementations. Although -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: +Finding SLIB | +------------ | - * swiss.csail.mit.edu:/pub/scm/slib-3b1.tar.gz | +If you didn't create scmlit using `make scmlit', then you must create a | +file named `scm/require.scm'. For most installations, | +`scm/require.scm' can just be copied from `scm/requires.scm', which is | +part of the SCM distribution. | - * ftp.gnu.org:/pub/gnu/jacal/slib-3b1.tar.gz | +If, when executing `scmlit' or `scm', you get a message like: | -Unpack SLIB (`tar xzf slib-3b1.tar.gz' or `unzip -ao slib-3b1.zip') in | -an appropriate directory for your system; both `tar' and `unzip' will | -create the directory `slib'. + ERROR: "LOAD couldn't find file " "/usr/local/src/scm/require" | -Then create a file `require.scm' in the SCM "implementation-vicinity" -(this is the same directory as where the file `Init5e5.scm' is | -installed). `require.scm' should have the contents: +then create a file `require.scm' in the SCM "implementation-vicinity" | +(this is the same directory as where the file `Init5f1.scm' is). | +`require.scm' should have the contents: | (define (library-vicinity) "/usr/local/lib/slib/") where the pathname string `/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 (*note chmod: I/O-Extensions.). -The way to specify a relative pathname is to append it to the -implementation-vicinity, which is absolute: +the pathname into which you unzipped (or installed) SLIB. | + | +Alternatively, you can set the (shell) environment variable | +`SCHEME_LIBRARY_PATH' to the pathname of the SLIB directory (*note | +SCHEME_LIBRARY_PATH: SCM Variables.). If set, this environment | +variable overrides `scm/require.scm'. | + | +Absolute pathnames are recommended here; if you use a relative | +pathname, SLIB can get confused when the working directory is changed | +(*note chmod: I/O-Extensions.). The way to specify a relative pathname | +is to append it to the implementation-vicinity, which is absolute: | (define library-vicinity (let ((lv (string-append (implementation-vicinity) "../slib/"))) (lambda () lv))) -Alternatively, you can set the (shell) environment variable -`SCHEME_LIBRARY_PATH' to the pathname of the SLIB directory (*note -SCHEME_LIBRARY_PATH: SCM Variables.). If set, the environment variable -overrides `require.scm'. Again, absolute pathnames are recommended. -  -File: scm.info, Node: Building SCM, Next: Installing Dynamic Linking, Prev: SLIB, Up: Installing SCM +File: scm-5f2.info, Node: Makefile targets, Prev: Making scmlit, Up: GNU configure and make + | +2.2.2 Makefile targets | +---------------------- | + | +Each of the following four `make' targets creates an executable named | +`scm'. Each target takes its build options from a file with an `.opt' | +suffix. If that options file doesn't exist, making that target will | +create the file with the `-F' features: cautious, bignums, arrays, | +inexact, engineering-notation, and dynamic-linking. Once that `.opt' | +file exists, you can edit it to your taste and it will be preserved. | + | +`make scm4' | + Produces a R4RS executable named `scm' lacking hygienic macros | + (but with defmacro). The build options are taken from `scm4.opt'. | + If build or the executable fails, try removing `dynamic-linking' | + from `scm4.opt'. | + | +`make scm5' | + R5RS; like `make scm4' but with `-F macro'. The build options are | + taken from `scm5.opt'. If build or the executable fails, try | + removing `dynamic-linking' from `scm5.opt'. | + | +`make dscm4' | + Produces a R4RS executable named `udscm4', which it starts and | + dumps to a low startup latency executable named `scm'. The build | + options are taken from `udscm4.opt'. | + | + If the build fails, then `build scm4' instead. If the dumped | + executable fails to run, then send me a bug report (and use | + `build scm4' until the problem with dump is corrected). | + | +`make dscm5' | + Like `make dscm4' but with `-F macro'. The build options are | + taken from `udscm5.opt'. | + | + If the build fails, then `build scm5' instead. If the dumped | + executable fails to run, then send me a bug report (and use | + `build scm5' until the problem with dump is corrected). | + | + | +If the above builds fail because of `-F dynamic-linking', then (because | +they can't be dynamically linked) you will likely want to add some | +other features to the build's `.opt' file. See the `-F' build option | +in *note Build Options::. | + | +If dynamic-linking is working, then you will likely want to compile | +most of the modules as "DLL"s. The build options for compiling DLLs | +are in `dlls.opt'. | + | +`make x.so' | + The `Xlib' module; *note SCM Language X Interface: (Xlibscm)Top. | + | +`make myturtle' | + Creates a DLL named `turtlegr.so' which is a simple graphics API. | + | +`make wbscm.so' | + The `wb' module; *note B-tree database implementation: (wb)Top. | + Compiling this requires that wb source be in a peer directory to | + scm. | + | +`make dlls' | + Compiles all the distributed library modules, but not `wbscm.so'. | + Many of the module compiles are recursively invoked in such a way | + that failure of one (which could be due to a system library not | + being installed) doesn't cause the top-level `make dlls' to fail. | + If `make dlls' fails as a whole, it is time to submit a bug report | + (*note Reporting Problems::). | + | + +File: scm-5f2.info, Node: Building SCM, Next: Saving Executable Images, Prev: GNU configure and make, Up: Installing SCM + | 2.3 Building SCM ================ @@ -807,40 +1001,103 @@ The file "build" loads the file "build.scm", which constructs a relational database of how to compile and link SCM executables. `build.scm' has information for the platforms which SCM has been ported to (of which I have been notified). Some of this information is old, -incorrect, or incomplete. Send corrections and additions to jaffer @ -ai.mit.edu. +incorrect, or incomplete. Send corrections and additions to | +agj@alum.mit.edu. | * Menu: * Invoking Build:: -* Build Options:: +* Build Options:: build --help * Compiling and Linking Custom Files::  -File: scm.info, Node: Invoking Build, Next: Build Options, Prev: Building SCM, Up: Building SCM - +File: scm-5f2.info, Node: Invoking Build, Next: Build Options, Prev: Building SCM, Up: Building SCM + | 2.3.1 Invoking Build -------------------- -The _all_ method will also work for MS-DOS and unix. Use the _all_ -method if you encounter problems with `build'. +This section teaches how to use `build', a Scheme program for creating | +compilation scripts to produce SCM executables and library modules. | +The options accepted by `build' are documented in *note Build Options::. | + | +Use the _any_ method if you encounter problems with the other two | +methods (MS-DOS, Unix). | MS-DOS From the SCM source directory, type `build' followed by up to 9 command line arguments. -unix +Unix | From the SCM source directory, type `./build' followed by command line arguments. -_all_ +_any_ | From the SCM source directory, start `scm' or `scmlit' and type `(load "build")'. Alternatively, start `scm' or `scmlit' with the - command line argument `-ilbuild'. + command line argument `-ilbuild'. This method will also work for | + MS-DOS and Unix. | + | + After loading various SLIB modules, the program will print: | + | + type (b "build ") to build | + type (b*) to enter build command loop | + | + The `b*' procedure enters into a "build shell" where you can enter | + commands (with or without the `build'). Blank lines are ignored. | + To create a build script with all defaults type `build'. | + | + If the build-shell encouters an error, you can reenter the | + build-shell by typing `(b*)'. To exit scm type `(quit)'. | + | + | +Here is a transcript of an interactive (b*) build-shell. | + | + bash$ scmlit | + SCM version 5e7, Copyright (C) 1990-2006 Free Software Foundation. | + 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. | + > (load "build") | + ;loading build | + ; loading /home/jaffer/slib/getparam | + ; loading /home/jaffer/slib/coerce | + ... | + ; done loading build.scm | + type (b "build ") to build | + type (b*) to enter build command loop | + ;done loading build | + # | + > (b*) | + ;loading /home/jaffer/slib/comparse | + ;done loading /home/jaffer/slib/comparse.scm | + build> -t exe | + #! /bin/sh | + # unix (linux) script created by SLIB/batch Wed Oct 26 17:14:23 2011 | + # [-p linux] | + # ================ Write file with C defines | + rm -f scmflags.h | + echo '#define IMPLINIT "Init5e7.scm"'>>scmflags.h | + echo '#define BIGNUMS'>>scmflags.h | + echo '#define FLOATS'>>scmflags.h | + echo '#define ARRAYS'>>scmflags.h | + # ================ Compile C source files | + gcc -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c + # ================ Link C object files | + gcc -rdynamic -o scm continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o -lm -lc + "scm" | + build> -t exe -w myscript.sh | + "scm" | + build> (quit) | +No compilation was done. The `-t exe' command shows the compile | +script. The `-t exe -w myscript.sh' line creates a file `myscript.sh' | +containing the compile script. To actually compile and link it, type | +`./myscript.sh'. | Invoking build without the `-F' option will build or create a shell script with the `arrays', `inexact', and `bignums' options as defaults. +Invoking `build' with `-F lit -o scmlit' will make a script for | +compiling `scmlit'. | bash$ ./build -| @@ -848,7 +1105,7 @@ script with the `arrays', `inexact', and `bignums' options as defaults. # unix (linux) script created by SLIB/batch # ================ Write file with C defines rm -f scmflags.h - echo '#define IMPLINIT "Init5e5.scm"'>>scmflags.h | + echo '#define IMPLINIT "Init5f1.scm"'>>scmflags.h | echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h echo '#define ARRAYS'>>scmflags.h @@ -867,7 +1124,7 @@ in the `-p' or `--platform=' option. # unix (darwin) script created by SLIB/batch # ================ Write file with C defines rm -f scmflags.h - echo '#define IMPLINIT "Init5e5.scm"'>>scmflags.h | + echo '#define IMPLINIT "Init5f1.scm"'>>scmflags.h | # ================ Compile C source files cc -O3 -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c # ================ Link C object files @@ -875,8 +1132,8 @@ in the `-p' or `--platform=' option. cc -o scmlit continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o  -File: scm.info, Node: Build Options, Next: Compiling and Linking Custom Files, Prev: Invoking Build, Up: Building SCM - +File: scm-5f2.info, Node: Build Options, Next: Compiling and Linking Custom Files, Prev: Invoking Build, Up: Building SCM + | 2.3.2 Build Options ------------------- @@ -950,7 +1207,7 @@ the SCM command line options. The `Makefile' calls out builds with the options in `.opt' files: `dlls.opt' - Options for Makefile targets mydlls, myturtle, and x.so. + Options for Makefile targets dlls, myturtle, and x.so. | `gdb.opt' Options for udgdbscm and gdbscm. @@ -1001,7 +1258,7 @@ the SCM command line options. -- Build Option: -s PATHNAME -- Build Option: --scheme-initial=PATHNAME specifies that PATHNAME should be the default location of the SCM - initialization file `Init5e5.scm'. SCM tries several likely | + initialization file `Init5f1.scm'. SCM tries several likely | locations before resorting to PATHNAME (*note File-System Habitat::). If not specified, the current directory (where build is building) is used. @@ -1231,6 +1488,9 @@ the SCM command line options. "wb" WB database with relational wrapper. + "wb-no-threads" | + no-comment | + | "windows" Microsoft Windows executable. @@ -1242,8 +1502,8 @@ the SCM command line options.  -File: scm.info, Node: Compiling and Linking Custom Files, Prev: Build Options, Up: Building SCM - +File: scm-5f2.info, Node: Compiling and Linking Custom Files, Prev: Build Options, Up: Building SCM + | 2.3.3 Compiling and Linking Custom Files ---------------------------------------- @@ -1262,7 +1522,7 @@ link your file at compile time, use the `-c' and `-i' options to build: -| #! /bin/sh rm -f scmflags.h - echo '#define IMPLINIT "/home/jaffer/scm/Init5e5.scm"'>>scmflags.h | + echo '#define IMPLINIT "/home/jaffer/scm/Init5f1.scm"'>>scmflags.h | echo '#define COMPILED_INITS init_foo();'>>scmflags.h echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h @@ -1278,7 +1538,7 @@ To make a dynamically loadable object file use the `-t dll' option: -| #! /bin/sh rm -f scmflags.h - echo '#define IMPLINIT "/home/jaffer/scm/Init5e5.scm"'>>scmflags.h | + echo '#define IMPLINIT "/home/jaffer/scm/Init5f1.scm"'>>scmflags.h | echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h echo '#define ARRAYS'>>scmflags.h @@ -1288,105 +1548,15 @@ To make a dynamically loadable object file use the `-t dll' option: Once `foo.c' compiles correctly (and your SCM build supports dynamic-loading), you can load the compiled file with the Scheme command -`(load "./foo.so")'. See *Note Configure Module Catalog:: for how to +`(load "./foo.so")'. See *note Configure Module Catalog:: for how to add a compiled dll file to SLIB's catalog.  -File: scm.info, Node: Installing Dynamic Linking, Next: Configure Module Catalog, Prev: Building SCM, Up: Installing SCM - -2.4 Installing Dynamic Linking -============================== - -Dynamic linking has not been ported to all platforms. Operating systems -in the BSD family (a.out binary format) can usually be ported to "DLD". -The "dl" library (`#define SUN_DL' for SCM) was a proposed POSIX -standard and may be available on other machines with "COFF" binary -format. For notes about porting to MS-Windows and finishing the port -to VMS *Note VMS Dynamic Linking::. - -"DLD" is a library package of C functions that performs "dynamic link -editing" on GNU/Linux, VAX (Ultrix), Sun 3 (SunOS 3.4 and 4.0), -SPARCstation (SunOS 4.0), Sequent Symmetry (Dynix), and Atari ST. It -is available from: - - * ftp.gnu.org:pub/gnu/dld-3.3.tar.gz - -These notes about using libdl on SunOS are from `gcc.info': - - On a Sun, linking using GNU CC fails to find a shared library and - reports that the library doesn't exist at all. - - This happens if you are using the GNU linker, because it does only - static linking and looks only for unshared libraries. If you have - a shared library with no unshared counterpart, the GNU linker - won't find anything. - - We hope to make a linker which supports Sun shared libraries, but - please don't ask when it will be finished-we don't know. - - Sun forgot to include a static version of `libdl.a' with some - versions of SunOS (mainly 4.1). This results in undefined symbols - when linking static binaries (that is, if you use `-static'). If - you see undefined symbols `_dlclose', `_dlsym' or `_dlopen' when - linking, compile and link against the file `mit/util/misc/dlsym.c' - from the MIT version of X windows. - - -File: scm.info, Node: Configure Module Catalog, Next: Saving Images, Prev: Installing Dynamic Linking, Up: Installing SCM - -2.5 Configure Module Catalog +File: scm-5f2.info, Node: Saving Executable Images, Next: Installation, Prev: Building SCM, Up: Installing SCM + | +2.4 Saving Executable Images | ============================ - -The SLIB module "catalog" can be extended to define other -`require'-able packages by adding calls to the Scheme source file -`mkimpcat.scm'. Within `mkimpcat.scm', the following procedures are -defined. - - -- Function: add-link feature object-file lib1 ... - FEATURE should be a symbol. OBJECT-FILE should be a string naming - a file containing compiled "object-code". Each LIBn argument - should be either a string naming a library file or `#f'. - - If OBJECT-FILE exists, the `add-link' procedure registers symbol - FEATURE so that the first time `require' is called with the symbol - FEATURE as its argument, OBJECT-FILE and the LIB1 ... are - dynamically linked into the executing SCM session. - - If OBJECT-FILE exists, `add-link' returns `#t', otherwise it - returns `#f'. - - For example, to install a compiled dll `foo', add these lines to - `mkimpcat.scm': - - (add-link 'foo - (in-vicinity (implementation-vicinity) "foo" - link:able-suffix)) - - - -- Function: add-alias alias feature - ALIAS and FEATURE are symbols. The procedure `add-alias' - registers ALIAS as an alias for FEATURE. An unspecified value is - returned. - - `add-alias' causes `(require 'ALIAS)' to behave like `(require - 'FEATURE)'. - - -- Function: add-source feature filename - FEATURE is a symbol. FILENAME is a string naming a file - containing Scheme source code. The procedure `add-source' - registers FEATURE so that the first time `require' is called with - the symbol FEATURE as its argument, the file FILENAME will be - `load'ed. An unspecified value is returned. - -Remember to delete the file `slibcat' after modifying the file -`mkimpcat.scm' in order to force SLIB to rebuild its cache. - - -File: scm.info, Node: Saving Images, Next: Automatic C Preprocessor Definitions, Prev: Configure Module Catalog, Up: Installing SCM - -2.6 Saving Images -================= - + | In SCM, the ability to save running program images is called "dump" (*note Dump::). In order to make `dump' available to SCM, build with feature `dump'. `dump'ed executables are compatible with dynamic @@ -1401,23 +1571,23 @@ file from emacs. The `dscm4' and `dscm5' targets in the SCM `Makefile' save images from `udscm4' and `udscm5' executables respectively. -Recent GNU/Linux innovations interfere with `dump'. For: +"Address space layout randomization" interferes with `dump'. Here are | +the fixes for various operating-systems: | Fedora-Core-1 Remove the `#' from the line `#SETARCH = setarch i386' in the `Makefile'. Fedora-Core-3 - `http://jamesthornton.com/writing/emacs-compile.html' writes: [For - FC3] combreloc has become the default for recent GNU ld, which - breaks the unexec/undump on all versions of both Emacs and - XEmacs... + `http://jamesthornton.com/writing/emacs-compile.html' [For FC3] | + combreloc has become the default for recent GNU ld, which breaks | + the unexec/undump on all versions of both Emacs and XEmacs... | Override by adding the following to `udscm5.opt': `--linker-options="-z nocombreloc"' -Kernels later than 2.6.11 - `http://www.opensubscriber.com/message/emacs-devel@gnu.org/1007118.html' +Linux Kernels later than 2.6.11 | +`http://www.opensubscriber.com/message/emacs-devel@gnu.org/1007118.html' mentions the "exec-shield" feature. Kernels later than 2.6.11 must do (as root): @@ -1427,107 +1597,57 @@ Kernels later than 2.6.11 scripted for targets `dscm4' and `dscm5'. You must either set `randomize_va_space' to 0 or run as root to dump. +OS-X 10.6 | +`http://developer.apple.com/library/mac/#documentation/Darwin/Reference/Manpages/man1/dyld.1.html' + The dynamic linker uses the following environment variables. They | + affect any program that uses the dynamic linker. | + | + DYLD_NO_PIE | + | + Causes dyld to not randomize the load addresses of images in a | + process where the main executable was built position independent. | + This can be helpful when trying to reproduce and debug a problem | + in a PIE. | + |  -File: scm.info, Node: Automatic C Preprocessor Definitions, Next: Problems Compiling, Prev: Saving Images, Up: Installing SCM +File: scm-5f2.info, Node: Installation, Next: Troubleshooting and Testing, Prev: Saving Executable Images, Up: Installing SCM + | +2.5 Installation | +================ | -2.7 Automatic C Preprocessor Definitions -======================================== +Once `scmlit', `scm', and `dlls' have been built, these commands will | +install them to the locations specified when you ran `./configure': | + + bash$ (cd scm; make install) | + bash$ (cd slib; make install) | + +Note that installation to system directories (like `/usr/bin/') will | +require that those commands be run as root: | + + bash$ (cd scm; sudo make install) | + bash$ (cd slib; sudo make install) | -These `#defines' are automatically provided by preprocessors of various -C compilers. SCM uses the presence or absence of these definitions to -configure "include file" locations and aliases for library functions. -If the definition(s) corresponding to your system type is missing as -your system is configured, add `-DFLAG' to the compilation command -lines or add a `#define FLAG' line to `scmfig.h' or the beginning of -`scmfig.h'. - - #define Platforms: - ------- ---------- - ARM_ULIB Huw Rogers free unix library for acorn archimedes - AZTEC_C Aztec_C 5.2a - __CYGWIN__ Cygwin - __CYGWIN32__ Cygwin - _DCC Dice C on AMIGA - __GNUC__ Gnu CC (and DJGPP) - __EMX__ Gnu C port (gcc/emx 0.8e) to OS/2 2.0 - __HIGHC__ MetaWare High C - __IBMC__ C-Set++ on OS/2 2.1 - _MSC_VER MS VisualC++ 4.2 - MWC Mark Williams C on COHERENT - __MWERKS__ Metrowerks Compiler; Macintosh and WIN32 (?) - _POSIX_SOURCE ?? - _QC Microsoft QuickC - __STDC__ ANSI C compliant - __TURBOC__ Turbo C and Borland C - __USE_POSIX ?? - __WATCOMC__ Watcom C on MS-DOS - __ZTC__ Zortech C - - _AIX AIX operating system - __APPLE__ Apple Darwin - AMIGA SAS/C 5.10 or Dice C on AMIGA - __amigaos__ Gnu CC on AMIGA - atarist ATARI-ST under Gnu CC - __DragonflyBSD__ DragonflyBSD - __FreeBSD__ FreeBSD - GNUDOS DJGPP (obsolete in version 1.08) - __GO32__ DJGPP (future?) - hpux HP-UX - linux GNU/Linux - macintosh Macintosh (THINK_C and __MWERKS__ define) - MCH_AMIGA Aztec_c 5.2a on AMIGA - __MACH__ Apple Darwin - __MINGW32__ MinGW - Minimalist GNU for Windows - MSDOS Microsoft C 5.10 and 6.00A - _MSDOS Microsoft CLARM and CLTHUMB compilers. - __MSDOS__ Turbo C, Borland C, and DJGPP - __NetBSD__ NetBSD - nosve Control Data NOS/VE - __OpenBSD__ OpenBSD - SVR2 System V Revision 2. - sun SunOS - __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 and Cygwin (Win32 API) - _WIN32_WCE MS Windows CE - vms (and VMS) VAX-11 C under VMS. - - __alpha DEC Alpha processor - __alpha__ DEC Alpha processor - hp9000s800 HP RISC processor - __ia64 GCC on IA64 - __ia64__ GCC on IA64 - _LONGLONG GCC on IA64 - __i386__ DJGPP - i386 DJGPP - _M_ARM Microsoft CLARM compiler defines as 4 for ARM. - _M_ARMT Microsoft CLTHUMB compiler defines as 4 for Thumb. - MULTIMAX Encore computer - ppc PowerPC - __ppc__ PowerPC - pyr Pyramid 9810 processor - __sgi__ Silicon Graphics Inc. - sparc SPARC processor - sequent Sequent computer - tahoe CCI Tahoe processor - vax VAX processor - __x86_64 AMD Opteron - - -File: scm.info, Node: Problems Compiling, Next: Problems Linking, Prev: Automatic C Preprocessor Definitions, Up: Installing SCM - -2.8 Problems Compiling -====================== + +File: scm-5f2.info, Node: Troubleshooting and Testing, Prev: Installation, Up: Installing SCM + | +2.6 Troubleshooting and Testing | +=============================== | + | +* Menu: + | +* Problems Compiling:: +* Problems Linking:: +* Testing:: +* Problems Starting:: +* Problems Running:: +* Reporting Problems:: + | + +File: scm-5f2.info, Node: Problems Compiling, Next: Problems Linking, Prev: Troubleshooting and Testing, Up: Troubleshooting and Testing + | +2.6.1 Problems Compiling | +------------------------ | FILE PROBLEM / MESSAGE HOW TO FIX *.c include file not found. Correct the status of @@ -1557,21 +1677,66 @@ scl.c syntax error. #define SYSTNAME to your system type in scl.c (softtype).  -File: scm.info, Node: Problems Linking, Next: Problems Running, Prev: Problems Compiling, Up: Installing SCM - -2.9 Problems Linking -==================== +File: scm-5f2.info, Node: Problems Linking, Next: Testing, Prev: Problems Compiling, Up: Troubleshooting and Testing + | +2.6.2 Problems Linking | +---------------------- | PROBLEM HOW TO FIX _sin etc. missing. Uncomment LIBS in makefile.  -File: scm.info, Node: Problems Running, Next: Testing, Prev: Problems Linking, Up: Installing SCM - -2.10 Problems Running -===================== +File: scm-5f2.info, Node: Testing, Next: Problems Starting, Prev: Problems Linking, Up: Troubleshooting and Testing + | +2.6.3 Testing | +------------- | + | +Loading `r4rstest.scm' in the distribution will run an [R4RS] | +conformance test on `scm'. | + | + > (load "r4rstest.scm") | + -| | + ;loading r4rstest.scm | + SECTION(2 1) | + SECTION(3 4) | + # | + # | + # | + # | + ... | + | +Loading `pi.scm' in the distribution will enable you to compute digits | +of pi. | + | + > (load "pi.scm") | + ;loading pi.scm | + ;done loading pi.scm | + # | + > (pi 100 5) | + 00003 14159 26535 89793 23846 26433 83279 50288 41971 69399 | + 37510 58209 74944 59230 78164 06286 20899 86280 34825 34211 | + 70679 | + ;Evaluation took 550 ms (60 in gc) 36976 cells work, 1548.B other | + # | + | +Performance | +----------- | + | +Loading `bench.scm' will compute and display performance statistics of | +SCM running `pi.scm'. `make bench' or `make benchlit' appends the | +performance report to the file `BenchLog', facilitating tracking | +effects of changes to SCM on performance. | + | + +File: scm-5f2.info, Node: Problems Starting, Next: Problems Running, Prev: Testing, Up: Troubleshooting and Testing + | +2.6.4 Problems Starting | +----------------------- | PROBLEM HOW TO FIX +/bin/bash: scm: program not found Is `scm' in a `$PATH' directory? | +/bin/bash: /usr/local/bin/scm: `chmod +x /usr/local/bin/scm' | +Permission denied | Opening message and then machine Change memory model option to C crashes. compiler (or makefile). Make sure sizet definition is @@ -1588,61 +1753,27 @@ remove in scmfig.h and Do so and recompile files. recompile scm. add in scmfig.h and recompile scm. -ERROR: Init5e5.scm not found. Assign correct IMPLINIT in makefile | +ERROR: Init5f1.scm not found. Assign correct IMPLINIT in makefile | or scmfig.h. Define environment variable SCM_INIT_PATH to be the full - pathname of Init5e5.scm. | + pathname of Init5f1.scm. | WARNING: require.scm not found. Define environment variable SCHEME_LIBRARY_PATH to be the full pathname of the scheme library [SLIB]. Change library-vicinity in - Init5e5.scm to point to library or | + Init5f1.scm to point to library or | remove. Make sure the value of (library-vicinity) has a trailing file separator (like / or \).  -File: scm.info, Node: Testing, Next: Reporting Problems, Prev: Problems Running, Up: Installing SCM - -2.11 Testing -============ - -Loading `r4rstest.scm' in the distribution will run an [R4RS] -conformance test on `scm'. - - > (load "r4rstest.scm") - -| - ;loading "r4rstest.scm" - SECTION(2 1) - SECTION(3 4) - # - # - # - # - ... - -Loading `pi.scm' in the distribution will enable you to compute digits -of pi. - - > (load "pi") - ;loading "pi" - ;done loading "pi.scm" - ;Evaluation took 20 ms (0 in gc) 767 cells work, 233.B other - # - > (pi 100 5) - 00003 14159 26535 89793 23846 26433 83279 50288 41971 69399 - 37510 58209 74944 59230 78164 06286 20899 86280 34825 34211 - 70679 - ;Evaluation took 550 ms (60 in gc) 36976 cells work, 1548.B other - # - -Loading `bench.scm' will compute and display performance statistics of -SCM running `pi.scm'. `make bench' or `make benchlit' appends the -performance report to the file `BenchLog', facilitating tracking -effects of changes to SCM on performance. +File: scm-5f2.info, Node: Problems Running, Next: Reporting Problems, Prev: Problems Starting, Up: Troubleshooting and Testing + | +2.6.5 Problems Running | +---------------------- | PROBLEM HOW TO FIX Runs some and then machine crashes. See above under machine crashes. @@ -1658,7 +1789,7 @@ Some symbol names print incorrectly. Change memory model option to C than HEAP_SEG_SIZE). ERROR: Rogue pointer in Heap. See above under machine crashes. Newlines don't appear correctly in Check file mode (define OPEN_... in -output files. `Init5e5.scm'). | +output files. `Init5f1.scm'). | Spaces or control characters appear Check character defines in in symbol names. `scmfig.h'. Negative numbers turn positive. Check SRS in `scmfig.h'. @@ -1667,27 +1798,17 @@ Negative numbers turn positive. Check SRS in `scmfig.h'. VMS: Couldn't unwind stack. #define CHEAP_CONTINUATIONS in `scmfig.h'. VAX: botched longjmp. - -Sparc(SUN-4) heap is growing out of control - You are experiencing a GC problem peculiar to the Sparc. The - problem is that SCM doesn't know how to clear register windows. - Every location which is not reused still gets marked at GC time. - This causes lots of stuff which should be collected to not be. - This will be a problem with any _conservative_ GC until we find - what instruction will clear the register windows. This problem is - exacerbated by using lots of call-with-current-continuations. A - possible fix for dynthrow() is commented out in `continue.c'. - + |  -File: scm.info, Node: Reporting Problems, Prev: Testing, Up: Installing SCM - -2.12 Reporting Problems -======================= +File: scm-5f2.info, Node: Reporting Problems, Prev: Problems Running, Up: Troubleshooting and Testing + | +2.6.6 Reporting Problems | +------------------------ | Reported problems and solutions are grouped under Compiling, Linking, Running, and Testing. If you don't find your problem listed there, you -can send a bug report to `agj @ alum.mit.edu'. The bug report should -include: +can send a bug report to `agj@alum.mit.edu' or `scm-discuss@gnu.org'. | +The bug report should include: | 1. The version of SCM (printed when SCM is invoked with no arguments). @@ -1705,8 +1826,8 @@ include: corresponding with the vendor is recommended.  -File: scm.info, Node: Operational Features, Next: The Language, Prev: Installing SCM, Up: Top - +File: scm-5f2.info, Node: Operational Features, Next: The Language, Prev: Installing SCM, Up: Top + | 3 Operational Features ********************** @@ -1726,8 +1847,8 @@ File: scm.info, Node: Operational Features, Next: The Language, Prev: Install * Scripting::  -File: scm.info, Node: Invoking SCM, Next: SCM Options, Prev: Operational Features, Up: Operational Features - +File: scm-5f2.info, Node: Invoking SCM, Next: SCM Options, Prev: Operational Features, Up: Operational Features + | 3.1 Invoking SCM ================ @@ -1744,8 +1865,8 @@ variable SCM_INIT_PATH. If SCM_INIT_PATH is not defined or if the file it names is not present, `scm' tries to find the directory containing the executable file. If it is able to locate the executable, `scm' looks for the initialization -file (usually `Init5e5.scm') in platform-dependent directories relative | -to this directory. See *Note File-System Habitat:: for a blow-by-blow +file (usually `Init5f1.scm') in platform-dependent directories relative | +to this directory. See *note File-System Habitat:: for a blow-by-blow description. As a last resort (if initialization file cannot be located), the C @@ -1753,12 +1874,12 @@ compile parameter IMPLINIT (defined in the makefile or `scmfig.h') is tried. Unless the option `-no-init-file' or `--no-init-file' occurs in the -command line, or if `scm' is being invoked as a script, `Init5e5.scm' | +command line, or if `scm' is being invoked as a script, `Init5f1.scm' | checks to see if there is file `ScmInit.scm' in the path specified by the environment variable HOME (or in the current directory if HOME is undefined). If it finds such a file, then it is loaded. -`Init5e5.scm' then looks for command input from one of three sources: | +`Init5f1.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. @@ -1768,8 +1889,8 @@ Scheme-code files can also invoke SCM and its variants. *Note #!: Lexical Conventions.  -File: scm.info, Node: SCM Options, Next: Invocation Examples, Prev: Invoking SCM, Up: Operational Features - +File: scm-5f2.info, Node: SCM Options, Next: Invocation Examples, Prev: Invoking SCM, Up: Operational Features + | 3.2 Options =========== @@ -1883,8 +2004,8 @@ The options are processed in the order specified on the command line. aguments.  -File: scm.info, Node: Invocation Examples, Next: SCM Variables, Prev: SCM Options, Up: Operational Features - +File: scm-5f2.info, Node: Invocation Examples, Next: SCM Variables, Prev: SCM Options, Up: Operational Features + | 3.3 Invocation Examples ======================= @@ -1915,20 +2036,20 @@ File: scm.info, Node: Invocation Examples, Next: SCM Variables, Prev: SCM Opt Like above but `rev4-optional-procedures' are also loaded.  -File: scm.info, Node: SCM Variables, Next: SCM Session, Prev: Invocation Examples, Up: Operational Features - +File: scm-5f2.info, Node: SCM Variables, Next: SCM Session, Prev: Invocation Examples, Up: Operational Features + | 3.4 Environment Variables ========================= -- Environment Variable: SCM_INIT_PATH is the pathname where `scm' will look for its initialization code. - The default is the file `Init5e5.scm' in the source directory. | + The default is the file `Init5f1.scm' in the source directory. | -- Environment Variable: SCHEME_LIBRARY_PATH is the [SLIB] Scheme library directory. -- Environment Variable: HOME - is the directory where `Init5e5.scm' will look for the user | + is the directory where `Init5f1.scm' will look for the user | initialization file `ScmInit.scm'. -- Environment Variable: EDITOR @@ -1955,8 +2076,8 @@ File: scm.info, Node: SCM Variables, Next: SCM Session, Prev: Invocation Exam line. This can be overridden by subsequent `-i' and `-b' options.  -File: scm.info, Node: SCM Session, Next: Editing Scheme Code, Prev: SCM Variables, Up: Operational Features - +File: scm-5f2.info, Node: SCM Session, Next: Editing Scheme Code, Prev: SCM Variables, Up: Operational Features + | 3.6 SCM Session =============== @@ -1994,13 +2115,28 @@ File: scm.info, Node: SCM Session, Next: Editing Scheme Code, Prev: SCM Varia For documentation of the procedures `getenv' and `system' *Note System Interface: (slib)System Interface. +SCM extends `getenv' as suggested by draft SRFI-98: + + -- Function: getenv name + Looks up NAME, a string, in the program environment. If NAME is + found a string of its value is returned. Otherwise, `#f' is + returned. + + -- Function: getenv + Returns names and values of all the environment variables as an + association-list. + + (getenv) => + (("PATH" . "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin") + ("USERNAME" . "taro")) + -- Function: vms-debug If SCM is compiled under VMS this `vms-debug' will invoke the VMS debugger.  -File: scm.info, Node: Editing Scheme Code, Next: Debugging Scheme Code, Prev: SCM Session, Up: Operational Features - +File: scm-5f2.info, Node: Editing Scheme Code, Next: Debugging Scheme Code, Prev: SCM Session, Up: Operational Features + | 3.7 Editing Scheme Code ======================= @@ -2047,8 +2183,8 @@ other systems: After editing, the modified file will be loaded.  -File: scm.info, Node: Debugging Scheme Code, Next: Debugging Continuations, Prev: Editing Scheme Code, Up: Operational Features - +File: scm-5f2.info, Node: Debugging Scheme Code, Next: Debugging Continuations, Prev: Editing Scheme Code, Up: Operational Features + | 3.8 Debugging Scheme Code ========================= @@ -2060,7 +2196,7 @@ debugging in Scheme. occurs, a "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. See *Note Memoized Expressions:: for + procedure is not builtin. See *note Memoized Expressions:: for how to read memoized expressions. Also as the result of the `CAUTIOUS' flag, both `error' and @@ -2137,21 +2273,20 @@ could be large. `pp' is a better choice. 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, *Note Quick Print: (slib)Quick Print, can be +external representations, *note Quick Print: (slib)Quick Print, can be used. When `trace' is not sufficient to find program flow problems, SLIB-PSD, the Portable Scheme Debugger offers source code debugging from GNU Emacs. PSD runs slowly, so start by instrumenting only a few functions at a time. - http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz - swiss.csail.mit.edu:/pub/scm/slib-psd1-3.tar.gz + http://groups.csail.mit.edu/mac/ftpdir/scm/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  -File: scm.info, Node: Debugging Continuations, Next: Errors, Prev: Debugging Scheme Code, Up: Operational Features - +File: scm-5f2.info, Node: Debugging Continuations, Next: Errors, Prev: Debugging Scheme Code, Up: Operational Features + | 3.9 Debugging Continuations =========================== @@ -2180,7 +2315,7 @@ continuations: of continuation CONT and returns the result. Values in the environment may be returned or SET!. -*Note stack-trace: Errors. also now accepts an optional continuation +*note stack-trace: Errors. also now accepts an optional continuation argument. `stack-trace' differs from `frame-trace' in that it truncates long output using safeports and prints code from all available frames. @@ -2238,8 +2373,8 @@ available frames. (frame-eval k 0 'x) => 8  -File: scm.info, Node: Errors, Next: Memoized Expressions, Prev: Debugging Continuations, Up: Operational Features - +File: scm-5f2.info, Node: Errors, Next: Memoized Expressions, Prev: Debugging Continuations, Up: Operational Features + | 3.10 Errors =========== @@ -2346,20 +2481,20 @@ a system or library function. warnings and errors. -- Function: warn arg1 arg2 arg3 ... - Alias for *Note slib:warn: (slib)System. Outputs an error message - containing the arguments. `warn' is defined in `Init5e5.scm'. | + Alias for *note slib:warn: (slib)System. Outputs an error message + containing the arguments. `warn' is defined in `Init5f1.scm'. | -- Function: error arg1 arg2 arg3 ... - Alias for *Note slib:error: (slib)System. Outputs an error + Alias for *note slib:error: (slib)System. 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 `Init5e5.scm'. | + defined in `Init5f1.scm'. | If SCM is built with the `CAUTIOUS' flag, then when an error occurs, a "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. See *Note Memoized Expressions:: for how to read memoized +builtin. See *note Memoized Expressions:: for how to read memoized expressions. Also as the result of the `CAUTIOUS' flag, both `error' and @@ -2371,12 +2506,12 @@ with Lisp systems. -- Function: stack-trace Prints information describing the stack of partially evaluated expressions. `stack-trace' returns `#t' if any lines were printed - and `#f' otherwise. See `Init5e5.scm' for an example of the use | + and `#f' otherwise. See `Init5f1.scm' for an example of the use | of `stack-trace'.  -File: scm.info, Node: Memoized Expressions, Next: Internal State, Prev: Errors, Up: Operational Features - +File: scm-5f2.info, Node: Memoized Expressions, Next: Internal State, Prev: Errors, Up: Operational Features + | 3.11 Memoized Expressions ========================= @@ -2396,7 +2531,7 @@ a convenient aid to locating bugs and untested expressions. * The names of identifiers which are not lexiallly bound but defined at top-level have #@ prepended. -For instance, `open-input-file' is defined as follows in `Init5e5.scm': | +For instance, `open-input-file' is defined as follows in `Init5f1.scm': | (define (open-input-file str) (or (open-file str open_read) @@ -2434,8 +2569,8 @@ too become memoized: (#@error "OPEN-INPUT-FILE couldn't open file " #@0+0))>  -File: scm.info, Node: Internal State, Next: Scripting, Prev: Memoized Expressions, Up: Operational Features - +File: scm-5f2.info, Node: Internal State, Next: Scripting, Prev: Memoized Expressions, Up: Operational Features + | 3.12 Internal State =================== @@ -2445,7 +2580,7 @@ File: scm.info, Node: Internal State, Next: Scripting, Prev: Memoized Express *INTERACTIVE* is controlled directly by the command-line options `-b', `-i', and `-s' (*note Invoking SCM::). If none of these options are specified, the rules to determine interactivity are - more complicated; see `Init5e5.scm' for details. | + more complicated; see `Init5f1.scm' for details. | -- Function: abort Resumes the top level Read-Eval-Print loop. @@ -2494,13 +2629,16 @@ File: scm.info, Node: Internal State, Next: Scripting, Prev: Memoized Express Scans all of SCM objects and reclaims for further use those that are no longer accessible. + -- Function: gc #t | + Garbage-collects only the ecache. | + | -- Function: room -- Function: room #t Prints out statistics about SCM's current use of storage. `(room #t)' also gives the hexadecimal heap segment and stack bounds. -- Constant: *scm-version* - Contains the version string (e.g. `5e5') of SCM. | + Contains the version string (e.g. `5f1') of SCM. | 3.12.1 Executable path ---------------------- @@ -2525,8 +2663,8 @@ For other configuration constants and procedures *Note Configuration: (slib)Configuration.  -File: scm.info, Node: Scripting, Prev: Internal State, Up: Operational Features - +File: scm-5f2.info, Node: Scripting, Prev: Internal State, Up: Operational Features + | 3.13 Scripting ============== @@ -2537,8 +2675,8 @@ File: scm.info, Node: Scripting, Prev: Internal State, Up: Operational Featur * Unix Shell Scripts:: Use /bin/sh to run Scheme  -File: scm.info, Node: Unix Scheme Scripts, Next: MS-DOS Compatible Scripts, Prev: Scripting, Up: Scripting - +File: scm-5f2.info, Node: Unix Scheme Scripts, Next: MS-DOS Compatible Scripts, Prev: Scripting, Up: Scripting + | 3.13.1 Unix Scheme Scripts -------------------------- @@ -2623,15 +2761,15 @@ usage information. Returns the factorial of N.  -File: scm.info, Node: MS-DOS Compatible Scripts, Next: Unix Shell Scripts, Prev: Unix Scheme Scripts, Up: Scripting - +File: scm-5f2.info, Node: MS-DOS Compatible Scripts, Next: Unix Shell Scripts, Prev: Unix Scheme Scripts, Up: Scripting + | 3.13.2 MS-DOS Compatible Scripts -------------------------------- It turns out that we can create scheme-scripts which run both under unix and MS-DOS. To implement this, I have written the MS-DOS programs: `#!.bat' and `!#.exe', which are available from: -`http://swiss.csail.mit.edu/ftpdir/scm/sharpbang.zip' +`http://groups.csail.mit.edu/mac/ftpdir/scm/sharpbang.zip' With these two programs installed in a `PATH' directory, we have the following syntax for .BAT files. @@ -2664,8 +2802,8 @@ The previous example Scheme-Script works in both MS-DOS and unix systems.  -File: scm.info, Node: Unix Shell Scripts, Prev: MS-DOS Compatible Scripts, Up: Scripting - +File: scm-5f2.info, Node: Unix Shell Scripts, Prev: MS-DOS Compatible Scripts, Up: Scripting + | 3.13.3 Unix Shell Scripts ------------------------- @@ -2724,8 +2862,8 @@ example. => 720  -File: scm.info, Node: The Language, Next: Packages, Prev: Operational Features, Up: Top - +File: scm-5f2.info, Node: The Language, Next: Packages, Prev: Operational Features, Up: Top + | 4 The Language ************** @@ -2742,14 +2880,14 @@ File: scm.info, Node: The Language, Next: Packages, Prev: Operational Feature * Syntax:: Macros  -File: scm.info, Node: Standards Compliance, Next: Storage, Prev: The Language, Up: The Language - +File: scm-5f2.info, Node: Standards Compliance, Next: Storage, Prev: The Language, Up: The Language + | 4.1 Standards Compliance ======================== Scm conforms to the `IEEE Standard 1178-1990. IEEE Standard for the Scheme Programming Language.' (*note Bibliography::), and `Revised(5) -Report on the Algorithmic Language Scheme'. *Note Top: (r5rs)Top. All +Report on the Algorithmic Language Scheme'. *note Top: (r5rs)Top. All the required features of these specifications are supported. Many of the optional features are supported as well. @@ -2862,8 +3000,8 @@ Optionals of [R5RS] not Supported by SCM *Note Require: (slib)Require.  -File: scm.info, Node: Storage, Next: Time, Prev: Standards Compliance, Up: The Language - +File: scm-5f2.info, Node: Storage, Next: Time, Prev: Standards Compliance, Up: The Language + | 4.2 Storage =========== @@ -2920,8 +3058,8 @@ File: scm.info, Node: Storage, Next: Time, Prev: Standards Compliance, Up: T Springer-Verlag LNCS.  -File: scm.info, Node: Time, Next: Interrupts, Prev: Storage, Up: The Language - +File: scm-5f2.info, Node: Time, Next: Interrupts, Prev: Storage, Up: The Language + | 4.3 Time ======== @@ -2939,17 +3077,17 @@ File: scm.info, Node: Time, Next: Interrupts, Prev: Storage, Up: The Languag Returns the integer time in internal time units from an unspecified starting time. The difference of two calls to `get-internal-real-time' divided by - `interal-time-units-per-second' will give elapsed real time in + `internal-time-units-per-second' will give elapsed real time in | seconds. -- Function: current-time Returns the time since 00:00:00 GMT, January 1, 1970, measured in seconds. *Note current-time: (slib)Time and Date. `current-time' - is used in *Note Time and Date: (slib)Time and Date. + is used in *note Time and Date: (slib)Time and Date.  -File: scm.info, Node: Interrupts, Next: Process Synchronization, Prev: Time, Up: The Language - +File: scm-5f2.info, Node: Interrupts, Next: Process Synchronization, Prev: Time, Up: The Language + | 4.4 Interrupts ============== @@ -3027,8 +3165,8 @@ File: scm.info, Node: Interrupts, Next: Process Synchronization, Prev: Time, `#f'. For instance, `(set! could-not-open #f)'.  -File: scm.info, Node: Process Synchronization, Next: Files and Ports, Prev: Interrupts, Up: The Language - +File: scm-5f2.info, Node: Process Synchronization, Next: Files and Ports, Prev: Interrupts, Up: The Language + | 4.5 Process Synchronization =========================== @@ -3073,13 +3211,13 @@ operation. Otherwise, returns `#f'.  -File: scm.info, Node: Files and Ports, Next: Eval and Load, Prev: Process Synchronization, Up: The Language - +File: scm-5f2.info, Node: Files and Ports, Next: Eval and Load, Prev: Process Synchronization, Up: The Language + | 4.6 Files and Ports =================== These procedures generalize and extend the standard capabilities in -*Note Ports: (r5rs)Ports. +*note Ports: (r5rs)Ports. * Menu: @@ -3089,8 +3227,8 @@ These procedures generalize and extend the standard capabilities in * Soft Ports::  -File: scm.info, Node: Opening and Closing, Next: Port Properties, Prev: Files and Ports, Up: Files and Ports - +File: scm-5f2.info, Node: Opening and Closing, Next: Port Properties, Prev: Files and Ports, Up: Files and Ports + | 4.6.1 Opening and Closing ------------------------- @@ -3146,8 +3284,8 @@ File: scm.info, Node: Opening and Closing, Next: Port Properties, Prev: Files Closes PORT. The same as close-input-port and close-output-port.  -File: scm.info, Node: Port Properties, Next: Port Redirection, Prev: Opening and Closing, Up: Files and Ports - +File: scm-5f2.info, Node: Port Properties, Next: Port Redirection, Prev: Opening and Closing, Up: Files and Ports + | 4.6.2 Port Properties --------------------- @@ -3219,8 +3357,8 @@ File: scm.info, Node: Port Properties, Next: Port Redirection, Prev: Opening returned by `current-input-port'.  -File: scm.info, Node: Port Redirection, Next: Soft Ports, Prev: Port Properties, Up: Files and Ports - +File: scm-5f2.info, Node: Port Redirection, Next: Soft Ports, Prev: Port Properties, Up: Files and Ports + | 4.6.3 Port Redirection ---------------------- @@ -3252,8 +3390,8 @@ File: scm.info, Node: Port Redirection, Next: Soft Ports, Prev: Port Properti just the output-string and the error-string as arguments.  -File: scm.info, Node: Soft Ports, Prev: Port Redirection, Up: Files and Ports - +File: scm-5f2.info, Node: Soft Ports, Prev: Port Redirection, Up: Files and Ports + | 4.6.4 Soft Ports ---------------- @@ -3301,8 +3439,8 @@ accepting or delivering characters. It allows emulation of I/O ports. (write p p) => #  -File: scm.info, Node: Eval and Load, Next: Lexical Conventions, Prev: Files and Ports, Up: The Language - +File: scm-5f2.info, Node: Eval and Load, Next: Lexical Conventions, Prev: Files and Ports, Up: The Language + | 4.7 Eval and Load ================= @@ -3318,10 +3456,10 @@ File: scm.info, Node: Eval and Load, Next: Lexical Conventions, Prev: Files a Is set to the pathname given as argument to `load', `try-load', and `dyn:link' (*note Compiling And Linking: (hobbit)Compiling And Linking.). `*load-pathname*' is used to compute the value of - *Note program-vicinity: (slib)Vicinity. + *note program-vicinity: (slib)Vicinity. -- Function: eval obj - Alias for *Note eval: (slib)System. + Alias for *note eval: (slib)System. -- Function: eval-string str Returns the result of reading an expression from STR and @@ -3341,8 +3479,8 @@ File: scm.info, Node: Eval and Load, Next: Lexical Conventions, Prev: Files a * Line Numbers::  -File: scm.info, Node: Line Numbers, Prev: Eval and Load, Up: Eval and Load - +File: scm-5f2.info, Node: Line Numbers, Prev: Eval and Load, Up: Eval and Load + | 4.7.1 Line Numbers ------------------ @@ -3401,8 +3539,8 @@ line-numbers in other positions is undefined. `*load-reader*' and `*slib-load-reader*' to #f.  -File: scm.info, Node: Lexical Conventions, Next: Syntax, Prev: Eval and Load, Up: The Language - +File: scm-5f2.info, Node: Lexical Conventions, Next: Syntax, Prev: Eval and Load, Up: The Language + | 4.8 Lexical Conventions ======================= @@ -3414,8 +3552,8 @@ File: scm.info, Node: Lexical Conventions, Next: Syntax, Prev: Eval and Load, * Modifying Read Syntax::  -File: scm.info, Node: Common-Lisp Read Syntax, Next: Load Syntax, Prev: Lexical Conventions, Up: Lexical Conventions - +File: scm-5f2.info, Node: Common-Lisp Read Syntax, Next: Load Syntax, Prev: Lexical Conventions, Up: Lexical Conventions + | 4.8.1 Common-Lisp Read Syntax ----------------------------- @@ -3465,12 +3603,12 @@ using `#.'. is equivalent to FORM (for compatibility with common-lisp).  -File: scm.info, Node: Load Syntax, Next: Documentation and Comments, Prev: Common-Lisp Read Syntax, Up: Lexical Conventions - +File: scm-5f2.info, Node: Load Syntax, Next: Documentation and Comments, Prev: Common-Lisp Read Syntax, Up: Lexical Conventions + | 4.8.2 Load Syntax ----------------- -"#!" is the unix mechanism for executing scripts. See *Note Unix +"#!" is the unix mechanism for executing scripts. See *note Unix Scheme Scripts:: for the full description of how this comment supports scripting. @@ -3484,8 +3622,8 @@ scripting. path is the string passed to `load', possibly with `.scm' appended.  -File: scm.info, Node: Documentation and Comments, Next: Modifying Read Syntax, Prev: Load Syntax, Up: Lexical Conventions - +File: scm-5f2.info, Node: Documentation and Comments, Next: Modifying Read Syntax, Prev: Load Syntax, Up: Lexical Conventions + | 4.8.3 Documentation and Comments -------------------------------- @@ -3517,8 +3655,8 @@ File: scm.info, Node: Documentation and Comments, Next: Modifying Read Syntax, Behaves as `(comment "TEXT-TILL-END-OF-LINE")'.  -File: scm.info, Node: Modifying Read Syntax, Prev: Documentation and Comments, Up: Lexical Conventions - +File: scm-5f2.info, Node: Modifying Read Syntax, Prev: Documentation and Comments, Up: Lexical Conventions + | 4.8.4 Modifying Read Syntax --------------------------- @@ -3549,12 +3687,12 @@ File: scm.info, Node: Modifying Read Syntax, Prev: Documentation and Comments, _Note_ When adding new <#> syntaxes, have your code save the previous value of `load:sharp', `read:sharp', or `char:sharp' when defining it. Call this saved value if an invocation's syntax is not recognized. -This will allow `#+', `#-', and *Note Uniform Array::s to still be +This will allow `#+', `#-', and *note Uniform Array::s to still be supported (as they dispatch from `read:sharp').  -File: scm.info, Node: Syntax, Prev: Lexical Conventions, Up: The Language - +File: scm-5f2.info, Node: Syntax, Prev: Lexical Conventions, Up: The Language + | 4.9 Syntax ========== @@ -3586,8 +3724,8 @@ use the correct macro loader when `require'd. * Syntactic Hooks for Hygienic Macros::  -File: scm.info, Node: Define and Set, Next: Defmacro, Prev: Syntax, Up: Syntax - +File: scm-5f2.info, Node: Define and Set, Next: Defmacro, Prev: Syntax, Up: Syntax + | 4.9.1 Define and Set -------------------- @@ -3668,8 +3806,8 @@ File: scm.info, Node: Define and Set, Next: Defmacro, Prev: Syntax, Up: Synt (else 'consonant)) ==> consonant  -File: scm.info, Node: Defmacro, Next: Syntax-Rules, Prev: Define and Set, Up: Syntax - +File: scm-5f2.info, Node: Defmacro, Next: Syntax-Rules, Prev: Define and Set, Up: Syntax + | 4.9.2 Defmacro -------------- @@ -3702,8 +3840,8 @@ For example: (let1 not legal syntax) error--> not "does not match" ((name value))  -File: scm.info, Node: Syntax-Rules, Next: Macro Primitives, Prev: Defmacro, Up: Syntax - +File: scm-5f2.info, Node: Syntax-Rules, Next: Macro Primitives, Prev: Defmacro, Up: Syntax + | 4.9.3 Syntax-Rules ------------------ @@ -3756,8 +3894,8 @@ For example: (set! eight 9) => ERROR  -File: scm.info, Node: Macro Primitives, Next: Environment Frames, Prev: Syntax-Rules, Up: Syntax - +File: scm-5f2.info, Node: Macro Primitives, Next: Environment Frames, Prev: Syntax-Rules, Up: Syntax + | 4.9.4 Macro Primitives ---------------------- @@ -3796,8 +3934,8 @@ File: scm.info, Node: Macro Primitives, Next: Environment Frames, Prev: Synta may not result in NAME being interpreted as a macro keyword.  -File: scm.info, Node: Environment Frames, Next: Syntactic Hooks for Hygienic Macros, Prev: Macro Primitives, Up: Syntax - +File: scm-5f2.info, Node: Environment Frames, Next: Syntactic Hooks for Hygienic Macros, Prev: Macro Primitives, Up: Syntax + | 4.9.5 Environment Frames ------------------------ @@ -3861,8 +3999,8 @@ There are several types of environment frames: bindings.  -File: scm.info, Node: Syntactic Hooks for Hygienic Macros, Prev: Environment Frames, Up: Syntax - +File: scm-5f2.info, Node: Syntactic Hooks for Hygienic Macros, Prev: Environment Frames, Up: Syntax + | 4.9.6 Syntactic Hooks for Hygienic Macros ----------------------------------------- @@ -4015,8 +4153,8 @@ in order to denote the same binding. binding in the usage environment of the new syntax.  -File: scm.info, Node: Packages, Next: The Implementation, Prev: The Language, Up: Top - +File: scm-5f2.info, Node: Packages, Next: The Implementation, Prev: The Language, Up: Top + | 5 Packages ********** @@ -4043,8 +4181,8 @@ File: scm.info, Node: Packages, Next: The Implementation, Prev: The Language, * Hobbit: (hobbit). Scheme-to-C Compiler  -File: scm.info, Node: Dynamic Linking, Next: Dump, Prev: Packages, Up: Packages - +File: scm-5f2.info, Node: Dynamic Linking, Next: Dump, Prev: Packages, Up: Packages + | 5.1 Dynamic Linking =================== @@ -4154,8 +4292,8 @@ an example of their use. `#t'; If not successful, `#f' is returned.  -File: scm.info, Node: Dump, Next: Numeric, Prev: Dynamic Linking, Up: Packages - +File: scm-5f2.info, Node: Dump, Next: Numeric, Prev: Dynamic Linking, Up: Packages + | 5.2 Dump ======== @@ -4252,8 +4390,8 @@ This task can also be accomplished using the `-o' command line option bash$  -File: scm.info, Node: Numeric, Next: Arrays, Prev: Dump, Up: Packages - +File: scm-5f2.info, Node: Numeric, Next: Arrays, Prev: Dump, Up: Packages + | 5.3 Numeric =========== @@ -4268,8 +4406,18 @@ File: scm.info, Node: Numeric, Next: Arrays, Prev: Dump, Up: Packages -- Constant: pi The ratio of the circumference to the diameter of a circle. -These procedures augment the standard capabilities in *Note Numerical -operations: (r5rs)Numerical operations. +These procedures are in addition to those in *Note Irrational Integer +Functions: (slib)Irrational Integer Functions. | + | + -- Function: exact-round x | + -- Function: exact-floor x | + -- Function: exact-ceiling x | + -- Function: exact-truncate x | + Return exact integers. | + | +These procedures augment the standard capabilities in *note Numerical +operations: (r5rs)Numerical operations. Many are from *Note Irrational +Real Functions: (slib)Irrational Real Functions. | -- Function: pi* z `(* pi Z)' @@ -4296,6 +4444,7 @@ operations: (r5rs)Numerical operations. -- Function: real-asin x -- Function: real-acos x -- Function: real-atan x + -- Function: atan y x | -- Function: real-sinh x -- Function: real-cosh x -- Function: real-tanh x @@ -4317,9 +4466,14 @@ operations: (r5rs)Numerical operations. error if the value which should be returned by a call to `real-expt' is not real. + -- Function: infinite? z | + -- Function: finite? z | + All IEEE-754 numbers except positive and negative infinity and NaN | + (non-a-number) are finite. | + |  -File: scm.info, Node: Arrays, Next: Records, Prev: Numeric, Up: Packages - +File: scm-5f2.info, Node: Arrays, Next: Records, Prev: Numeric, Up: Packages + | 5.4 Arrays ========== @@ -4331,13 +4485,13 @@ File: scm.info, Node: Arrays, Next: Records, Prev: Numeric, Up: Packages * Array Mapping:: array-for-each  -File: scm.info, Node: Conventional Arrays, Next: Uniform Array, Prev: Arrays, Up: Arrays - +File: scm-5f2.info, Node: Conventional Arrays, Next: Uniform Array, Prev: Arrays, Up: Arrays + | 5.4.1 Conventional Arrays ------------------------- The following syntax and procedures are SCM extensions to feature -`array' in *Note Arrays: (slib)Arrays. +`array' in *note Arrays: (slib)Arrays. "Arrays" read and write as a `#' followed by the "rank" (number of dimensions) followed by the character #\a or #\A and what appear as @@ -4383,11 +4537,13 @@ equivalent to (and can't be distinguished from) scheme vectors. enclosed array is unspecified. examples: - (enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) => - # - (enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) => - # +(enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) => +# + +(enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) => +# + -- Function: array->list array Returns a list consisting of all the elements, in order, of ARRAY. @@ -4406,8 +4562,8 @@ equivalent to (and can't be distinguished from) scheme vectors. in memory.  -File: scm.info, Node: Uniform Array, Next: Bit Vectors, Prev: Conventional Arrays, Up: Arrays - +File: scm-5f2.info, Node: Uniform Array, Next: Bit Vectors, Prev: Conventional Arrays, Up: Arrays + | 5.4.2 Uniform Array ------------------- @@ -4424,7 +4580,7 @@ equivalent to (and can't be distinguished from) strings. (make-array "" 3) => "$q2" Unshared uniform boolean 0-based arrays of rank 1 (dimension) are -equivalent to (and can't be distinguished from) *Note bit-vectors: Bit +equivalent to (and can't be distinguished from) *note bit-vectors: Bit Vectors. (make-array '#1at() 3) => #*000 == @@ -4512,8 +4668,8 @@ returns a uniform vector of signed integers. integer or if VAL is not boolean.  -File: scm.info, Node: Bit Vectors, Next: Array Mapping, Prev: Uniform Array, Up: Arrays - +File: scm-5f2.info, Node: Bit Vectors, Next: Array Mapping, Prev: Uniform Array, Up: Arrays + | 5.4.3 Bit Vectors ----------------- @@ -4537,13 +4693,13 @@ uniform-arrays. Modifies BV by replacing each element with its negation. -- Function: bit-set*! bv uve bool - If uve is a bit-vector BV and uve must be of the same length. If - BOOL is `#t', uve is OR'ed into BV; If BOOL is `#f', the inversion - of uve is AND'ed into BV. + If UVE is a bit-vector, then BV and UVE must be of the same | + length. If BOOL is `#t', then UVE is OR'ed into BV; If BOOL is | + `#f', the inversion of UVE is AND'ed into BV. | - If uve is a unsigned integer vector all the elements of uve must be - between 0 and the `LENGTH' of BV. The bits of BV corresponding to - the indexes in uve are set to BOOL. + If UVE is a unsigned integer vector, then all the elements of UVE | + must be between 0 and the `LENGTH' of BV. The bits of BV | + corresponding to the indexes in UVE are set to BOOL. | The return value is unspecified. @@ -4553,8 +4709,8 @@ uniform-arrays. BV is not modified.  -File: scm.info, Node: Array Mapping, Prev: Bit Vectors, Up: Arrays - +File: scm-5f2.info, Node: Array Mapping, Prev: Bit Vectors, Up: Arrays + | 5.4.4 Array Mapping ------------------- @@ -4587,7 +4743,7 @@ SCM has some extra functions in feature `array-for-each': value returned is unspecified. The order of application is unspecified. - Handling non-array arguments is a SCM extension of *Note + Handling non-array arguments is a SCM extension of *note array-map!: (slib)Array Mapping. -- Function: serial-array-map! array0 proc array1 ... @@ -4613,8 +4769,8 @@ SCM has some extra functions in feature `array-for-each': `array-map!' and friends to handle scalar arguments.  -File: scm.info, Node: Records, Next: I/O-Extensions, Prev: Arrays, Up: Packages - +File: scm-5f2.info, Node: Records, Next: I/O-Extensions, Prev: Arrays, Up: Packages + | 5.5 Records =========== @@ -4635,12 +4791,12 @@ see *Note Records: (slib)Records, with the following extension. Only the default printer will be used when printing error messages.  -File: scm.info, Node: I/O-Extensions, Next: Posix Extensions, Prev: Records, Up: Packages - +File: scm-5f2.info, Node: I/O-Extensions, Next: Posix Extensions, Prev: Records, Up: Packages + | 5.6 I/O-Extensions ================== -If `'i/o-extensions' is provided (by linking in `ioext.o'), *Note Line +If `'i/o-extensions' is provided (by linking in `ioext.o'), *note Line I/O: (slib)Line I/O, and the following functions are defined: -- Function: stat @@ -4703,7 +4859,7 @@ I/O: (slib)Line I/O, and the following functions are defined: -- Function: duplicate-port port modes Creates and returns a "duplicate" port from PORT. Duplicate _unbuffered_ ports share one file position. MODES are as for - *Note open-file: Files and Ports. + *note open-file: Files and Ports. -- Function: redirect-port! from-port to-port Closes TO-PORT and makes TO-PORT be a duplicate of FROM-PORT. @@ -4751,7 +4907,16 @@ I/O: (slib)Line I/O, and the following functions are defined: "Link.scm" "Macro.scm" "Transcen.scm" - "Init5e5.scm" | + "Init5f1.scm" | + | + -- Function: directory*-for-each proc path-glob | + PATH-GLOB is a pathname whose last component is a (wildcard) | + pattern (*note Filenames: (slib)Filenames.). PROC must be a | + procedure taking one argument. `directory*-for-each' applies PROC | + to the (string) name of each file in the current directory. The | + dynamic order in which PROC is applied to the filenames is | + unspecified. The value returned by `directory*-for-each' is | + unspecified. | -- Function: mkdir path mode The `mkdir' function creates a new, empty directory whose name is @@ -4782,6 +4947,11 @@ I/O: (slib)Line I/O, and the following functions are defined: renaming is successful, `#t' is returned. Otherwise, `#f' is returned. + -- Function: copy-file oldfilename newfilename | + Copies the file specified by OLDFILENAME to NEWFILENAME. If the | + copying is successful, `#t' is returned. Otherwise, `#f' is | + returned. | + | -- Function: chmod file mode The function `chmod' sets the access permission bits for the file named by FILE to MODE. The FILE argument may be a string @@ -4864,8 +5034,8 @@ I/O: (slib)Line I/O, and the following functions are defined: (slib)System Interface.).  -File: scm.info, Node: Posix Extensions, Next: Unix Extensions, Prev: I/O-Extensions, Up: Packages - +File: scm-5f2.info, Node: Posix Extensions, Next: Unix Extensions, Prev: I/O-Extensions, Up: Packages + | 5.7 Posix Extensions ==================== @@ -4950,7 +5120,7 @@ Persona. -- Function: kill pid sig The `kill' function sends the signal SIGNUM to the process or process group specified by PID. Besides the signals listed in - *Note Standard Signals: (libc)Standard Signals, SIGNUM can also + *note Standard Signals: (libc)Standard Signals, SIGNUM can also have a value of zero to check the validity of the PID. The PID specifies the process or process group to receive the @@ -5130,8 +5300,8 @@ Persona. `#f'.  -File: scm.info, Node: Unix Extensions, Next: Sequence Comparison, Prev: Posix Extensions, Up: Packages - +File: scm-5f2.info, Node: Unix Extensions, Next: Sequence Comparison, Prev: Posix Extensions, Up: Packages + | 5.8 Unix Extensions =================== @@ -5184,8 +5354,8 @@ These "privileged" and symbolic link functions are not in Posix: actual writing is done. The value returned is unspecified.  -File: scm.info, Node: Sequence Comparison, Next: Regular Expression Pattern Matching, Prev: Unix Extensions, Up: Packages - +File: scm-5f2.info, Node: Sequence Comparison, Next: Regular Expression Pattern Matching, Prev: Unix Extensions, Up: Packages + | 5.9 Sequence Comparison ======================= @@ -5195,8 +5365,8 @@ A blazing fast implementation of the sequence-comparison module in SLIB, see *Note Sequence Comparison: (slib)Sequence Comparison.  -File: scm.info, Node: Regular Expression Pattern Matching, Next: Line Editing, Prev: Sequence Comparison, Up: Packages - +File: scm-5f2.info, Node: Regular Expression Pattern Matching, Next: Line Editing, Prev: Sequence Comparison, Up: Packages + | 5.10 Regular Expression Pattern Matching ======================================== @@ -5311,11 +5481,13 @@ description of regular expressions, *Note syntax: (regex)syntax. to perform one substitution.  -File: scm.info, Node: Line Editing, Next: Curses, Prev: Regular Expression Pattern Matching, Up: Packages - +File: scm-5f2.info, Node: Line Editing, Next: Curses, Prev: Regular Expression Pattern Matching, Up: Packages + | 5.11 Line Editing ================= +`(require 'edit-line)' + These procedures provide input line editing and recall. These functions are defined in `edline.c' and `Iedline.scm' using the @@ -5326,9 +5498,9 @@ available from: * `ftp.gnu.org:/pub/gnu/readline-2.0.tar.gz' -When `Iedline.scm' is loaded, if the current input port is the default -input port and the environment variable EMACS is not defined, -line-editing mode will be entered. +When `edit-line' package is initialized, if the current input port is +the default input port and the environment variable EMACS is not +defined, line-editing mode will be entered. -- Function: default-input-port Returns the initial `current-input-port' SCM was invoked with @@ -5352,8 +5524,8 @@ line-editing mode will be entered. previous value of `(line-editing)'.  -File: scm.info, Node: Curses, Next: Sockets, Prev: Line Editing, Up: Packages - +File: scm-5f2.info, Node: Curses, Next: Sockets, Prev: Line Editing, Up: Packages + | 5.12 Curses =========== @@ -5370,7 +5542,7 @@ completion and `#f' for failure. curses mode temporarily, to do a system call, for example. This routine will restore termio modes, move the cursor to the lower left corner of the screen and reset the terminal into the proper - non-visual mode. To resume after a temporary escape, call *Note + non-visual mode. To resume after a temporary escape, call *note refresh: Window Manipulation. * Menu: @@ -5383,8 +5555,8 @@ completion and `#f' for failure. * Curses Miscellany::  -File: scm.info, Node: Output Options Setting, Next: Terminal Mode Setting, Prev: Curses, Up: Curses - +File: scm-5f2.info, Node: Output Options Setting, Next: Terminal Mode Setting, Prev: Curses, Up: Curses + | 5.12.1 Output Options Setting ----------------------------- @@ -5440,8 +5612,8 @@ necessary to turn these options off before calling `endwin'. will hang until a key is pressed.  -File: scm.info, Node: Terminal Mode Setting, Next: Window Manipulation, Prev: Output Options Setting, Up: Curses - +File: scm-5f2.info, Node: Terminal Mode Setting, Next: Window Manipulation, Prev: Output Options Setting, Up: Curses + | 5.12.2 Terminal Mode Setting ---------------------------- @@ -5504,8 +5676,8 @@ routines. It is not necessary to turn these options off before calling `savetty'.  -File: scm.info, Node: Window Manipulation, Next: Output, Prev: Terminal Mode Setting, Up: Curses - +File: scm-5f2.info, Node: Window Manipulation, Next: Output, Prev: Terminal Mode Setting, Up: Curses + | 5.12.3 Window Manipulation -------------------------- @@ -5575,8 +5747,8 @@ File: scm.info, Node: Window Manipulation, Next: Output, Prev: Terminal Mode which is (0, 0).  -File: scm.info, Node: Output, Next: Input, Prev: Window Manipulation, Up: Curses - +File: scm-5f2.info, Node: Output, Next: Input, Prev: Window Manipulation, Up: Curses + | 5.12.4 Output ------------- @@ -5615,7 +5787,7 @@ These routines are used to "draw" text on windows This routine copies blanks to every position in the window WIN. -- Function: wclear win - This routine is like `werase', but it also calls *Note clearok: + This routine is like `werase', but it also calls *note clearok: Output Options Setting, arranging that the screen will be cleared completely on the next call to `refresh' or `force-output' for window WIN, and repainted from scratch. @@ -5659,8 +5831,8 @@ These routines are used to "draw" text on windows screen will be scrolled at the same time.  -File: scm.info, Node: Input, Next: Curses Miscellany, Prev: Output, Up: Curses - +File: scm-5f2.info, Node: Input, Next: Curses Miscellany, Prev: Output, Up: Curses + | 5.12.5 Input ------------ @@ -5686,8 +5858,8 @@ File: scm.info, Node: Input, Next: Curses Miscellany, Prev: Output, Up: Curs window WIN is returned  -File: scm.info, Node: Curses Miscellany, Prev: Input, Up: Curses - +File: scm-5f2.info, Node: Curses Miscellany, Prev: Input, Up: Curses + | 5.12.6 Curses Miscellany ------------------------ @@ -5721,8 +5893,8 @@ File: scm.info, Node: Curses Miscellany, Prev: Input, Up: Curses as is.  -File: scm.info, Node: Sockets, Next: SCMDB, Prev: Curses, Up: Packages - +File: scm-5f2.info, Node: Sockets, Next: SCMDB, Prev: Curses, Up: Packages + | 5.13 Sockets ============ @@ -5737,8 +5909,8 @@ Sockets: (libc)Sockets. * Socket::  -File: scm.info, Node: Host and Other Inquiries, Next: Internet Addresses and Socket Names, Prev: Sockets, Up: Sockets - +File: scm-5f2.info, Node: Host and Other Inquiries, Next: Internet Addresses and Socket Names, Prev: Sockets, Up: Sockets + | 5.13.1 Host and Other Inquiries ------------------------------- @@ -5830,8 +6002,8 @@ File: scm.info, Node: Host and Other Inquiries, Next: Internet Addresses and S When called without an argument, the service table is closed.  -File: scm.info, Node: Internet Addresses and Socket Names, Next: Socket, Prev: Host and Other Inquiries, Up: Sockets - +File: scm-5f2.info, Node: Internet Addresses and Socket Names, Next: Socket, Prev: Host and Other Inquiries, Up: Sockets + | 5.13.2 Internet Addresses and Socket Names ------------------------------------------ @@ -5875,8 +6047,8 @@ following procedures: Returns the integer Internet address for SOCKET-NAME.  -File: scm.info, Node: Socket, Prev: Internet Addresses and Socket Names, Up: Sockets - +File: scm-5f2.info, Node: Socket, Prev: Internet Addresses and Socket Names, Up: Sockets + | 5.13.3 Socket ------------- @@ -6034,8 +6206,8 @@ you can use a client written in scheme: (newline)))  -File: scm.info, Node: SCMDB, Prev: Sockets, Up: Packages - +File: scm-5f2.info, Node: SCMDB, Prev: Sockets, Up: Packages + | 5.14 SCMDB ========== @@ -6046,8 +6218,8 @@ File: scm.info, Node: SCMDB, Prev: Sockets, Up: Packages It is available from: `http://www.dedecker.net/jessie/scmdb/'  -File: scm.info, Node: The Implementation, Next: Index, Prev: Packages, Up: Top - +File: scm-5f2.info, Node: The Implementation, Next: Index, Prev: Packages, Up: Top + | 6 The Implementation ******************** @@ -6059,8 +6231,8 @@ File: scm.info, Node: The Implementation, Next: Index, Prev: Packages, Up: T * Improvements To Make::  -File: scm.info, Node: Data Types, Next: Operations, Prev: The Implementation, Up: The Implementation - +File: scm-5f2.info, Node: Data Types, Next: Operations, Prev: The Implementation, Up: The Implementation + | 6.1 Data Types ============== @@ -6078,13 +6250,16 @@ basic flavors, Immediates and Cells: * Cells:: Non-Immediate types * Header Cells:: Malloc objects * Subr Cells:: Built-in and Compiled Procedures +* Defining Subrs:: * Ptob Cells:: I/O ports +* Defining Ptobs:: * Smob Cells:: Miscellaneous datatypes +* Defining Smobs:: * Data Type Representations:: How they all fit together  -File: scm.info, Node: Immediates, Next: Cells, Prev: Data Types, Up: Data Types - +File: scm-5f2.info, Node: Immediates, Next: Cells, Prev: Data Types, Up: Data Types + | 6.1.1 Immediates ---------------- @@ -6222,8 +6397,8 @@ A "CAR Immediate" is an Immediate point which can only occur in the `CAR's of evaluated code (as a result of `ceval''s memoization process).  -File: scm.info, Node: Cells, Next: Header Cells, Prev: Immediates, Up: Data Types - +File: scm-5f2.info, Node: Cells, Next: Header Cells, Prev: Immediates, Up: Data Types + | 6.1.2 Cells ----------- @@ -6283,8 +6458,8 @@ is of type `SCM' and points to a cell (`CELLPTR').  -File: scm.info, Node: Header Cells, Next: Subr Cells, Prev: Cells, Up: Data Types - +File: scm-5f2.info, Node: Header Cells, Next: Subr Cells, Prev: Cells, Up: Data Types + | 6.1.3 Header Cells ------------------ @@ -6395,8 +6570,8 @@ memory allocated by `malloc'. Expands to the length of CCLO.  -File: scm.info, Node: Subr Cells, Next: Ptob Cells, Prev: Header Cells, Up: Data Types - +File: scm-5f2.info, Node: Subr Cells, Next: Defining Subrs, Prev: Header Cells, Up: Data Types + | 6.1.4 Subr Cells ---------------- @@ -6460,9 +6635,63 @@ type `SCM'. C function of list of `SCM' arguments.  -File: scm.info, Node: Ptob Cells, Next: Smob Cells, Prev: Subr Cells, Up: Data Types - -6.1.5 Ptob Cells +File: scm-5f2.info, Node: Defining Subrs, Next: Ptob Cells, Prev: Subr Cells, Up: Data Types + | +6.1.5 Defining Subrs | +-------------------- | + | +If "CCLO" is `#define'd when compiling, the compiled closure feature | +will be enabled. It is automatically enabled if dynamic linking is | +enabled. | + | +The SCM interpreter directly recognizes subrs taking small numbers of | +arguments. In order to create subrs taking larger numbers of arguments | +use: | + | + -- Function: make_gsubr name req opt rest fcn | + returns a cclo (compiled closure) object of name `char *' NAME | + which takes `int' REQ required arguments, `int' OPT optional | + arguments, and a list of rest arguments if `int' REST is 1 (0 for | + not). | + | + `SCM (*fcn)()' is a pointer to a C function to do the work. | + | + The C function will always be called with REQ + OPT + REST | + arguments, optional arguments not supplied will be passed | + `UNDEFINED'. An error will be signaled if the subr is called with | + too many or too few arguments. Currently a total of 10 arguments | + may be specified, but increasing this limit should not be | + difficult. | + | + /* A silly example, taking 2 required args, | + 1 optional, and a list of rest args */ | + | + #include | + | + SCM gsubr_21l(req1,req2,opt,rst) | + SCM req1,req2,opt,rst; | + { | + lputs("gsubr-2-1-l:\n req1: ", cur_outp); | + display(req1,cur_outp); | + lputs("\n req2: ", cur_outp); | + display(req2,cur_outp); | + lputs("\n opt: ", cur_outp); | + display(opt,cur_outp); | + lputs("\n rest: ", cur_outp); | + display(rst,cur_outp); | + newline(cur_outp); | + return UNSPECIFIED; | + } | + | + void init_gsubr211() | + { | + make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); | + } | + | + +File: scm-5f2.info, Node: Ptob Cells, Next: Defining Ptobs, Prev: Defining Subrs, Up: Data Types + | +6.1.6 Ptob Cells | ---------------- A "ptob" is a port object, capable of delivering or accepting characters. @@ -6519,9 +6748,40 @@ for fports. open output-port, respectively.  -File: scm.info, Node: Smob Cells, Next: Data Type Representations, Prev: Ptob Cells, Up: Data Types - -6.1.6 Smob Cells +File: scm-5f2.info, Node: Defining Ptobs, Next: Smob Cells, Prev: Ptob Cells, Up: Data Types + | +6.1.7 Defining Ptobs | +-------------------- | + | +"ptob"s are similar to smobs but define new types of port to which SCM | +procedures can read or write. The following functions are defined in | +the `ptobfuns': | + | + typedef struct { | + SCM (*mark)P((SCM ptr)); | + int (*free)P((FILE *p)); | + int (*print)P((SCM exp, SCM port, int writing)); | + SCM (*equalp)P((SCM, SCM)); | + int (*fputc)P((int c, FILE *p)); | + int (*fputs)P((char *s, FILE *p)); | + sizet (*fwrite)P((char *s, sizet siz, sizet num, FILE *p)); | + int (*fflush)P((FILE *stream)); | + int (*fgetc)P((FILE *p)); | + int (*fclose)P((FILE *p)); | + } ptobfuns; | + | +The `.free' component to the structure takes a `FILE *' or other C | +construct as its argument, unlike `.free' in a smob, which takes the | +whole smob cell. Often, `.free' and `.fclose' can be the same | +function. See `fptob' and `pipob' in `sys.c' for examples of how to | +define ptobs. Ptobs that must allocate blocks of memory should use, | +for example, `must_malloc' rather than `malloc' *Note Allocating +memory::. | + | + +File: scm-5f2.info, Node: Smob Cells, Next: Defining Smobs, Prev: Defining Ptobs, Up: Data Types + | +6.1.8 Smob Cells | ---------------- A "smob" is a miscellaneous datatype. The type code and GCMARK bit occupy @@ -6609,10 +6869,84 @@ Defining Smobs::). These are the initial smobs: `CDR'.  -File: scm.info, Node: Data Type Representations, Prev: Smob Cells, Up: Data Types - -6.1.7 Data Type Representations -------------------------------- +File: scm-5f2.info, Node: Defining Smobs, Next: Data Type Representations, Prev: Smob Cells, Up: Data Types + | +6.1.9 Defining Smobs | +-------------------- | + | +Here is an example of how to add a new type named `foo' to SCM. The | +following lines need to be added to your code: | + | +`long tc16_foo;' | + The type code which will be used to identify the new type. | + | +`static smobfuns foosmob = {markfoo,freefoo,printfoo,equalpfoo};' | + smobfuns is a structure composed of 4 functions: | + | + typedef struct { | + SCM (*mark)P((SCM)); | + sizet (*free)P((CELLPTR)); | + int (*print)P((SCM exp, SCM port, int writing)); | + SCM (*equalp)P((SCM, SCM)); | + } smobfuns; | + | + `smob.mark' | + is a function of one argument of type `SCM' (the cell to | + mark) and returns type `SCM' which will then be marked. If | + no further objects need to be marked then return an immediate | + object such as `BOOL_F'. The smob cell itself will already | + have been marked. _Note_ This is different from SCM versions | + prior to 5c5. Only additional data specific to a smob type | + need be marked by `smob.mark'. | + | + 2 functions are provided: | + | + `markcdr(ptr)' | + returns `CDR(ptr)'. | + | + `mark0(ptr)' | + is a no-op used for smobs containing no additional `SCM' | + data. 0 may also be used in this case. | + | + `smob.free' | + is a function of one argument of type `CELLPTR' (the cell to | + collected) and returns type `sizet' which is the number of | + `malloc'ed bytes which were freed. `Smob.free' should free | + any `malloc'ed storage associated with this object. The | + function free0(ptr) is provided which does not free any | + storage and returns 0. | + | + `smob.print' | + is 0 or a function of 3 arguments. The first, of type `SCM', | + is the smob object. The second, of type `SCM', is the stream | + on which to write the result. The third, of type int, is 1 | + if the object should be `write'n, 0 if it should be | + `display'ed, and 2 if it should be `write'n for an error | + report. This function should return non-zero if it printed, | + and zero otherwise (in which case a hexadecimal number will | + be printed). | + | + `smob.equalp' | + is 0 or a function of 2 `SCM' arguments. Both of these | + arguments will be of type `tc16foo'. This function should | + return `BOOL_T' if the smobs are equal, `BOOL_F' if they are | + not. If `smob.equalp' is 0, `equal?' will return `BOOL_F' if | + they are not `eq?'. | + | +`tc16_foo = newsmob(&foosmob);' | + Allocates the new type with the functions from `foosmob'. This | + line goes in an `init_' routine. | + | +Promises and macros in `eval.c' and arbiters in `repl.c' provide | +examples of SMOBs. There are a maximum of 256 SMOBs. Smobs that must | +allocate blocks of memory should use, for example, `must_malloc' rather | +than `malloc' *Note Allocating memory::. | + | + +File: scm-5f2.info, Node: Data Type Representations, Prev: Defining Smobs, Up: Data Types + | +6.1.10 Data Type Representations | +-------------------------------- | IMMEDIATE: B,D,E,F=data bit, C=flag code, P=pointer address bit ................................ @@ -6636,20 +6970,20 @@ ssymbol .........long length....G0000101 ..........char *chars........... msymbol .........long length....G0000111 ..........char *chars........... string .........long length....G0001101 ..........char *chars........... vector .........long length....G0001111 ...........SCM **elts........... -Vbool .........long length....G0010101 ..........long *words........... - spare 00010111 -VfixN8 .........long length....G0011101 ......unsigned char *words...... -VfixZ8 .........long length....G0011111 ..........char *words........... -VfixN16 .........long length....G0100101 ......unsigned short *words..... -VfixZ16 .........long length....G0100111 ........ short *words........... -VfixN32 .........long length....G0101101 ......unsigned long *words...... -VfixZ32 .........long length....G0101111 ..........long *words........... +VfixN8 .........long length....G0010101 ......unsigned char *words...... | +VfixZ8 .........long length....G0010111 ..........char *words........... | +VfixN16 .........long length....G0011101 ......unsigned short *words..... | +VfixZ16 .........long length....G0011111 ........ short *words........... | +VfixN32 .........long length....G0100101 ......unsigned medium *words.... | +VfixZ32 .........long length....G0100111 ........medium *words........... | +VfixN64 .........long length....G0101101 ......unsigned long *words...... | +VfixZ64 .........long length....G0101111 ..........long *words........... | VfloR32 .........long length....G0110101 .........float *words........... VfloC32 .........long length....G0110111 .........float *words........... VfloR64 .........long length....G0111101 ........double *words........... VfloC64 .........long length....G0111111 ........double *words........... - spare 01000101 +Vbool .........long length....G1000101 ..........long *words........... | contin .........long length....G1001101 .............*regs.............. specfun ................xxxxxxxxG1001111 ...........SCM name............. cclo ..short length..xxxxxx10G1001111 ...........SCM **elts........... @@ -6691,8 +7025,8 @@ macro 000000000000000mxxxxxxxxG1111111 ...........SCM name............. array ...short rank..cxxxxxxxxG1111111 ............*array..............  -File: scm.info, Node: Operations, Next: Program Self-Knowledge, Prev: Data Types, Up: The Implementation - +File: scm-5f2.info, Node: Operations, Next: Program Self-Knowledge, Prev: Data Types, Up: The Implementation + | 6.2 Operations ============== @@ -6700,12 +7034,12 @@ File: scm.info, Node: Operations, Next: Program Self-Knowledge, Prev: Data Ty * Garbage Collection:: Automatically reclaims unused storage * Memory Management for Environments:: +* Dynamic Linking Support:: +* Configure Module Catalog:: +* Automatic C Preprocessor Definitions:: * Signals:: * C Macros:: * Changing Scm:: -* Defining Subrs:: -* Defining Smobs:: -* Defining Ptobs:: * Allocating memory:: * Embedding SCM:: In other programs * Callbacks:: @@ -6714,8 +7048,8 @@ File: scm.info, Node: Operations, Next: Program Self-Knowledge, Prev: Data Ty * Evaluation:: Why SCM is fast  -File: scm.info, Node: Garbage Collection, Next: Memory Management for Environments, Prev: Operations, Up: Operations - +File: scm-5f2.info, Node: Garbage Collection, Next: Memory Management for Environments, Prev: Operations, Up: Operations + | 6.2.1 Garbage Collection ------------------------ @@ -6734,8 +7068,8 @@ heap. * Sweeping the Heap::  -File: scm.info, Node: Marking Cells, Next: Sweeping the Heap, Prev: Garbage Collection, Up: Garbage Collection - +File: scm-5f2.info, Node: Marking Cells, Next: Sweeping the Heap, Prev: Garbage Collection, Up: Garbage Collection + | 6.2.1.1 Marking Cells ..................... @@ -6780,8 +7114,8 @@ symbols, "symhash". practice and the advantage of using the c-stack far outweighs it.  -File: scm.info, Node: Sweeping the Heap, Prev: Marking Cells, Up: Garbage Collection - +File: scm-5f2.info, Node: Sweeping the Heap, Prev: Marking Cells, Up: Garbage Collection + | 6.2.1.2 Sweeping the Heap ......................... @@ -6804,8 +7138,8 @@ collected. the smob's `free' procedure is called to free its storage.  -File: scm.info, Node: Memory Management for Environments, Next: Signals, Prev: Garbage Collection, Up: Operations - +File: scm-5f2.info, Node: Memory Management for Environments, Next: Dynamic Linking Support, Prev: Garbage Collection, Up: Operations + | 6.2.2 Memory Management for Environments ---------------------------------------- @@ -6904,9 +7238,195 @@ into garbage collection techniques about which a considerable amount of literature is available.  -File: scm.info, Node: Signals, Next: C Macros, Prev: Memory Management for Environments, Up: Operations - -6.2.3 Signals +File: scm-5f2.info, Node: Dynamic Linking Support, Next: Configure Module Catalog, Prev: Memory Management for Environments, Up: Operations + | +6.2.3 Dynamic Linking Support | +----------------------------- | + | +Dynamic linking has not been ported to all platforms. Operating systems | +in the BSD family (a.out binary format) can usually be ported to "DLD". | +The "dl" library (`#define SUN_DL' for SCM) was a proposed POSIX | +standard and may be available on other machines with "COFF" binary | +format. For notes about porting to MS-Windows and finishing the port | +to VMS *note VMS Dynamic Linking::. | + | +"DLD" is a library package of C functions that performs "dynamic link | +editing" on GNU/Linux, VAX (Ultrix), Sun 3 (SunOS 3.4 and 4.0), | +SPARCstation (SunOS 4.0), Sequent Symmetry (Dynix), and Atari ST. It | +is available from: | + | + * ftp.gnu.org:pub/gnu/dld-3.3.tar.gz | + | +These notes about using libdl on SunOS are from `gcc.info': | + | + On a Sun, linking using GNU CC fails to find a shared library and | + reports that the library doesn't exist at all. | + | + This happens if you are using the GNU linker, because it does only | + static linking and looks only for unshared libraries. If you have | + a shared library with no unshared counterpart, the GNU linker | + won't find anything. | + | + We hope to make a linker which supports Sun shared libraries, but | + please don't ask when it will be finished-we don't know. | + | + Sun forgot to include a static version of `libdl.a' with some | + versions of SunOS (mainly 4.1). This results in undefined symbols | + when linking static binaries (that is, if you use `-static'). If | + you see undefined symbols `_dlclose', `_dlsym' or `_dlopen' when | + linking, compile and link against the file `mit/util/misc/dlsym.c' | + from the MIT version of X windows. | + | + +File: scm-5f2.info, Node: Configure Module Catalog, Next: Automatic C Preprocessor Definitions, Prev: Dynamic Linking Support, Up: Operations + | +6.2.4 Configure Module Catalog | +------------------------------ | + | +The SLIB module "catalog" can be extended to define other | +`require'-able packages by adding calls to the Scheme source file | +`mkimpcat.scm'. Within `mkimpcat.scm', the following procedures are | +defined. | + | + -- Function: add-link feature object-file lib1 ... | + FEATURE should be a symbol. OBJECT-FILE should be a string naming | + a file containing compiled "object-code". Each LIBn argument | + should be either a string naming a library file or `#f'. | + | + If OBJECT-FILE exists, the `add-link' procedure registers symbol | + FEATURE so that the first time `require' is called with the symbol | + FEATURE as its argument, OBJECT-FILE and the LIB1 ... are | + dynamically linked into the executing SCM session. | + | + If OBJECT-FILE exists, `add-link' returns `#t', otherwise it | + returns `#f'. | + | + For example, to install a compiled dll `foo', add these lines to | + `mkimpcat.scm': | + | + (add-link 'foo | + (in-vicinity (implementation-vicinity) "foo" | + link:able-suffix)) | + | + | + -- Function: add-alias alias feature | + ALIAS and FEATURE are symbols. The procedure `add-alias' | + registers ALIAS as an alias for FEATURE. An unspecified value is | + returned. | + | + `add-alias' causes `(require 'ALIAS)' to behave like `(require | + 'FEATURE)'. | + | + -- Function: add-source feature filename | + FEATURE is a symbol. FILENAME is a string naming a file | + containing Scheme source code. The procedure `add-source' | + registers FEATURE so that the first time `require' is called with | + the symbol FEATURE as its argument, the file FILENAME will be | + `load'ed. An unspecified value is returned. | + | +Remember to delete the file `slibcat' after modifying the file | +`mkimpcat.scm' in order to force SLIB to rebuild its cache. | + | + +File: scm-5f2.info, Node: Automatic C Preprocessor Definitions, Next: Signals, Prev: Configure Module Catalog, Up: Operations + | +6.2.5 Automatic C Preprocessor Definitions | +------------------------------------------ | + | +These `#defines' are automatically provided by preprocessors of various | +C compilers. SCM uses the presence or absence of these definitions to | +configure "include file" locations and aliases for library functions. | +If the definition(s) corresponding to your system type is missing as | +your system is configured, add `-DFLAG' to the compilation command | +lines or add a `#define FLAG' line to `scmfig.h' or the beginning of | +`scmfig.h'. | + | + #define Platforms: | + ------- ---------- | + ARM_ULIB Huw Rogers free unix library for acorn archimedes | + AZTEC_C Aztec_C 5.2a | + __CYGWIN__ Cygwin | + __CYGWIN32__ Cygwin | + _DCC Dice C on AMIGA | + __GNUC__ Gnu CC (and DJGPP) | + __EMX__ Gnu C port (gcc/emx 0.8e) to OS/2 2.0 | + __HIGHC__ MetaWare High C | + __IBMC__ C-Set++ on OS/2 2.1 | + _MSC_VER MS VisualC++ 4.2 | + MWC Mark Williams C on COHERENT | + __MWERKS__ Metrowerks Compiler; Macintosh and WIN32 (?) | + _POSIX_SOURCE ?? | + _QC Microsoft QuickC | + __STDC__ ANSI C compliant | + __TURBOC__ Turbo C and Borland C | + __USE_POSIX ?? | + __WATCOMC__ Watcom C on MS-DOS | + __ZTC__ Zortech C | + | + _AIX AIX operating system | + __APPLE__ Apple Darwin | + AMIGA SAS/C 5.10 or Dice C on AMIGA | + __amigaos__ Gnu CC on AMIGA | + atarist ATARI-ST under Gnu CC | + __DragonflyBSD__ DragonflyBSD | + __FreeBSD__ FreeBSD | + GNUDOS DJGPP (obsolete in version 1.08) | + __GO32__ DJGPP (future?) | + hpux HP-UX | + linux GNU/Linux | + macintosh Macintosh (THINK_C and __MWERKS__ define) | + MCH_AMIGA Aztec_c 5.2a on AMIGA | + __MACH__ Apple Darwin | + __MINGW32__ MinGW - Minimalist GNU for Windows | + MSDOS Microsoft C 5.10 and 6.00A | + _MSDOS Microsoft CLARM and CLTHUMB compilers. | + __MSDOS__ Turbo C, Borland C, and DJGPP | + __NetBSD__ NetBSD | + nosve Control Data NOS/VE | + __OpenBSD__ OpenBSD | + SVR2 System V Revision 2. | + sun SunOS | + __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 and Cygwin (Win32 API) | + _WIN32_WCE MS Windows CE | + vms (and VMS) VAX-11 C under VMS. | + | + __alpha DEC Alpha processor | + __alpha__ DEC Alpha processor | + __hppa__ HP RISC processor | + hp9000s800 HP RISC processor | + __ia64 GCC on IA64 | + __ia64__ GCC on IA64 | + _LONGLONG GCC on IA64 | + __i386__ DJGPP | + i386 DJGPP | + _M_ARM Microsoft CLARM compiler defines as 4 for ARM. | + _M_ARMT Microsoft CLTHUMB compiler defines as 4 for Thumb. | + MULTIMAX Encore computer | + ppc PowerPC | + __ppc__ PowerPC | + pyr Pyramid 9810 processor | + __sgi__ Silicon Graphics Inc. | + sparc SPARC processor | + sequent Sequent computer | + tahoe CCI Tahoe processor | + vax VAX processor | + __x86_64 AMD Opteron | + | + +File: scm-5f2.info, Node: Signals, Next: C Macros, Prev: Automatic C Preprocessor Definitions, Up: Operations + | +6.2.6 Signals | ------------- -- Function: init_signals @@ -6945,9 +7465,9 @@ macros `DEFER_INTS' and `ALLOW_INTS'. `scmfig.h'.  -File: scm.info, Node: C Macros, Next: Changing Scm, Prev: Signals, Up: Operations - -6.2.4 C Macros +File: scm-5f2.info, Node: C Macros, Next: Changing Scm, Prev: Signals, Up: Operations + | +6.2.7 C Macros | -------------- -- Macro: ASRTER cond arg pos subr @@ -7000,9 +7520,9 @@ File: scm.info, Node: C Macros, Next: Changing Scm, Prev: Signals, Up: Opera `ASRTGO' does is not active if the flag `RECKLESS' is defined.  -File: scm.info, Node: Changing Scm, Next: Defining Subrs, Prev: C Macros, Up: Operations - -6.2.5 Changing Scm +File: scm-5f2.info, Node: Changing Scm, Next: Allocating memory, Prev: C Macros, Up: Operations + | +6.2.8 Changing Scm | ------------------ When writing C-code for SCM, a precaution is recommended. If your @@ -7095,7 +7615,7 @@ To add a package of new procedures to scm (see `crs.c' for example): 7. put any scheme code which needs to be run as part of your package into `Ifoo.scm'. - 8. put an `if' into `Init5e5.scm' which loads `Ifoo.scm' if your | + 8. put an `if' into `Init5f1.scm' which loads `Ifoo.scm' if your | package is included: (if (defined? twiddle-bits!) @@ -7130,167 +7650,8 @@ New syntax can now be added without recompiling SCM by the use of the and `defmacro'. For details, *Note Syntax::.  -File: scm.info, Node: Defining Subrs, Next: Defining Smobs, Prev: Changing Scm, Up: Operations - -6.2.6 Defining Subrs --------------------- - -If "CCLO" is `#define'd when compiling, the compiled closure feature -will be enabled. It is automatically enabled if dynamic linking is -enabled. - -The SCM interpreter directly recognizes subrs taking small numbers of -arguments. In order to create subrs taking larger numbers of arguments -use: - - -- Function: make_gsubr name req opt rest fcn - returns a cclo (compiled closure) object of name `char *' NAME - which takes `int' REQ required arguments, `int' OPT optional - arguments, and a list of rest arguments if `int' REST is 1 (0 for - not). - - `SCM (*fcn)()' is a pointer to a C function to do the work. - - The C function will always be called with REQ + OPT + REST - arguments, optional arguments not supplied will be passed - `UNDEFINED'. An error will be signaled if the subr is called with - too many or too few arguments. Currently a total of 10 arguments - may be specified, but increasing this limit should not be - difficult. - - /* A silly example, taking 2 required args, - 1 optional, and a list of rest args */ - - #include - - SCM gsubr_21l(req1,req2,opt,rst) - SCM req1,req2,opt,rst; - { - lputs("gsubr-2-1-l:\n req1: ", cur_outp); - display(req1,cur_outp); - lputs("\n req2: ", cur_outp); - display(req2,cur_outp); - lputs("\n opt: ", cur_outp); - display(opt,cur_outp); - lputs("\n rest: ", cur_outp); - display(rst,cur_outp); - newline(cur_outp); - return UNSPECIFIED; - } - - void init_gsubr211() - { - make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); - } - - -File: scm.info, Node: Defining Smobs, Next: Defining Ptobs, Prev: Defining Subrs, Up: Operations - -6.2.7 Defining Smobs --------------------- - -Here is an example of how to add a new type named `foo' to SCM. The -following lines need to be added to your code: - -`long tc16_foo;' - The type code which will be used to identify the new type. - -`static smobfuns foosmob = {markfoo,freefoo,printfoo,equalpfoo};' - smobfuns is a structure composed of 4 functions: - - typedef struct { - SCM (*mark)P((SCM)); - sizet (*free)P((CELLPTR)); - int (*print)P((SCM exp, SCM port, int writing)); - SCM (*equalp)P((SCM, SCM)); - } smobfuns; - - `smob.mark' - is a function of one argument of type `SCM' (the cell to - mark) and returns type `SCM' which will then be marked. If - no further objects need to be marked then return an immediate - object such as `BOOL_F'. The smob cell itself will already - have been marked. _Note_ This is different from SCM versions - prior to 5c5. Only additional data specific to a smob type - need be marked by `smob.mark'. - - 2 functions are provided: - - `markcdr(ptr)' - returns `CDR(ptr)'. - - `mark0(ptr)' - is a no-op used for smobs containing no additional `SCM' - data. 0 may also be used in this case. - - `smob.free' - is a function of one argument of type `CELLPTR' (the cell to - collected) and returns type `sizet' which is the number of - `malloc'ed bytes which were freed. `Smob.free' should free - any `malloc'ed storage associated with this object. The - function free0(ptr) is provided which does not free any - storage and returns 0. - - `smob.print' - is 0 or a function of 3 arguments. The first, of type `SCM', - is the smob object. The second, of type `SCM', is the stream - on which to write the result. The third, of type int, is 1 - if the object should be `write'n, 0 if it should be - `display'ed, and 2 if it should be `write'n for an error - report. This function should return non-zero if it printed, - and zero otherwise (in which case a hexadecimal number will - be printed). - - `smob.equalp' - is 0 or a function of 2 `SCM' arguments. Both of these - arguments will be of type `tc16foo'. This function should - return `BOOL_T' if the smobs are equal, `BOOL_F' if they are - not. If `smob.equalp' is 0, `equal?' will return `BOOL_F' if - they are not `eq?'. - -`tc16_foo = newsmob(&foosmob);' - Allocates the new type with the functions from `foosmob'. This - line goes in an `init_' routine. - -Promises and macros in `eval.c' and arbiters in `repl.c' provide -examples of SMOBs. There are a maximum of 256 SMOBs. Smobs that must -allocate blocks of memory should use, for example, `must_malloc' rather -than `malloc' *Note Allocating memory::. - - -File: scm.info, Node: Defining Ptobs, Next: Allocating memory, Prev: Defining Smobs, Up: Operations - -6.2.8 Defining Ptobs --------------------- - -"ptob"s are similar to smobs but define new types of port to which SCM -procedures can read or write. The following functions are defined in -the `ptobfuns': - - typedef struct { - SCM (*mark)P((SCM ptr)); - int (*free)P((FILE *p)); - int (*print)P((SCM exp, SCM port, int writing)); - SCM (*equalp)P((SCM, SCM)); - int (*fputc)P((int c, FILE *p)); - int (*fputs)P((char *s, FILE *p)); - sizet (*fwrite)P((char *s, sizet siz, sizet num, FILE *p)); - int (*fflush)P((FILE *stream)); - int (*fgetc)P((FILE *p)); - int (*fclose)P((FILE *p)); - } ptobfuns; - -The `.free' component to the structure takes a `FILE *' or other C -construct as its argument, unlike `.free' in a smob, which takes the -whole smob cell. Often, `.free' and `.fclose' can be the same -function. See `fptob' and `pipob' in `sys.c' for examples of how to -define ptobs. Ptobs that must allocate blocks of memory should use, -for example, `must_malloc' rather than `malloc' *Note Allocating -memory::. - - -File: scm.info, Node: Allocating memory, Next: Embedding SCM, Prev: Defining Ptobs, Up: Operations - +File: scm-5f2.info, Node: Allocating memory, Next: Embedding SCM, Prev: Changing Scm, Up: Operations + | 6.2.9 Allocating memory ----------------------- @@ -7338,8 +7699,8 @@ must be large enough. instead.  -File: scm.info, Node: Embedding SCM, Next: Callbacks, Prev: Allocating memory, Up: Operations - +File: scm-5f2.info, Node: Embedding SCM, Next: Callbacks, Prev: Allocating memory, Up: Operations + | 6.2.10 Embedding SCM -------------------- @@ -7395,7 +7756,7 @@ SCM, then you can replace `scm_find_implpath'. environment variable is defined, its value will be returned from `scm_find_implpath'. Otherwise find_impl_file() is called with the arguments EXECPATH, GENERIC_NAME (default "scm"), INIT_FILE_NAME - (default "Init5e5_scm"), and the directory separator string | + (default "Init5f1_scm"), and the directory separator string | DIRSEP. If find_impl_file() returns 0 and IMPLINIT is defined, then a copy of the string IMPLINIT is returned. @@ -7406,8 +7767,7 @@ SCM, then you can replace `scm_find_implpath'. Otherwise, 0 is returned. `init_buf0' should be called before any input is read from INPORT. - Its value can be used as the last argument to - scm_init_from_argv(). + Its value can be used as the last argument to scm_init_from_argv(). -- Function: void scm_init_from_argv (int ARGC, char **ARGV, char *SCRIPT_ARG, int IVERBOSE, int BUF0STDIN) @@ -7518,13 +7878,13 @@ Here is a minimal embedding program `libtest.c': -| dld_find_executable(./libtest): /home/jaffer/scm/libtest - implpath: /home/jaffer/scm/Init5e5.scm | + implpath: /home/jaffer/scm/Init5f1.scm | This is libtest_init_user_scm hello world  -File: scm.info, Node: Callbacks, Next: Type Conversions, Prev: Embedding SCM, Up: Operations - +File: scm-5f2.info, Node: Callbacks, Next: Type Conversions, Prev: Embedding SCM, Up: Operations + | 6.2.11 Callbacks ---------------- @@ -7534,7 +7894,7 @@ The source code for these routines are found in `rope.c'. -- Function: int scm_ldfile (char *FILE) Loads the Scheme source file FILE. Returns 0 if successful, non-0 if not. This function is used to load SCM's initialization file - `Init5e5.scm'. | + `Init5f1.scm'. | -- Function: int scm_ldprog (char *FILE) Loads the Scheme source file `(in-vicinity (program-vicinity) @@ -7571,8 +7931,8 @@ can use a wrapper like this for your Scheme procedures: Calls to procedures so wrapped will return even if an error occurs.  -File: scm.info, Node: Type Conversions, Next: Continuations, Prev: Callbacks, Up: Operations - +File: scm-5f2.info, Node: Type Conversions, Next: Continuations, Prev: Callbacks, Up: Operations + | 6.2.12 Type Conversions ----------------------- @@ -7658,15 +8018,15 @@ code. Most are defined in `rope.c'. `makargvfrmstrs'.  -File: scm.info, Node: Continuations, Next: Evaluation, Prev: Type Conversions, Up: Operations - +File: scm-5f2.info, Node: Continuations, Next: Evaluation, Prev: Type Conversions, Up: Operations + | 6.2.13 Continuations -------------------- The source files `continue.h' and `continue.c' are designed to function as an independent resource for programs wishing to use continuations, but without all the rest of the SCM machinery. The concept of -continuations is explained in *Note call-with-current-continuation: +continuations is explained in *note call-with-current-continuation: (r5rs)Control features. The C constructs `jmp_buf', `setjmp', and `longjmp' implement escape @@ -7758,8 +8118,8 @@ conflicts. * `longjump(CONT->jmpbuf, val)';  -File: scm.info, Node: Evaluation, Prev: Continuations, Up: Operations - +File: scm-5f2.info, Node: Evaluation, Prev: Continuations, Up: Operations + | 6.2.14 Evaluation ----------------- @@ -7864,8 +8224,8 @@ then be replaced with an `ILOC' or `GLOC'. not modify `expression'.  -File: scm.info, Node: Program Self-Knowledge, Next: Improvements To Make, Prev: Operations, Up: The Implementation - +File: scm-5f2.info, Node: Program Self-Knowledge, Next: Improvements To Make, Prev: Operations, Up: The Implementation + | 6.3 Program Self-Knowledge ========================== @@ -7876,8 +8236,8 @@ File: scm.info, Node: Program Self-Knowledge, Next: Improvements To Make, Pre * Script Support::  -File: scm.info, Node: File-System Habitat, Next: Executable Pathname, Prev: Program Self-Knowledge, Up: Program Self-Knowledge - +File: scm-5f2.info, Node: File-System Habitat, Next: Executable Pathname, Prev: Program Self-Knowledge, Up: Program Self-Knowledge + | 6.3.1 File-System Habitat ------------------------- @@ -7949,12 +8309,12 @@ needed. `C:\foo\bar.exe' and the initialization file in `C:\foo\bar\'.  -File: scm.info, Node: Executable Pathname, Next: Script Support, Prev: File-System Habitat, Up: Program Self-Knowledge - +File: scm-5f2.info, Node: Executable Pathname, Next: Script Support, Prev: File-System Habitat, Up: Program Self-Knowledge + | 6.3.2 Executable Pathname ------------------------- -For purposes of finding `Init5e5.scm', dumping an executable, and | +For purposes of finding `Init5f1.scm', dumping an executable, and | dynamic linking, a SCM session needs the pathname of its executable image. @@ -7991,12 +8351,12 @@ the full pathname for the associated executable file. any of the directories listed in `PATH'.  -File: scm.info, Node: Script Support, Prev: Executable Pathname, Up: Program Self-Knowledge - +File: scm-5f2.info, Node: Script Support, Prev: Executable Pathname, Up: Program Self-Knowledge + | 6.3.3 Script Support -------------------- -Source code for these C functions is in the file `script.c'. *Note +Source code for these C functions is in the file `script.c'. *note Scripting:: for a description of script argument processing. `script_find_executable' is only defined on unix systems. @@ -8024,8 +8384,8 @@ Scripting:: for a description of script argument processing. Returns the number of argument strings in ARGV.  -File: scm.info, Node: Improvements To Make, Prev: Program Self-Knowledge, Up: The Implementation - +File: scm-5f2.info, Node: Improvements To Make, Prev: Program Self-Knowledge, Up: The Implementation + | 6.4 Improvements To Make ======================== @@ -8077,8 +8437,8 @@ File: scm.info, Node: Improvements To Make, Prev: Program Self-Knowledge, Up: * VMS Dynamic Linking:: Finishing the job.  -File: scm.info, Node: VMS Dynamic Linking, Prev: Improvements To Make, Up: Improvements To Make - +File: scm-5f2.info, Node: VMS Dynamic Linking, Prev: Improvements To Make, Up: Improvements To Make + | 6.4.1 VMS Dynamic Linking ------------------------- @@ -8197,8 +8557,8 @@ with a VMS system needs to finish and debug it. that have been linked against it.  -File: scm.info, Node: Index, Prev: The Implementation, Up: Top - +File: scm-5f2.info, Node: Index, Prev: The Implementation, Up: Top + | Index ***** @@ -8226,7 +8586,7 @@ Procedure and Macro Index (line 7) * #|: Common-Lisp Read Syntax. (line 28) -* $atan2: Numeric. (line 59) +* $atan2: Numeric. (line 70) * -: SCM Options. (line 111) * ---: SCM Options. (line 112) * ---c-source-files=: Build Options. (line 134) @@ -8286,10 +8646,10 @@ Procedure and Macro Index * _ionbf: Opening and Closing. (line 28) * _tracked: Opening and Closing. (line 35) * abort: Internal State. (line 15) -* access: I/O-Extensions. (line 170) +* access: I/O-Extensions. (line 184) * acct: Unix Extensions. (line 34) * acons: Storage. (line 21) -* acosh: Numeric. (line 33) +* acosh: Numeric. (line 43) * add-alias: Configure Module Catalog. (line 33) * add-finalizer: Storage. (line 36) @@ -8303,18 +8663,19 @@ Procedure and Macro Index * alrm_signal: Signals. (line 14) * ARGC: Cells. (line 57) * arithmetic-error: Interrupts. (line 69) -* array->list: Conventional Arrays. (line 60) -* array-contents: Conventional Arrays. (line 64) +* array->list: Conventional Arrays. (line 62) +* array-contents: Conventional Arrays. (line 66) * array-equal?: Array Mapping. (line 18) * array-fill!: Array Mapping. (line 11) * array-map: Array Mapping. (line 43) * array-map!: Array Mapping. (line 25) * array-prototype: Uniform Array. (line 50) * array?: Uniform Array. (line 46) -* asinh: Numeric. (line 32) +* asinh: Numeric. (line 42) * ASRTER: C Macros. (line 7) * ASRTGO: C Macros. (line 52) -* atanh: Numeric. (line 34) +* atan: Numeric. (line 56) +* atanh: Numeric. (line 44) * bit-count: Bit Vectors. (line 15) * bit-count*: Bit Vectors. (line 37) * bit-invert!: Bit Vectors. (line 23) @@ -8337,9 +8698,9 @@ Procedure and Macro Index * char:sharp: Modifying Read Syntax. (line 23) * CHARS: Header Cells. (line 35) -* chdir: I/O-Extensions. (line 134) +* chdir: I/O-Extensions. (line 143) * CHEAP_CONTINUATIONS: Continuations. (line 37) -* chmod: I/O-Extensions. (line 149) +* chmod: I/O-Extensions. (line 163) * chown: Posix Extensions. (line 255) * clearok: Output Options Setting. (line 11) @@ -8353,20 +8714,22 @@ Procedure and Macro Index * comment: Documentation and Comments. (line 23) * CONSP: Cells. (line 35) +* copy-file: I/O-Extensions. (line 158) * copy-tree: Storage. (line 15) -* cosh: Numeric. (line 28) +* cosh: Numeric. (line 38) * could-not-open: Interrupts. (line 66) * current-error-port: Port Redirection. (line 7) * current-input-port: Port Properties. (line 54) * current-time: Time. (line 24) -* default-input-port: Line Editing. (line 21) -* default-output-port: Line Editing. (line 25) +* default-input-port: Line Editing. (line 23) +* default-output-port: Line Editing. (line 27) * defconst: Define and Set. (line 22) * DEFER_INTS: Signals. (line 26) * defined?: Define and Set. (line 7) * defmacro: Defmacro. (line 6) * defsyntax: Macro Primitives. (line 36) * defvar: Define and Set. (line 13) +* directory*-for-each: I/O-Extensions. (line 120) * directory-for-each: I/O-Extensions. (line 94) * display: Output. (line 9) * dld_find_executable: Executable Pathname. (line 18) @@ -8389,19 +8752,24 @@ Procedure and Macro Index * EVAL: Evaluation. (line 91) * eval: Eval and Load. (line 21) * eval-string: Eval and Load. (line 24) +* exact-ceiling: Numeric. (line 23) +* exact-floor: Numeric. (line 22) +* exact-round: Numeric. (line 21) +* exact-truncate: Numeric. (line 24) * exec-self: Internal State. (line 27) -* execl: I/O-Extensions. (line 196) -* execlp: I/O-Extensions. (line 197) -* execpath: Internal State. (line 79) -* execv: I/O-Extensions. (line 207) -* execvp: I/O-Extensions. (line 208) +* execl: I/O-Extensions. (line 210) +* execlp: I/O-Extensions. (line 211) +* execpath: Internal State. (line 82) +* execv: I/O-Extensions. (line 221) +* execvp: I/O-Extensions. (line 222) * exit: SCM Session. (line 19) * extended-environment: Syntactic Hooks for Hygienic Macros. (line 113) * file-position: Port Properties. (line 18) -* fileno: I/O-Extensions. (line 166) -* final_scm: Embedding SCM. (line 117) +* fileno: I/O-Extensions. (line 180) +* final_scm: Embedding SCM. (line 116) * find_impl_file: File-System Habitat. (line 35) +* finite?: Numeric. (line 79) * force-output: Window Manipulation. (line 30) * fork: Posix Extensions. (line 44) * FPORTP: Ptob Cells. (line 53) @@ -8421,8 +8789,9 @@ Procedure and Macro Index * gentemp: Defmacro. (line 6) * get-internal-real-time: Time. (line 17) * get-internal-run-time: Time. (line 10) -* getcwd: I/O-Extensions. (line 139) +* getcwd: I/O-Extensions. (line 148) * getegid: Posix Extensions. (line 63) +* getenv: SCM Session. (line 43) * geteuid: Posix Extensions. (line 66) * getgid: Posix Extensions. (line 60) * getgr: Posix Extensions. (line 224) @@ -8468,9 +8837,10 @@ Procedure and Macro Index (line 15) * inet:string->address: Internet Addresses and Socket Names. (line 7) +* infinite?: Numeric. (line 78) * init_buf0: Embedding SCM. (line 63) * init_sbrk: Embedding SCM. (line 31) -* init_signals <1>: Embedding SCM. (line 85) +* init_signals <1>: Embedding SCM. (line 84) * init_signals: Signals. (line 7) * initscr: Curses. (line 11) * INPORTP: Ptob Cells. (line 37) @@ -8486,7 +8856,7 @@ Procedure and Macro Index * leaveok: Output Options Setting. (line 32) * LENGTH: Header Cells. (line 22) -* line-editing: Line Editing. (line 33) +* line-editing: Line Editing. (line 35) * line-number: Eval and Load. (line 34) * line-number->integer: Line Numbers. (line 41) * line-number?: Line Numbers. (line 44) @@ -8508,7 +8878,7 @@ Procedure and Macro Index * makcclo: Header Cells. (line 105) * make-arbiter: Process Synchronization. (line 35) -* make-edited-line-port: Line Editing. (line 29) +* make-edited-line-port: Line Editing. (line 31) * make-exchanger: Process Synchronization. (line 12) * make-soft-port: Soft Ports. (line 10) @@ -8527,7 +8897,7 @@ Procedure and Macro Index * MAKSPCSYM: Immediates. (line 97) * mark_locations: Marking Cells. (line 33) * milli-alarm: Interrupts. (line 30) -* mkdir: I/O-Extensions. (line 120) +* mkdir: I/O-Extensions. (line 129) * mknod: Unix Extensions. (line 43) * must_free: Allocating memory. (line 43) * must_free_argv: Type Conversions. (line 84) @@ -8577,8 +8947,8 @@ Procedure and Macro Index * overlay: Window Manipulation. (line 46) * overwrite: Window Manipulation. (line 47) * perror: Errors. (line 101) -* pi*: Numeric. (line 21) -* pi/: Numeric. (line 24) +* pi*: Numeric. (line 31) +* pi/: Numeric. (line 34) * pipe: Posix Extensions. (line 40) * port-closed?: Port Properties. (line 7) * port-column: Port Properties. (line 30) @@ -8603,7 +8973,7 @@ Procedure and Macro Index * profile-alarm: Interrupts. (line 32) * profile-alarm-interrupt: Interrupts. (line 52) * program-arguments: SCM Session. (line 30) -* putenv: I/O-Extensions. (line 212) +* putenv: I/O-Extensions. (line 226) * qase: Define and Set. (line 45) * quit: SCM Session. (line 17) * raw: Terminal Mode Setting. @@ -8616,23 +8986,23 @@ Procedure and Macro Index (line 7) * readdir: I/O-Extensions. (line 81) * readlink: Unix Extensions. (line 19) -* real-acos: Numeric. (line 44) -* real-acosh: Numeric. (line 50) -* real-asin: Numeric. (line 43) -* real-asinh: Numeric. (line 49) -* real-atan: Numeric. (line 45) -* real-atanh: Numeric. (line 51) -* real-cos: Numeric. (line 41) -* real-cosh: Numeric. (line 47) -* real-exp: Numeric. (line 38) -* real-expt: Numeric. (line 62) -* real-ln: Numeric. (line 39) -* real-log10: Numeric. (line 56) -* real-sin: Numeric. (line 40) -* real-sinh: Numeric. (line 46) -* real-sqrt: Numeric. (line 37) -* real-tan: Numeric. (line 42) -* real-tanh: Numeric. (line 48) +* real-acos: Numeric. (line 54) +* real-acosh: Numeric. (line 61) +* real-asin: Numeric. (line 53) +* real-asinh: Numeric. (line 60) +* real-atan: Numeric. (line 55) +* real-atanh: Numeric. (line 62) +* real-cos: Numeric. (line 51) +* real-cosh: Numeric. (line 58) +* real-exp: Numeric. (line 48) +* real-expt: Numeric. (line 73) +* real-ln: Numeric. (line 49) +* real-log10: Numeric. (line 67) +* real-sin: Numeric. (line 50) +* real-sinh: Numeric. (line 57) +* real-sqrt: Numeric. (line 47) +* real-tan: Numeric. (line 52) +* real-tanh: Numeric. (line 59) * record-printer-set!: Records. (line 10) * redirect-port!: I/O-Extensions. (line 72) * refresh: Window Manipulation. (line 29) @@ -8654,7 +9024,7 @@ Procedure and Macro Index (line 52) * release-arbiter: Process Synchronization. (line 43) -* rename-file: I/O-Extensions. (line 144) +* rename-file: I/O-Extensions. (line 153) * renamed-identifier: Syntactic Hooks for Hygienic Macros. (line 26) * renaming-transformer: Syntactic Hooks for Hygienic Macros. @@ -8664,10 +9034,10 @@ Procedure and Macro Index * resetty: Terminal Mode Setting. (line 58) * restart: Internal State. (line 18) -* restore_signals: Embedding SCM. (line 90) +* restore_signals: Embedding SCM. (line 89) * rewinddir: I/O-Extensions. (line 86) -* rmdir: I/O-Extensions. (line 129) -* room: Internal State. (line 62) +* rmdir: I/O-Extensions. (line 138) +* room: Internal State. (line 65) * savetty: Terminal Mode Setting. (line 59) * scalar->array: Array Mapping. (line 51) @@ -8675,12 +9045,12 @@ Procedure and Macro Index * scm_find_execpath: Embedding SCM. (line 36) * scm_find_implpath: Embedding SCM. (line 50) * scm_gc_protect: Changing Scm. (line 35) -* scm_init_from_argv: Embedding SCM. (line 74) +* scm_init_from_argv: Embedding SCM. (line 73) * scm_ldfile: Callbacks. (line 10) * scm_ldprog: Callbacks. (line 15) * scm_ldstr: Callbacks. (line 28) * scm_protect_temp: Changing Scm. (line 26) -* scm_top_level: Embedding SCM. (line 93) +* scm_top_level: Embedding SCM. (line 92) * scope-trace: Debugging Continuations. (line 23) * script_count_argv: Script Support. (line 31) @@ -8709,7 +9079,7 @@ Procedure and Macro Index * short: Type Conversions. (line 25) * SHORT_ALIGN: Continuations. (line 28) * SIDEVAL: Evaluation. (line 92) -* sinh: Numeric. (line 27) +* sinh: Numeric. (line 37) * socket-name:address: Internet Addresses and Socket Names. (line 43) * socket-name:family: Internet Addresses and Socket Names. @@ -8740,7 +9110,7 @@ Procedure and Macro Index * syntax-quote: Syntactic Hooks for Hygienic Macros. (line 123) * syntax-rules: Syntax-Rules. (line 6) -* tanh: Numeric. (line 29) +* tanh: Numeric. (line 39) * the-macro: Syntactic Hooks for Hygienic Macros. (line 129) * throw_to_continuation: Continuations. (line 84) @@ -8763,7 +9133,7 @@ Procedure and Macro Index * TYP7: Cells. (line 28) * UCHARS: Header Cells. (line 36) * ulong2num: Type Conversions. (line 11) -* umask: I/O-Extensions. (line 161) +* umask: I/O-Extensions. (line 175) * uname: Posix Extensions. (line 172) * unctrl: Curses Miscellany. (line 30) * uniform-array-read!: Uniform Array. (line 67) @@ -8772,14 +9142,14 @@ Procedure and Macro Index (line 45) * user-interrupt: Interrupts. (line 49) * usr:lib: Dynamic Linking. (line 18) -* utime: I/O-Extensions. (line 156) +* utime: I/O-Extensions. (line 170) * vector-set-length!: Storage. (line 7) * VECTORP: Header Cells. (line 16) * VELTS: Header Cells. (line 21) * verbose: Internal State. (line 33) * virtual-alarm: Interrupts. (line 31) * virtual-alarm-interrupt: Interrupts. (line 51) -* vms-debug: SCM Session. (line 41) +* vms-debug: SCM Session. (line 56) * void: Sweeping the Heap. (line 15) * wadd: Output. (line 11) * wait-for-input: Port Properties. (line 66) @@ -8816,7 +9186,7 @@ Variable Index * *interactive*: SCM Variables. (line 36) * *load-pathname*: Eval and Load. (line 15) * *load-reader*: Line Numbers. (line 50) -* *scm-version*: Internal State. (line 67) +* *scm-version*: Internal State. (line 70) * *slib-load-reader*: Line Numbers. (line 51) * *syntax-rules*: SCM Variables. (line 30) * af_inet: Host and Other Inquiries. @@ -9032,145 +9402,151 @@ Concept Index * Unix: Unix Extensions. (line 6) * unix: Build Options. (line 351) * wb: Build Options. (line 355) -* windows: Build Options. (line 358) +* wb-no-threads: Build Options. (line 358) +* windows: Build Options. (line 361) * X: Packages. (line 23) * x <1>: Packages. (line 23) -* x: Build Options. (line 361) +* x: Build Options. (line 364) * xlib: Packages. (line 23) * Xlib: Packages. (line 23) -* xlib: Build Options. (line 364) +* xlib: Build Options. (line 367) * xlibscm: Packages. (line 23) * Xlibscm: Packages. (line 23)  Tag Table: -Node: Top853 -Node: Overview1826 -Node: SCM Features2311 -Node: SCM Authors4321 -Node: Copying5222 -Node: The SCM License5607 -Node: SIOD copyright6539 -Node: GNU Free Documentation License8010 -Node: Bibliography42502 -Node: Installing SCM44457 -Node: Making SCM44976 -Node: SLIB45924 -Node: Building SCM47772 -Node: Invoking Build48354 -Node: Build Options50691 -Node: Compiling and Linking Custom Files64059 -Node: Installing Dynamic Linking66055 -Node: Configure Module Catalog67845 -Node: Saving Images69853 -Node: Automatic C Preprocessor Definitions71595 -Node: Problems Compiling75438 -Node: Problems Linking77099 -Node: Problems Running77372 -Node: Testing79490 -Node: Reporting Problems82759 -Node: Operational Features83611 -Node: Invoking SCM84007 -Node: SCM Options85727 -Node: Invocation Examples90197 -Node: SCM Variables91157 -Node: SCM Session92637 -Node: Editing Scheme Code94168 -Node: Debugging Scheme Code96186 -Node: Debugging Continuations100451 -Node: Errors103011 -Node: Memoized Expressions107329 -Node: Internal State109693 -Node: Scripting112919 -Node: Unix Scheme Scripts113223 -Node: MS-DOS Compatible Scripts116255 -Node: Unix Shell Scripts118110 -Node: The Language120251 -Node: Standards Compliance120873 -Node: Storage123296 -Node: Time125776 -Node: Interrupts126792 -Node: Process Synchronization130425 -Node: Files and Ports131954 -Node: Opening and Closing132295 -Node: Port Properties134795 -Node: Port Redirection137932 -Node: Soft Ports139424 -Node: Eval and Load141206 -Node: Line Numbers142622 -Node: Lexical Conventions145045 -Node: Common-Lisp Read Syntax145307 -Node: Load Syntax147294 -Node: Documentation and Comments147914 -Node: Modifying Read Syntax149138 -Node: Syntax150861 -Node: Define and Set151765 -Node: Defmacro155299 -Node: Syntax-Rules156379 -Node: Macro Primitives158185 -Node: Environment Frames159824 -Node: Syntactic Hooks for Hygienic Macros162244 -Node: Packages169218 -Node: Dynamic Linking170098 -Node: Dump174777 -Node: Numeric178798 -Node: Arrays180614 -Node: Conventional Arrays180832 -Node: Uniform Array184371 -Node: Bit Vectors189183 -Node: Array Mapping190491 -Node: Records193184 -Node: I/O-Extensions194056 -Node: Posix Extensions202223 -Node: Unix Extensions211775 -Node: Sequence Comparison213676 -Node: Regular Expression Pattern Matching214006 -Node: Line Editing217984 -Node: Curses219345 -Node: Output Options Setting220280 -Node: Terminal Mode Setting222947 -Node: Window Manipulation226048 -Node: Output229533 -Node: Input233185 -Node: Curses Miscellany234229 -Node: Sockets235670 -Node: Host and Other Inquiries236033 -Node: Internet Addresses and Socket Names239174 -Node: Socket240747 -Node: SCMDB247964 -Node: The Implementation248202 -Node: Data Types248465 -Node: Immediates249294 -Node: Cells253676 -Node: Header Cells255794 -Node: Subr Cells259090 -Node: Ptob Cells261387 -Node: Smob Cells262956 -Node: Data Type Representations266179 -Node: Operations271058 -Node: Garbage Collection271652 -Node: Marking Cells272285 -Node: Sweeping the Heap274406 -Node: Memory Management for Environments275368 -Node: Signals279937 -Node: C Macros281498 -Node: Changing Scm282635 -Node: Defining Subrs287099 -Node: Defining Smobs288959 -Node: Defining Ptobs292016 -Node: Allocating memory293205 -Node: Embedding SCM295535 -Node: Callbacks303249 -Node: Type Conversions305070 -Node: Continuations309119 -Node: Evaluation313357 -Node: Program Self-Knowledge318540 -Node: File-System Habitat318794 -Node: Executable Pathname322407 -Node: Script Support324045 -Node: Improvements To Make325380 -Node: VMS Dynamic Linking327598 -Node: Index332311 +Node: Top787 +Node: Overview1763 +Node: SCM Features2252 +Node: SCM Authors4331 +Node: Copying5313 +Node: The SCM License5781 +Node: SIOD copyright6638 +Node: GNU Free Documentation License8113 +Node: Bibliography33332 +Node: Installing SCM35291 +Node: Distributions36220 +Node: GNU configure and make37940 +Node: Making scmlit41863 +Node: Makefile targets45340 +Node: Building SCM50878 +Node: Invoking Build51664 +Node: Build Options59463 +Node: Compiling and Linking Custom Files73167 +Node: Saving Executable Images75246 +Node: Installation78349 +Node: Troubleshooting and Testing79366 +Node: Problems Compiling80075 +Node: Problems Linking81937 +Node: Testing82415 +Node: Problems Starting85737 +Node: Problems Running88308 +Node: Reporting Problems90206 +Node: Operational Features91356 +Node: Invoking SCM91835 +Node: SCM Options93638 +Node: Invocation Examples98191 +Node: SCM Variables99234 +Node: SCM Session100797 +Node: Editing Scheme Code102888 +Node: Debugging Scheme Code104989 +Node: Debugging Continuations109289 +Node: Errors111932 +Node: Memoized Expressions116333 +Node: Internal State118780 +Node: Scripting122329 +Node: Unix Scheme Scripts122716 +Node: MS-DOS Compatible Scripts125831 +Node: Unix Shell Scripts127774 +Node: The Language129998 +Node: Standards Compliance130703 +Node: Storage133209 +Node: Time135772 +Node: Interrupts136883 +Node: Process Synchronization140599 +Node: Files and Ports142211 +Node: Opening and Closing142635 +Node: Port Properties145218 +Node: Port Redirection148438 +Node: Soft Ports150013 +Node: Eval and Load151878 +Node: Line Numbers153377 +Node: Lexical Conventions155883 +Node: Common-Lisp Read Syntax156228 +Node: Load Syntax158298 +Node: Documentation and Comments159001 +Node: Modifying Read Syntax160308 +Node: Syntax162114 +Node: Define and Set163101 +Node: Defmacro166718 +Node: Syntax-Rules167881 +Node: Macro Primitives169770 +Node: Environment Frames171492 +Node: Syntactic Hooks for Hygienic Macros173995 +Node: Packages181052 +Node: Dynamic Linking182015 +Node: Dump186777 +Node: Numeric190881 +Node: Arrays194082 +Node: Conventional Arrays194383 +Node: Uniform Array197961 +Node: Bit Vectors202856 +Node: Array Mapping204367 +Node: Records207143 +Node: I/O-Extensions208098 +Node: Posix Extensions217468 +Node: Unix Extensions227103 +Node: Sequence Comparison229087 +Node: Regular Expression Pattern Matching229500 +Node: Line Editing233561 +Node: Curses235040 +Node: Output Options Setting236058 +Node: Terminal Mode Setting238808 +Node: Window Manipulation241992 +Node: Output245560 +Node: Input249295 +Node: Curses Miscellany250422 +Node: Sockets251946 +Node: Host and Other Inquiries252392 +Node: Internet Addresses and Socket Names255616 +Node: Socket257272 +Node: SCMDB264572 +Node: The Implementation264893 +Node: Data Types265239 +Node: Immediates266208 +Node: Cells270673 +Node: Header Cells272874 +Node: Subr Cells276253 +Node: Defining Subrs278637 +Node: Ptob Cells282896 +Node: Defining Ptobs284619 +Node: Smob Cells287023 +Node: Defining Smobs290385 +Node: Data Type Representations296259 +Node: Operations301434 +Node: Garbage Collection302152 +Node: Marking Cells302868 +Node: Sweeping the Heap305072 +Node: Memory Management for Environments306117 +Node: Dynamic Linking Support310785 +Node: Configure Module Catalog313971 +Node: Automatic C Preprocessor Definitions317959 +Node: Signals325611 +Node: C Macros327323 +Node: Changing Scm328608 +Node: Allocating memory333219 +Node: Embedding SCM335630 +Node: Callbacks343422 +Node: Type Conversions345326 +Node: Continuations349458 +Node: Evaluation353779 +Node: Program Self-Knowledge359045 +Node: File-System Habitat359382 +Node: Executable Pathname363078 +Node: Script Support364799 +Node: Improvements To Make366217 +Node: VMS Dynamic Linking368518 +Node: Index373314  End Tag Table diff --git a/scm.nsi b/scm.nsi index 1954b05..db06c7b 100644 --- a/scm.nsi +++ b/scm.nsi @@ -4,8 +4,8 @@ ; placed in the public domain ; *** version numbers *** -!define PRODUCT_VERSION "5e5-1" -!define REQ_SLIB_VERSION "3b1-1" +!define PRODUCT_VERSION "5f2-1" +!define REQ_SLIB_VERSION "3b5-1" ; ----------------[ NO CHANGES BELOW ]---------------- @@ -21,7 +21,7 @@ !define PRODUCT_NAME "SCM" !define PRODUCT_COMPANY "Voluntocracy" !define PRODUCT_PUBLISHER "Aubrey Jaffer" -!define PRODUCT_WEB_SITE "http://swissnet.ai.mit.edu/~jaffer/SCM.html" +!define PRODUCT_WEB_SITE "http://people.csail.mit.edu/jaffer/SCM.html" !define PRODUCT_DIR_REGKEY "Software\Microsoft\Windows\CurrentVersion\App Paths\scm-${PRODUCT_VERSION}.exe" !define PRODUCT_UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PRODUCT_NAME}" !define PRODUCT_UNINST_ROOT_KEY "HKLM" @@ -103,7 +103,8 @@ Section "MainSection" SEC01 File "scm.exe" File "scm.html" File "SCM.ico" - File "Init5e5.scm" + File "Init5f2.scm" + File "Tscript.scm" File "Transcen.scm" File "mkimpcat.scm" File "hobbit.scm" @@ -181,7 +182,8 @@ Section Uninstall Delete "$INSTDIR\hobbit.scm" Delete "$INSTDIR\mkimpcat.scm" Delete "$INSTDIR\Transcen.scm" - Delete "$INSTDIR\Init5e5.scm" + Delete "$INSTDIR\Tscript.scm" + Delete "$INSTDIR\Init5f2.scm" Delete "$INSTDIR\SCM.ico" Delete "$INSTDIR\scm.html" Delete "$INSTDIR\scm.exe" diff --git a/scm.spec b/scm.spec index 9a1f57c..82b9631 100644 --- a/scm.spec +++ b/scm.spec @@ -1,9 +1,9 @@ %define name scm -%define version 5e5 +%define version 5f2 %define release 1 %define implpath %{prefix}/lib/scm %define slibpath %{prefix}/lib/slib -%define dumparch setarch i386 +%define dumparch setarch %{_target_cpu} # rpm seems to require all on one line, bleah. %define features cautious bignums arrays inexact dump dynamic-linking macro engineering-notation @@ -19,8 +19,8 @@ Provides: scm Requires: slib Summary: SCM Scheme implementation -Source: ftp://swiss.csail.mit.edu/pub/scm/scm-%{version}.zip -URL: http://swiss.csail.mit.edu/~jaffer/SCM +Source: http://groups.csail.mit.edu/mac/ftpdir/scm/scm-%{version}.zip +URL: http://people.csail.mit.edu/jaffer/SCM BuildRoot: %{_tmppath}/%{name}-%{version} Prefix: /usr @@ -33,7 +33,7 @@ This distribution requires libdl.so from the glibc-devel package and the slib Scheme library package. If your machine lacks XFree86 or readline, install with --nodeps. -%define __os_install_post /usr/lib/rpm/brp-compress +# %define __os_install_post /usr/lib/rpm/brp-compress %prep rm -rf /var/tmp/%{name}-%{version} @@ -55,60 +55,55 @@ make clean export PATH=.:$PATH # to get scmlit in the path. # Build the executable. -./build -h system -o udscm5 --compiler-options="-O3" -l debug -s %{implpath} -F %{features} +./build -h system -o udscm5 --compiler-options="-O2" -l debug -s %{implpath} -F %{features} echo "(quit)" | ./udscm5 -no-init-file -r5 -o scm -make check +# make check # Build dlls make x.so -./build -h system -t dll -F curses --compiler-options="-O3" -./build -h system -t dll -c differ.c --compiler-options="-O3" -./build -h system -t dll -c sc2.c --compiler-options="-O3" -./build -h system -t dll -c rgx.c --compiler-options="-O3" -./build -h system -t dll -c record.c --compiler-options="-O3" -./build -h system -t dll -c gsubr.c --compiler-options="-O3" -./build -h system -t dll -c ioext.c --compiler-options="-O3" -./build -h system -t dll -c posix.c --compiler-options="-O3" -./build -h system -t dll -c unix.c --compiler-options="-O3" -./build -h system -t dll -c socket.c --compiler-options="-O3" -./build -h system -t dll -c ramap.c --compiler-options="-O3" -./build -h system -t dll -c byte.c --compiler-options="-O3" -./build -h system -t dll -F edit-line --compiler-options="-O3" -./build -h system -t dll -F x --compiler-options="-O3" +./build -h system -t dll -F curses --compiler-options="-O2" +./build -h system -t dll -F edit-line --compiler-options="-O2" +./build -h system -t dll -c differ.c --compiler-options="-O2" +./build -h system -t dll -c sc2.c --compiler-options="-O2" +./build -h system -t dll -c rgx.c --compiler-options="-O2" +./build -h system -t dll -c record.c --compiler-options="-O2" +./build -h system -t dll -c gsubr.c --compiler-options="-O2" +./build -h system -t dll -c ioext.c --compiler-options="-O2" +./build -h system -t dll -c posix.c --compiler-options="-O2" +./build -h system -t dll -c unix.c --compiler-options="-O2" +./build -h system -t dll -c socket.c --compiler-options="-O2" +./build -h system -t dll -c ramap.c --compiler-options="-O2" +./build -h system -t dll -c byte.c --compiler-options="-O2" +./build -h system -t dll -F x --compiler-options="-O2" # Build libscm.a static library ./build -h system -F cautious bignums arrays inexact dynamic-linking -t lib \ - --compiler-options="-O3" + --compiler-options="-O2" %install mkdir -p ${RPM_BUILD_ROOT}%{prefix}/bin mkdir -p ${RPM_BUILD_ROOT}%{prefix}/lib/scm -mkdir -p ${RPM_BUILD_ROOT}%{prefix}/man/man1 -make prefix=${RPM_BUILD_ROOT}%{prefix}/ install -make prefix=${RPM_BUILD_ROOT}%{prefix}/ installlib +mkdir -p ${RPM_BUILD_ROOT}%{_mandir}/man1 +make prefix=${RPM_BUILD_ROOT}%{prefix}/ \ + mandir=${RPM_BUILD_ROOT}%{_mandir}/ \ + infodir=${RPM_BUILD_ROOT}%{_infodir}/ \ + install rm -f ${RPM_BUILD_ROOT}%{prefix}/bin/scm cp udscm5 ${RPM_BUILD_ROOT}%{prefix}/bin/ -# Assume SLIB is in %{slibpath}, as installed by the slib rpm. +# Assume SLIB is in %{prefix}/lib/slib, as installed by the slib rpm. cat > ${RPM_BUILD_ROOT}%{prefix}/lib/scm/require.scm < + @end ifset -@center @url{http://swiss.csail.mit.edu/~jaffer/SCM} +@center @url{http://people.csail.mit.edu/jaffer/SCM} @ifset html @end ifset @@ -153,7 +153,7 @@ timing information printed interactively (the @code{verbose} function). @section Authors @table @b -@item Aubrey Jaffer (agj @@ alum.mit.edu) +@item Aubrey Jaffer (agj@@alum.mit.edu) Most of SCM. @item Radey Shouman Arrays, @code{gsubr}s, compiled closures, records, Ecache, syntax-rules @@ -400,37 +400,119 @@ Documentation of the Xlib - SCM Language X Interface. @node Installing SCM, Operational Features, Overview, Top @chapter Installing SCM +SCM runs on a wide variety of platforms. ``Distributions'' is the +starting point for all platforms. The process described in ``GNU +configure and make'' will work on most Unix and GNU/Linux platforms. +If it works for you, then you may skip the later sections of +``Installing SCM''. + @menu -* Making SCM:: Bootstrapping. -* SLIB:: REQUIREd reading. +* Distributions:: Source and Binaries +* GNU configure and make:: For Unix and GNU/Linux * Building SCM:: -* Installing Dynamic Linking:: -* Configure Module Catalog:: -* Saving Images:: Make Fast-Booting Executables -* Automatic C Preprocessor Definitions:: -* Problems Compiling:: -* Problems Linking:: -* Problems Running:: -* Testing:: -* Reporting Problems:: +* Saving Executable Images:: For Faster Startup +* Installation:: +* Troubleshooting and Testing:: +@end menu + +@node Distributions, GNU configure and make, Installing SCM, Installing SCM +@section Distributions + +@noindent +The SCM homepage contains links to precompiled binaries and source +distributions. + +@noindent +Downloads and instructions for installing the precompiled binaries are +at @uref{http://people.csail.mit.edu/jaffer/SCM#QuickStart}. + +@noindent +If there is no precompiled binary for your platform, you may be able +to build from the source distribution. The rest of these instructions +deal with building and installing SCM and SLIB from sources. + +@noindent +Download (both SCM and SLIB of) either the last release or current +development snapshot from +@uref{http://people.csail.mit.edu/jaffer/SCM#BuildFromSource}. + +@noindent +Unzip both the SCM and SLIB zips. For example, if you are working in +@file{/usr/local/src/}, this will create directories +@file{/usr/local/src/scm/} and @file{/usr/local/src/slib/}. + + +@node GNU configure and make, Building SCM, Distributions, Installing SCM +@section GNU configure and make + +@file{scm/configure} and @file{slib/configure} are Shell scripts which +create the files @file{scm/config.status} and +@file{slib/config.status} on Unix and MinGW systems. + +The @file{config.status} files are used (included) by the Makefile to +control where the packages will be installed by @code{make install}. +With GNU shell (bash) and utilities, the following commands should +build and install SCM and SLIB: + +@example +bash$ (cd slib; ./configure --prefix=/usr/local/) +bash$ (cd scm +> ./configure --prefix=/usr/local/ +> make scmlit +> sudo make all +> sudo make install) +bash$ (cd slib; sudo make install) +@end example + +If the install commands worked, skip to @ref{Testing}. + +If @file{configure} doesn't work on your system, make +@file{scm/config.status} and @file{slib/config.status} be empty files. + +For additional help on using the @file{configure} script, run +@w{@samp{./configure --help}}. + +@samp{make all} will attempt to create a dumped executable +(@pxref{Saving Executable Images}), which has very small startup +latency. If that fails, it will try to compile an ordinary @samp{scm} +executable. + +Note that the compilation output may contain error messages; be +concerned only if the @samp{make install} transcripts contain errors. + +@samp{sudo} runs the command after it as user @dfn{root}. On recent +GNU/Linux systems, dumping requires that @samp{make all} be run as +user root; hence the use of @samp{sudo}. + +@samp{make install} requires root privileges if you are installing to +standard Unix locations as specified to (or defaulted by) +@samp{./configure}. Note that this is independent of whether you did +@w{@samp{sudo make all}} or @w{@samp{make all}}. + +@menu +* Making scmlit:: +* Makefile targets:: @end menu -@node Making SCM, SLIB, Installing SCM, Installing SCM -@section Making SCM +@node Making scmlit, Makefile targets, GNU configure and make, GNU configure and make +@subsection Making scmlit -The SCM distribution has @dfn{Makefile} which contains rules for -making @dfn{scmlit}, a ``bare-bones'' version of SCM sufficient for -running @file{build}. @file{build} is used to compile (or create -scripts to compile) full featured versions (@pxref{Building SCM}). +@noindent +The SCM distribution @file{Makefile} contains rules for making +@dfn{scmlit}, a ``bare-bones'' version of SCM sufficient for running +@file{build}. @file{build} is a Scheme program used to compile (or +create scripts to compile) full featured versions of SCM +(@pxref{Building SCM}). To create scmlit, run @w{@samp{make scmlit}} +in the @file{scm/} directory. -Makefiles are not portable to the majority of platforms. If -@file{Makefile} works for you, good; If not, I don't want to hear about -it. If you need to compile SCM without build, there are several ways to +@noindent +Makefiles are not portable to the majority of platforms. If you need +to compile SCM without @samp{scmlit}, there are several ways to proceed: @itemize @bullet @item -Use the @uref{http://swiss.csail.mit.edu/~jaffer/buildscm.html, build} +Use the @uref{http://people.csail.mit.edu/jaffer/buildscm.html, build} web page to create custom batch scripts for compiling SCM. @item @@ -445,48 +527,25 @@ script to build SCM; Create your own script or @file{Makefile}. @end itemize +@subheading Finding SLIB -@node SLIB, Building SCM, Making SCM, Installing SCM -@section SLIB +If you didn't create scmlit using @samp{make scmlit}, then you must +create a file named @file{scm/require.scm}. For most installations, +@file{scm/require.scm} can just be copied from +@file{scm/requires.scm}, which is part of the SCM distribution. @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: +If, when executing @samp{scmlit} or @samp{scm}, you get a message +like: -@ifclear html -@itemize @bullet -@item -swiss.csail.mit.edu:/pub/scm/slib-3b1.tar.gz -@item -ftp.gnu.org:/pub/gnu/jacal/slib-3b1.tar.gz -@end itemize -@end ifclear - -@ifset html -@itemize @bullet -@item - -http://swiss.csail.mit.edu/ftpdir/scm/slib-3b1.zip - -@item - -ftp.gnu.org:/pub/gnu/jacal/slib-3b1.tar.gz - -@end itemize -@end ifset - -@noindent -Unpack SLIB (@samp{tar xzf slib-3b1.tar.gz} or @samp{unzip -ao -slib-3b1.zip}) in an appropriate directory for your system; both -@code{tar} and @code{unzip} will create the directory @file{slib}. +@example +ERROR: "LOAD couldn't find file " "/usr/local/src/scm/require" +@end example @noindent -Then create a file @file{require.scm} in the SCM +then create a file @file{require.scm} in the SCM @dfn{implementation-vicinity} (this is the same directory as where the -file @file{Init@value{SCMVERSION}.scm} is installed). +file @file{Init@value{SCMVERSION}.scm} is). @file{require.scm} should have the contents: @example @@ -494,12 +553,21 @@ file @file{Init@value{SCMVERSION}.scm} is installed). @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: +where the pathname string @file{/usr/local/lib/slib/} is to be +replaced by the pathname into which you unzipped (or installed) SLIB. + +@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, this environment variable overrides @file{scm/require.scm}. + +@noindent +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 @@ -507,59 +575,204 @@ implementation-vicinity, which is absolute: (lambda () lv))) @end example + + +@node Makefile targets, , Making scmlit, GNU configure and make +@subsection Makefile targets + +Each of the following four @samp{make} targets creates an executable +named @file{scm}. Each target takes its build options from a file +with an @samp{.opt} suffix. If that options file doesn't exist, +making that target will create the file with the @samp{-F} features: +cautious, bignums, arrays, inexact, engineering-notation, and +dynamic-linking. Once that @samp{.opt} file exists, you can edit it +to your taste and it will be preserved. + +@table @code +@item make scm4 +Produces a R4RS executable named @file{scm} lacking hygienic macros +(but with defmacro). The build options are taken from +@file{scm4.opt}. If build or the executable fails, try removing +@samp{dynamic-linking} from @file{scm4.opt}. + +@item make scm5 +R5RS; like @samp{make scm4} but with @samp{-F macro}. The build +options are taken from @file{scm5.opt}. If build or the executable +fails, try removing @samp{dynamic-linking} from @file{scm5.opt}. + +@item make dscm4 +Produces a R4RS executable named @file{udscm4}, which it starts and +dumps to a low startup latency executable named @file{scm}. The build +options are taken from @file{udscm4.opt}. + +If the build fails, then @samp{build scm4} instead. If the dumped +executable fails to run, then send me a bug report (and use +@w{@samp{build scm4}} until the problem with dump is corrected). + +@item make dscm5 +Like @samp{make dscm4} but with @samp{-F macro}. The build options +are taken from @file{udscm5.opt}. + +If the build fails, then @samp{build scm5} instead. If the dumped +executable fails to run, then send me a bug report (and use +@w{@samp{build scm5}} until the problem with dump is corrected). + +@end table + @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. +If the above builds fail because of @w{@samp{-F dynamic-linking}}, +then (because they can't be dynamically linked) you will likely want +to add some other features to the build's @samp{.opt} file. See the +@samp{-F} build option in @ref{Build Options}. + +@noindent +If dynamic-linking is working, then you will likely want to compile +most of the modules as @dfn{DLL}s. The build options for compiling +DLLs are in @file{dlls.opt}. + +@table @code +@item make x.so +The @code{Xlib} module; +@ref{Top, ,SCM Language X Interface , Xlibscm, Xlibscm}. -@node Building SCM, Installing Dynamic Linking, SLIB, Installing SCM +@item make myturtle +Creates a DLL named @file{turtlegr.so} which is a simple graphics API. + +@item make wbscm.so +The @code{wb} module; +@ref{Top, ,B-tree database implementation , wb, wb}. +Compiling this requires that wb source be in a peer directory to scm. + +@item make dlls +Compiles all the distributed library modules, but not @file{wbscm.so}. +Many of the module compiles are recursively invoked in such a way that +failure of one (which could be due to a system library not being +installed) doesn't cause the top-level @samp{make dlls} to fail. If +@samp{make dlls} fails as a whole, it is time to submit a bug report +(@pxref{Reporting Problems}). + +@end table + + + +@node Building SCM, Saving Executable Images, GNU configure and make, Installing SCM @section Building SCM @cindex build @cindex build.scm -The file @dfn{build} loads the file @dfn{build.scm}, which constructs a -relational database of how to compile and link SCM executables. +The file @dfn{build} loads the file @dfn{build.scm}, which constructs +a relational database of how to compile and link SCM executables. @file{build.scm} has information for the platforms which SCM has been -ported to (of which I have been notified). Some of this information is -old, incorrect, or incomplete. Send corrections and additions to jaffer -@@ ai.mit.edu. +ported to (of which I have been notified). Some of this information +is old, incorrect, or incomplete. Send corrections and additions to +agj@@alum.mit.edu. @menu * Invoking Build:: -* Build Options:: +* Build Options:: build --help * Compiling and Linking Custom Files:: @end menu + @node Invoking Build, Build Options, Building SCM, Building SCM @subsection Invoking Build +This section teaches how to use @file{build}, a Scheme program for +creating compilation scripts to produce SCM executables and library +modules. The options accepted by @samp{build} are documented in +@ref{Build Options}. + @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}. +Use the @emph{any} method if you encounter problems with the other two +methods (MS-DOS, Unix). @table @asis @item MS-DOS From the SCM source directory, type @samp{build} followed by up to 9 command line arguments. -@item unix +@item Unix From the SCM source directory, type @samp{./build} followed by command line arguments. -@item @emph{all} +@item @emph{any} From the SCM source directory, start @samp{scm} or @samp{scmlit} and type @code{(load "build")}. Alternatively, start @samp{scm} or @samp{scmlit} with the command line argument @samp{-ilbuild}. +This method will also work for MS-DOS and Unix. + +After loading various SLIB modules, the program will print: + +@example +type (b "build ") to build +type (b*) to enter build command loop +@end example + +The @samp{b*} procedure enters into a @dfn{build shell} where you can +enter commands (with or without the @samp{build}). Blank lines are +ignored. To create a build script with all defaults type +@samp{build}. + +If the build-shell encouters an error, you can reenter the build-shell +by typing @samp{(b*)}. To exit scm type @samp{(quit)}. @end table @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. +Here is a transcript of an interactive (b*) build-shell. + +@example +bash$ scmlit +SCM version 5e7, Copyright (C) 1990-2006 Free Software Foundation. +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. +> (load "build") +;loading build +; loading /home/jaffer/slib/getparam +; loading /home/jaffer/slib/coerce +... +; done loading build.scm +type (b "build ") to build +type (b*) to enter build command loop +;done loading build +# +> (b*) +;loading /home/jaffer/slib/comparse +;done loading /home/jaffer/slib/comparse.scm +build> -t exe +#! /bin/sh +# unix (linux) script created by SLIB/batch Wed Oct 26 17:14:23 2011 +# [-p linux] +# ================ Write file with C defines +rm -f scmflags.h +echo '#define IMPLINIT "Init5e7.scm"'>>scmflags.h +echo '#define BIGNUMS'>>scmflags.h +echo '#define FLOATS'>>scmflags.h +echo '#define ARRAYS'>>scmflags.h +# ================ Compile C source files +gcc -c continue.c scm.c scmmain.c findexec.c script.c time.c repl.c scl.c eval.c sys.c subr.c debug.c unif.c rope.c +# ================ Link C object files +gcc -rdynamic -o scm continue.o scm.o scmmain.o findexec.o script.o time.o repl.o scl.o eval.o sys.o subr.o debug.o unif.o rope.o -lm -lc +"scm" +build> -t exe -w myscript.sh +"scm" +build> (quit) +@end example + +@noindent +No compilation was done. The @samp{-t exe} command shows the compile +script. The @samp{-t exe -w myscript.sh} line creates a file +@file{myscript.sh} containing the compile script. To actually compile +and link it, type @samp{./myscript.sh}. + +@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. Invoking @samp{build} with +@samp{-F lit -o scmlit} will make a script for compiling +@samp{scmlit}. @example bash$ ./build @@ -630,7 +843,7 @@ files: @table @file @item dlls.opt -Options for Makefile targets mydlls, myturtle, and x.so. +Options for Makefile targets dlls, myturtle, and x.so. @item gdb.opt Options for udgdbscm and gdbscm. @item libscm.opt @@ -833,119 +1046,8 @@ dynamic-loading), you can load the compiled file with the Scheme command add a compiled dll file to SLIB's catalog. -@node Installing Dynamic Linking, Configure Module Catalog, Building SCM, Installing SCM -@section Installing Dynamic Linking - -@noindent -Dynamic linking has not been ported to all platforms. Operating systems -in the BSD family (a.out binary format) can usually be ported to -@dfn{DLD}. The @dfn{dl} library (@code{#define SUN_DL} for SCM) was a -proposed POSIX standard and may be available on other machines with -@dfn{COFF} binary format. For notes about porting to MS-Windows and -finishing the port to VMS @ref{VMS Dynamic Linking}. - -@noindent -@dfn{DLD} is a library package of C functions that performs -@dfn{dynamic link editing} on GNU/Linux, VAX (Ultrix), Sun 3 (SunOS -3.4 and 4.0), SPARCstation (SunOS 4.0), Sequent Symmetry (Dynix), and -Atari ST. It is available from: - -@ifclear html -@itemize @bullet -@item -ftp.gnu.org:pub/gnu/dld-3.3.tar.gz -@end itemize -@end ifclear - -@ifset html - -ftp.gnu.org:pub/gnu/dld-3.3.tar.gz - -@end ifset - -@noindent -These notes about using libdl on SunOS are from @file{gcc.info}: - -@quotation -On a Sun, linking using GNU CC fails to find a shared library and -reports that the library doesn't exist at all. - -This happens if you are using the GNU linker, because it does only -static linking and looks only for unshared libraries. If you have -a shared library with no unshared counterpart, the GNU linker -won't find anything. - -We hope to make a linker which supports Sun shared libraries, but -please don't ask when it will be finished--we don't know. - -Sun forgot to include a static version of @file{libdl.a} with some -versions of SunOS (mainly 4.1). This results in undefined symbols when -linking static binaries (that is, if you use @samp{-static}). If you -see undefined symbols @samp{_dlclose}, @samp{_dlsym} or @samp{_dlopen} -when linking, compile and link against the file -@file{mit/util/misc/dlsym.c} from the MIT version of X windows. -@end quotation - - -@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 +@node Saving Executable Images, Installation, Building SCM, Installing SCM +@section Saving Executable Images In SCM, the ability to save running program images is called @dfn{dump} (@pxref{Dump}). In order to make @code{dump} available to SCM, build @@ -962,7 +1064,8 @@ The @samp{dscm4} and @samp{dscm5} targets in the SCM @file{Makefile} save images from @file{udscm4} and @file{udscm5} executables respectively. -Recent GNU/Linux innovations interfere with @code{dump}. For: +@dfn{Address space layout randomization} interferes with @code{dump}. +Here are the fixes for various operating-systems: @table @asis @item Fedora-Core-1 @@ -970,7 +1073,7 @@ Remove the @samp{#} from the line @samp{#SETARCH = setarch i386} in the @file{Makefile}. @item Fedora-Core-3 -@url{http://jamesthornton.com/writing/emacs-compile.html} writes: +@url{http://jamesthornton.com/writing/emacs-compile.html} [For FC3] combreloc has become the default for recent GNU ld, which breaks the unexec/undump on all versions of both Emacs and XEmacs... @@ -978,8 +1081,8 @@ XEmacs... Override by adding the following to @file{udscm5.opt}: @samp{--linker-options="-z nocombreloc"} -@item Kernels later than 2.6.11 -@url{http://www.opensubscriber.com/message/emacs-devel@@gnu.org/1007118.html} +@item Linux Kernels later than 2.6.11 +@exdent @url{http://www.opensubscriber.com/message/emacs-devel@@gnu.org/1007118.html} mentions the @dfn{exec-shield} feature. Kernels later than 2.6.11 must do (as root): @@ -991,106 +1094,55 @@ before dumping. @file{Makefile} has this @file{randomize_va_space} stuffing scripted for targets @samp{dscm4} and @samp{dscm5}. You must either set @file{randomize_va_space} to 0 or run as root to dump. +@item OS-X 10.6 + +@exdent @url{http://developer.apple.com/library/mac/#documentation/Darwin/Reference/Manpages/man1/dyld.1.html} +The dynamic linker uses the following environment variables. They +affect any program that uses the dynamic linker. + +DYLD_NO_PIE + +Causes dyld to not randomize the load addresses of images in a process +where the main executable was built position independent. This can be +helpful when trying to reproduce and debug a problem in a PIE. + @end table -@node Automatic C Preprocessor Definitions, Problems Compiling, Saving Images, Installing SCM -@section Automatic C Preprocessor Definitions +@node Installation, Troubleshooting and Testing, Saving Executable Images, Installing SCM +@section Installation -These @samp{#defines} are automatically provided by preprocessors of -various C compilers. SCM uses the presence or absence of these -definitions to configure @dfn{include file} locations and aliases for -library functions. If the definition(s) corresponding to your system -type is missing as your system is configured, add @code{-D@var{flag}} to -the compilation command lines or add a @code{#define @var{flag}} line to -@file{scmfig.h} or the beginning of @file{scmfig.h}. +Once @code{scmlit}, @code{scm}, and @code{dlls} have been built, these +commands will install them to the locations specified when you ran +@samp{./configure}: @example -#define Platforms: -------- ---------- -ARM_ULIB Huw Rogers free unix library for acorn archimedes -AZTEC_C Aztec_C 5.2a -__CYGWIN__ Cygwin -__CYGWIN32__ Cygwin -_DCC Dice C on AMIGA -__GNUC__ Gnu CC (and DJGPP) -__EMX__ Gnu C port (gcc/emx 0.8e) to OS/2 2.0 -__HIGHC__ MetaWare High C -__IBMC__ C-Set++ on OS/2 2.1 -_MSC_VER MS VisualC++ 4.2 -MWC Mark Williams C on COHERENT -__MWERKS__ Metrowerks Compiler; Macintosh and WIN32 (?) -_POSIX_SOURCE ?? -_QC Microsoft QuickC -__STDC__ ANSI C compliant -__TURBOC__ Turbo C and Borland C -__USE_POSIX ?? -__WATCOMC__ Watcom C on MS-DOS -__ZTC__ Zortech C +bash$ (cd scm; make install) +bash$ (cd slib; make install) +@end example -_AIX AIX operating system -__APPLE__ Apple Darwin -AMIGA SAS/C 5.10 or Dice C on AMIGA -__amigaos__ Gnu CC on AMIGA -atarist ATARI-ST under Gnu CC -__DragonflyBSD__ DragonflyBSD -__FreeBSD__ FreeBSD -GNUDOS DJGPP (obsolete in version 1.08) -__GO32__ DJGPP (future?) -hpux HP-UX -linux GNU/Linux -macintosh Macintosh (THINK_C and __MWERKS__ define) -MCH_AMIGA Aztec_c 5.2a on AMIGA -__MACH__ Apple Darwin -__MINGW32__ MinGW - Minimalist GNU for Windows -MSDOS Microsoft C 5.10 and 6.00A -_MSDOS Microsoft CLARM and CLTHUMB compilers. -__MSDOS__ Turbo C, Borland C, and DJGPP -__NetBSD__ NetBSD -nosve Control Data NOS/VE -__OpenBSD__ OpenBSD -SVR2 System V Revision 2. -sun SunOS -__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 and Cygwin (Win32 API) -_WIN32_WCE MS Windows CE -vms (and VMS) VAX-11 C under VMS. +Note that installation to system directories (like @samp{/usr/bin/}) +will require that those commands be run as root: -__alpha DEC Alpha processor -__alpha__ DEC Alpha processor -hp9000s800 HP RISC processor -__ia64 GCC on IA64 -__ia64__ GCC on IA64 -_LONGLONG GCC on IA64 -__i386__ DJGPP -i386 DJGPP -_M_ARM Microsoft CLARM compiler defines as 4 for ARM. -_M_ARMT Microsoft CLTHUMB compiler defines as 4 for Thumb. -MULTIMAX Encore computer -ppc PowerPC -__ppc__ PowerPC -pyr Pyramid 9810 processor -__sgi__ Silicon Graphics Inc. -sparc SPARC processor -sequent Sequent computer -tahoe CCI Tahoe processor -vax VAX processor -__x86_64 AMD Opteron +@example +bash$ (cd scm; sudo make install) +bash$ (cd slib; sudo make install) @end example +@node Troubleshooting and Testing, , Installation, Installing SCM +@section Troubleshooting and Testing + +@menu +* Problems Compiling:: +* Problems Linking:: +* Testing:: +* Problems Starting:: +* Problems Running:: +* Reporting Problems:: +@end menu -@node Problems Compiling, Problems Linking, Automatic C Preprocessor Definitions, Installing SCM -@section Problems Compiling +@node Problems Compiling, Problems Linking, Troubleshooting and Testing, Troubleshooting and Testing +@subsection Problems Compiling @multitable @columnfractions .10 .45 .45 @item FILE @@ -1144,8 +1196,8 @@ __x86_64 AMD Opteron @end multitable -@node Problems Linking, Problems Running, Problems Compiling, Installing SCM -@section Problems Linking +@node Problems Linking, Testing, Problems Compiling, Troubleshooting and Testing +@subsection Problems Linking @multitable @columnfractions .5 .5 @item PROBLEM @@ -1155,12 +1207,62 @@ __x86_64 AMD Opteron @end multitable -@node Problems Running, Testing, Problems Linking, Installing SCM -@section Problems Running +@node Testing, Problems Starting, Problems Linking, Troubleshooting and Testing +@subsection Testing + +@noindent +Loading @file{r4rstest.scm} in the distribution will run an [R4RS] +conformance test on @code{scm}. + +@example +> (load "r4rstest.scm") +@print{} +;loading r4rstest.scm +SECTION(2 1) +SECTION(3 4) + # + # + # + # +@dots{} +@end example + +@noindent +Loading @file{pi.scm} in the distribution will enable you to compute +digits of pi. + +@example +> (load "pi.scm") +;loading pi.scm +;done loading pi.scm +# +> (pi 100 5) +00003 14159 26535 89793 23846 26433 83279 50288 41971 69399 +37510 58209 74944 59230 78164 06286 20899 86280 34825 34211 +70679 +;Evaluation took 550 ms (60 in gc) 36976 cells work, 1548.B other +# +@end example + +@subheading Performance + +@noindent +Loading @file{bench.scm} will compute and display performance statistics +of SCM running @file{pi.scm}. @samp{make bench} or @samp{make benchlit} +appends the performance report to the file @file{BenchLog}, facilitating +tracking effects of changes to SCM on performance. + + +@node Problems Starting, Problems Running, Testing, Troubleshooting and Testing +@subsection Problems Starting @multitable @columnfractions .5 .5 @item PROBLEM @tab HOW TO FIX +@item /bin/bash: scm: program not found +@tab Is @samp{scm} in a @samp{$PATH} directory? +@item /bin/bash: /usr/local/bin/scm: Permission denied +@tab @code{chmod +x /usr/local/bin/scm} @item Opening message and then machine crashes. @tab Change memory model option to C compiler (or makefile). @item @@ -1194,49 +1296,8 @@ __x86_64 AMD Opteron @end multitable -@node Testing, Reporting Problems, Problems Running, Installing SCM -@section Testing - -@noindent -Loading @file{r4rstest.scm} in the distribution will run an [R4RS] -conformance test on @code{scm}. - -@example -> (load "r4rstest.scm") -@print{} -;loading "r4rstest.scm" -SECTION(2 1) -SECTION(3 4) - # - # - # - # -@dots{} -@end example - -@noindent -Loading @file{pi.scm} in the distribution will enable you to compute -digits of pi. - -@example -> (load "pi") -;loading "pi" -;done loading "pi.scm" -;Evaluation took 20 ms (0 in gc) 767 cells work, 233.B other -# -> (pi 100 5) -00003 14159 26535 89793 23846 26433 83279 50288 41971 69399 -37510 58209 74944 59230 78164 06286 20899 86280 34825 34211 -70679 -;Evaluation took 550 ms (60 in gc) 36976 cells work, 1548.B other -# -@end example - -@noindent -Loading @file{bench.scm} will compute and display performance statistics -of SCM running @file{pi.scm}. @samp{make bench} or @samp{make benchlit} -appends the performance report to the file @file{BenchLog}, facilitating -tracking effects of changes to SCM on performance. +@node Problems Running, Reporting Problems, Problems Starting, Troubleshooting and Testing +@subsection Problems Running @multitable @columnfractions .5 .5 @item PROBLEM @@ -1268,27 +1329,27 @@ tracking effects of changes to SCM on performance. @item VAX: botched longjmp. @end multitable -@table @asis -@item Sparc(SUN-4) heap is growing out of control -You are experiencing a GC problem peculiar to the Sparc. The problem -is that SCM doesn't know how to clear register windows. Every -location which is not reused still gets marked at GC time. This -causes lots of stuff which should be collected to not be. This will -be a problem with any @emph{conservative} GC until we find what -instruction will clear the register windows. This problem is -exacerbated by using lots of call-with-current-continuations. -A possible fix for dynthrow() is commented out in @file{continue.c}. -@end table +@c @table @asis +@c @item Sparc(SUN-4) heap is growing out of control +@c You are experiencing a GC problem peculiar to the Sparc. The problem +@c is that SCM doesn't know how to clear register windows. Every +@c location which is not reused still gets marked at GC time. This +@c causes lots of stuff which should be collected to not be. This will +@c be a problem with any @emph{conservative} GC until we find what +@c instruction will clear the register windows. This problem is +@c exacerbated by using lots of call-with-current-continuations. +@c A possible fix for dynthrow() is commented out in @file{continue.c}. +@c @end table -@node Reporting Problems, , Testing, Installing SCM -@section Reporting Problems +@node Reporting Problems, , Problems Running, Troubleshooting and Testing +@subsection Reporting Problems @noindent Reported problems and solutions are grouped under Compiling, Linking, -Running, and Testing. If you don't find your problem listed there, you -can send a bug report to @code{agj @@ alum.mit.edu}. The bug report -should include: +Running, and Testing. If you don't find your problem listed there, +you can send a bug report to @code{agj@@alum.mit.edu} or +@code{scm-discuss@@gnu.org}. The bug report should include: @enumerate @item @@ -1634,6 +1695,24 @@ terminal of the process, or #f if this information cannot be determined. For documentation of the procedures @code{getenv} and @code{system} @xref{System Interface, , , slib, SLIB}. +SCM extends @code{getenv} as suggested by draft SRFI-98: + +@defun getenv name +Looks up @var{name}, a string, in the program environment. If @var{name} is +found a string of its value is returned. Otherwise, @code{#f} is returned. +@end defun +@defun getenv +Returns names and values of all the environment variables as an +association-list. + +@example +(getenv) @result{} +(("PATH" . "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin") + ("USERNAME" . "taro")) +@end example +@end defun + + @defun vms-debug If SCM is compiled under VMS this @code{vms-debug} will invoke the VMS debugger. @@ -1647,8 +1726,8 @@ debugger. 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 +@end defun +@defun ed filename If SCM is compiled under VMS @code{ed} will invoke the editor with a single the single argument @var{filename}. @end defun @@ -1734,7 +1813,8 @@ 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 +@end defmac +@defmac 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. @@ -1742,7 +1822,8 @@ list of the traced identifiers. @defmac untrace proc1 @dots{} Turns tracing off for its arguments. -@defmacx untrace +@end defmac +@defmac untrace With no arguments, untraces all currently traced identifiers and returns a list of these formerly traced identifiers. @end defmac @@ -1810,8 +1891,7 @@ offers source code debugging from GNU Emacs. PSD runs slowly, so start by instrumenting only a few functions at a time. @lisp -http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz -swiss.csail.mit.edu:/pub/scm/slib-psd1-3.tar.gz +http://groups.csail.mit.edu/mac/ftpdir/scm/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 @@ -2183,6 +2263,10 @@ Scans all of SCM objects and reclaims for further use those that are no longer accessible. @end defun +@defun gc #t +Garbage-collects only the ecache. +@end defun + @defun room @defunx room #t Prints out statistics about SCM's current use of storage. @code{(room #t)} @@ -2206,8 +2290,8 @@ by calling @code{execpath} with the pathname. 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 +@end defun +@defun execpath #f @defunx execpath newpath Sets the path to @code{#f} or @var{newpath}, respectively. The old path is returned. @@ -2345,7 +2429,7 @@ and MS-DOS. To implement this, I have written the MS-DOS programs: @cindex #! @cindex #!.bat which are available from: -@url{http://swiss.csail.mit.edu/ftpdir/scm/sharpbang.zip} +@url{http://groups.csail.mit.edu/mac/ftpdir/scm/sharpbang.zip} @noindent With these two programs installed in a @code{PATH} directory, we have @@ -2521,10 +2605,14 @@ Many of the optional features are supported as well. @itemx @code{exact->inexact} @itemx @code{inexact->exact} @xref{Numerical operations, , , r5rs, Revised(5) Scheme}. -@itemx @code{with-input-from-file} +@end table +@table @asis +@item @code{with-input-from-file} @itemx @code{with-output-to-file} @xref{Ports, , , r5rs, Revised(5) Scheme}. -@itemx @code{load} +@end table +@table @asis +@item @code{load} @itemx @code{transcript-on} @itemx @code{transcript-off} @xref{System interface, , , r5rs, Revised(5) Scheme}. @@ -2677,7 +2765,7 @@ seconds. Returns the integer time in internal time units from an unspecified starting time. The difference of two calls to @code{get-internal-real-time} divided by -@code{interal-time-units-per-second} will give elapsed real time in +@code{internal-time-units-per-second} will give elapsed real time in seconds. @end defun @@ -2930,8 +3018,8 @@ not open to a file the result is unspecified. Returns the current position of the character in @var{port} which will next be read or written. If @var{port} is open to a non-file then @code{#f} is returned. - -@defunx file-position port k +@end defun +@defun file-position port k Sets the current position in @var{port} which will next be read or written. If successful, @code{#f} is returned. If @var{port} is open to a non-file, then @code{file-position} returns @code{#f}. @@ -3321,8 +3409,8 @@ internal definitions) is a string, then that string is the @defun comment string1 @dots{} Appends @var{string1} @dots{} to the strings given as arguments to previous calls @code{comment}. - -@defunx comment +@end defun +@defun comment Returns the (appended) strings given as arguments to previous calls @code{comment} and empties the current string collection. @end defun @@ -3345,8 +3433,8 @@ read from. The value returned by this function will be the value of @code{#} in which case the expression will be treated as whitespace. @code{#} is the value returned by the expression @code{(if #f #f)}. - -@deffnx {Callback procedure} load:sharp c port +@end deffn +@deffn {Callback procedure} load:sharp c port Dispatches like @code{read:sharp}, but only during @code{load}s. The read-syntaxes handled by @code{load:sharp} are a superset of those handled by @code{read:sharp}. @code{load:sharp} calls @@ -4195,9 +4283,21 @@ The immediate integer closest to negative infinity. The ratio of the circumference to the diameter of a circle. @end defvr +These procedures are in addition to those in +@xref{Irrational Integer Functions, , , slib, SLIB}. + +@defun exact-round x +@defunx exact-floor x +@defunx exact-ceiling x +@defunx exact-truncate x +Return exact integers. +@end defun + @noindent These procedures augment the standard capabilities in @ref{Numerical operations, , ,r5rs, Revised(5) Scheme}. +Many are from +@xref{Irrational Real Functions, , , slib, SLIB}. @defun pi* z @code{(* pi @var{z})} @@ -4228,6 +4328,7 @@ Return the inverse hyperbolic sine, cosine, and tangent of @var{z} @defunx real-asin x @defunx real-acos x @defunx real-atan x +@defunx atan y x @defunx real-sinh x @defunx real-cosh x @@ -4255,6 +4356,12 @@ an error if the value which should be returned by a call to @code{real-expt} is not real. @end defun +@defun infinite? z +@defunx finite? z +All IEEE-754 numbers except positive and negative infinity and NaN +(non-a-number) are finite. +@end defun + @node Arrays, Records, Numeric, Packages @section Arrays @@ -4325,14 +4432,15 @@ an enclosed array will be @code{equal?} but will not in general be enclosed array is unspecified. examples: +@end defun + @example -(enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) @result{} - # +@exdent (enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1) @result{} +@exdent # -(enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) @result{} - # +@exdent (enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) @result{} +@exdent # @end example -@end defun @defun array->list array Returns a list consisting of all the elements, in order, of @var{array}. @@ -4510,13 +4618,15 @@ Modifies @var{bv} by replacing each element with its negation. @end defun @defun bit-set*! bv uve bool -If uve is a bit-vector @var{bv} and uve must be of the same length. If -@var{bool} is @code{#t}, uve is OR'ed into @var{bv}; If @var{bool} is @code{#f}, the -inversion of uve is AND'ed into @var{bv}. +If @var{uve} is a bit-vector, then @var{bv} and @var{uve} must be of +the same length. If @var{bool} is @code{#t}, then @var{uve} is OR'ed +into @var{bv}; If @var{bool} is @code{#f}, the inversion of @var{uve} +is AND'ed into @var{bv}. -If uve is a unsigned integer vector all the elements of uve must be -between 0 and the @code{LENGTH} of @var{bv}. The bits of @var{bv} -corresponding to the indexes in uve are set to @var{bool}. +If @var{uve} is a unsigned integer vector, then all the elements of +@var{uve} must be between 0 and the @code{LENGTH} of @var{bv}. The +bits of @var{bv} corresponding to the indexes in @var{uve} are set to +@var{bool}. The return value is unspecified. @end defun @@ -4718,12 +4828,12 @@ closed,, @code{closedir} returns a @code{#f}. each file in @var{directory}. The dynamic order in which @var{proc} is applied to the filenames is unspecified. The value returned by @samp{directory-for-each} is unspecified. - -@defunx directory-for-each proc directory pred +@end defun +@defun directory-for-each proc directory pred Applies @var{proc} only to those filenames for which the procedure @var{pred} returns a non-false value. - -@defunx directory-for-each proc directory match +@end defun +@defun directory-for-each proc directory match Applies @var{proc} only to those filenames for which @code{(filename:match?? @var{match})} would return a non-false value (@pxref{Filenames, , , slib, SLIB}). @@ -4741,6 +4851,16 @@ Applies @var{proc} only to those filenames for which @end example @end defun +@defun directory*-for-each proc path-glob +@var{path-glob} is a pathname whose last component is a (wildcard) pattern +(@pxref{Filenames, , , slib, SLIB}). +@var{proc} must be a procedure taking one argument. +@samp{directory*-for-each} applies @var{proc} to the (string) name of +each file in the current directory. The dynamic order in which @var{proc} is +applied to the filenames is unspecified. The value returned by +@samp{directory*-for-each} is unspecified. +@end defun + @defun mkdir path mode The @code{mkdir} function creates a new, empty directory whose name is @var{path}. The integer argument @var{mode} specifies the file @@ -4775,6 +4895,12 @@ If the renaming is successful, @code{#t} is returned. Otherwise, @code{#f} is returned. @end defun +@defun copy-file oldfilename newfilename +Copies the file specified by @var{oldfilename} to @var{newfilename}. +If the copying is successful, @code{#t} is returned. Otherwise, +@code{#f} is returned. +@end defun + @defun chmod file mode The function @code{chmod} sets the access permission bits for the file named by @var{file} to @var{mode}. The @var{file} argument may be a @@ -4843,8 +4969,8 @@ as @var{command}. If successful, this procedure does not return. Otherwise an error message is printed and the integer @code{errno} is returned. - -@defunx execv command arglist +@end defun +@defun execv command arglist @defunx execvp command arglist Like @code{execl} and @code{execlp} except that the set of arguments to @var{command} is @var{arglist}. @@ -5123,8 +5249,8 @@ or @code{#f}, indicating that the system default should be used. @defun setpwent #t Rewinds the pw entry table back to the begining. - -@defunx setpwent #f +@end defun +@defun setpwent #f @defunx setpwent Closes the pw table. @end defun @@ -5151,8 +5277,8 @@ A list of (string) names of users in the group. @defun setgrent #t Rewinds the group entry table back to the begining. - -@defunx setgrent #f +@end defun +@defun setgrent #f @defunx setgrent Closes the group table. @end defun @@ -5385,6 +5511,8 @@ to perform one substitution. @node Line Editing, Curses, Regular Expression Pattern Matching, Packages @section Line Editing +@code{(require 'edit-line)} + @noindent These procedures provide input line editing and recall. @@ -5414,9 +5542,9 @@ available from: @end itemize @noindent -When @file{Iedline.scm} is loaded, if the current input port is the -default input port and the environment variable @var{EMACS} is not -defined, line-editing mode will be entered. +When @code{edit-line} package is initialized, if the current input +port is the default input port and the environment variable +@var{EMACS} is not defined, line-editing mode will be entered. @defun default-input-port Returns the initial @code{current-input-port} SCM was invoked with @@ -5435,8 +5563,8 @@ retrieval of history. @defun line-editing Returns the current edited line port or @code{#f}. - -@defunx line-editing bool +@end defun +@defun line-editing bool If @var{bool} is false, exits line-editing mode and returns the previous value of @code{(line-editing)}. If @var{bool} is true, sets the current input and output ports to an edited line port and returns the previous @@ -6290,8 +6418,11 @@ in 2 basic flavors, Immediates and Cells: * Cells:: Non-Immediate types * Header Cells:: Malloc objects * Subr Cells:: Built-in and Compiled Procedures +* Defining Subrs:: * Ptob Cells:: I/O ports +* Defining Ptobs:: * Smob Cells:: Miscellaneous datatypes +* Defining Smobs:: * Data Type Representations:: How they all fit together @end menu @@ -6434,8 +6565,8 @@ The number of ispcsyms and ispcsyms+isyms, respectively. Defined in @code{letrec}, @code{or}, @code{quote}, @code{set!}, @code{#f}, @code{#t}, @code{#}, @code{#}, @code{()}, and @code{#}. - -@deftpx {CAR Immediate} ispcsym +@end deftp +@deftp {CAR Immediate} ispcsym special symbols: syntax-checked versions of first 14 isyms @end deftp @@ -6561,8 +6692,8 @@ Returns the C array of @code{SCM}s holding the elements of vector @deftp Header tc7_ssymbol static scheme symbol (part of initial system) - -@deftpx Header tc7_msymbol +@end deftp +@deftp Header tc7_msymbol @code{malloc}ed scheme symbol (can be GCed) @defmac SYMBOLP x @@ -6670,7 +6801,7 @@ Expands to the length of @var{cclo}. @end deftp -@node Subr Cells, Ptob Cells, Header Cells, Data Types +@node Subr Cells, Defining Subrs, Header Cells, Data Types @subsection Subr Cells @noindent @@ -6742,12 +6873,68 @@ argument is not present, @code{UNDEFINED} is passed in its place. C function of 2 arguments and a list of (rest of) @code{SCM} arguments. @end deftp -@deftp Subr tc7_lsubr -C function of list of @code{SCM} arguments. -@end deftp +@deftp Subr tc7_lsubr +C function of list of @code{SCM} arguments. +@end deftp + + +@node Defining Subrs, Ptob Cells, Subr Cells, Data Types +@subsection Defining Subrs + +@noindent +If @dfn{CCLO} is @code{#define}d when compiling, the compiled closure +feature will be enabled. It is automatically enabled if dynamic linking +is enabled. + +@noindent +The SCM interpreter directly recognizes subrs taking small numbers of +arguments. In order to create subrs taking larger numbers of arguments +use: + +@defun make_gsubr name req opt rest fcn +returns a cclo (compiled closure) object of name @code{char *} +@var{name} which takes @code{int} @var{req} required arguments, +@code{int} @var{opt} optional arguments, and a list of rest arguments if +@code{int} @var{rest} is 1 (0 for not). + +@code{SCM (*fcn)()} is a pointer to a C function to do the work. + +The C function will always be called with @var{req} + @var{opt} + +@var{rest} arguments, optional arguments not supplied will be passed +@code{UNDEFINED}. An error will be signaled if the subr is called with +too many or too few arguments. Currently a total of 10 arguments may be +specified, but increasing this limit should not be difficult. + +@example +/* A silly example, taking 2 required args, + 1 optional, and a list of rest args */ + +#include + +SCM gsubr_21l(req1,req2,opt,rst) + SCM req1,req2,opt,rst; +@{ + lputs("gsubr-2-1-l:\n req1: ", cur_outp); + display(req1,cur_outp); + lputs("\n req2: ", cur_outp); + display(req2,cur_outp); + lputs("\n opt: ", cur_outp); + display(opt,cur_outp); + lputs("\n rest: ", cur_outp); + display(rst,cur_outp); + newline(cur_outp); + return UNSPECIFIED; +@} + +void init_gsubr211() +@{ + make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); +@} +@end example +@end defun -@node Ptob Cells, Smob Cells, Subr Cells, Data Types +@node Ptob Cells, Defining Ptobs, Defining Subrs, Data Types @subsection Ptob Cells @noindent @@ -6820,7 +7007,40 @@ open output-port, respectively. @end defmac -@node Smob Cells, Data Type Representations, Ptob Cells, Data Types +@node Defining Ptobs, Smob Cells, Ptob Cells, Data Types +@subsection Defining Ptobs + +@noindent +@dfn{ptob}s are similar to smobs but define new types of port to which +SCM procedures can read or write. The following functions are defined +in the @code{ptobfuns}: + +@example +typedef struct @{ + SCM (*mark)P((SCM ptr)); + int (*free)P((FILE *p)); + int (*print)P((SCM exp, SCM port, int writing)); + SCM (*equalp)P((SCM, SCM)); + int (*fputc)P((int c, FILE *p)); + int (*fputs)P((char *s, FILE *p)); + sizet (*fwrite)P((char *s, sizet siz, sizet num, FILE *p)); + int (*fflush)P((FILE *stream)); + int (*fgetc)P((FILE *p)); + int (*fclose)P((FILE *p)); +@} ptobfuns; +@end example + +@noindent +The @code{.free} component to the structure takes a @code{FILE *} or +other C construct as its argument, unlike @code{.free} in a smob, which +takes the whole smob cell. Often, @code{.free} and @code{.fclose} can be +the same function. See @code{fptob} and @code{pipob} in @file{sys.c} +for examples of how to define ptobs. +Ptobs that must allocate blocks of memory should use, for example, +@code{must_malloc} rather than @code{malloc} @xref{Allocating memory}. + + +@node Smob Cells, Defining Smobs, Defining Ptobs, Data Types @subsection Smob Cells @noindent @@ -6928,7 +7148,82 @@ VfixZ32, VfixN32, VfloR32, VfloR64, or VfloC64) in their @code{CDR}. @end deftp -@node Data Type Representations, , Smob Cells, Data Types +@node Defining Smobs, Data Type Representations, Smob Cells, Data Types +@subsection Defining Smobs + +@noindent +Here is an example of how to add a new type named @code{@i{foo}} to SCM. +The following lines need to be added to your code: + +@table @code +@item long tc16_@i{foo}; +The type code which will be used to identify the new type. +@item static smobfuns @i{foo}smob = @{mark@i{foo},free@i{foo},print@i{foo},equalp@i{foo}@}; +smobfuns is a structure composed of 4 functions: + +@example +typedef struct @{ + SCM (*mark)P((SCM)); + sizet (*free)P((CELLPTR)); + int (*print)P((SCM exp, SCM port, int writing)); + SCM (*equalp)P((SCM, SCM)); +@} smobfuns; +@end example + +@table @code +@item smob.mark +is a function of one argument of type @code{SCM} (the cell to mark) and +returns type @code{SCM} which will then be marked. If no further +objects need to be marked then return an immediate object such as +@code{BOOL_F}. The smob cell itself will already have been marked. +@emph{Note@:} This is different from SCM versions prior to 5c5. Only +additional data specific to a smob type need be marked by @code{smob.mark}. + + 2 functions are provided: + +@table @code +@item markcdr(ptr) +returns @code{CDR(ptr)}. +@item mark0(ptr) +is a no-op used for smobs containing no additional @code{SCM} data. 0 +may also be used in this case. +@end table + +@item smob.free +is a function of one argument of type @code{CELLPTR} (the cell to +collected) and returns type @code{sizet} which is the number of +@code{malloc}ed bytes which were freed. @code{Smob.free} should free +any @code{malloc}ed storage associated with this object. The function +free0(ptr) is provided which does not free any storage and returns 0. +@item smob.print +is 0 or a function of 3 arguments. The first, of type @code{SCM}, is +the smob object. The second, of type @code{SCM}, is the stream on which +to write the result. The third, of type int, is 1 if the object should +be @code{write}n, 0 if it should be @code{display}ed, and 2 if it should +be @code{write}n for an error report. This function should return non-zero +if it printed, and zero otherwise (in which case a hexadecimal number will +be printed). +@item smob.equalp +is 0 or a function of 2 @code{SCM} arguments. Both of these arguments +will be of type @code{tc16@i{foo}}. This function should return +@code{BOOL_T} if the smobs are equal, @code{BOOL_F} if they are not. If +@code{smob.equalp} is 0, @code{equal?} will return @code{BOOL_F} if they +are not @code{eq?}. +@end table + +@item tc16_@i{foo} = newsmob(&@i{foo}smob); +Allocates the new type with the functions from @code{@i{foo}smob}. This +line goes in an @code{init_} routine. +@end table + +@noindent +Promises and macros in @file{eval.c} and arbiters in @file{repl.c} +provide examples of SMOBs. There are a maximum of 256 SMOBs. +Smobs that must allocate blocks of memory should use, for example, +@code{must_malloc} rather than @code{malloc} @xref{Allocating memory}. + + +@node Data Type Representations, , Defining Smobs, Data Types @subsection Data Type Representations @format @@ -6954,20 +7249,20 @@ ssymbol .........long length....G0000101 ..........char *chars........... msymbol .........long length....G0000111 ..........char *chars........... string .........long length....G0001101 ..........char *chars........... vector .........long length....G0001111 ...........SCM **elts........... -Vbool .........long length....G0010101 ..........long *words........... - spare 00010111 -VfixN8 .........long length....G0011101 ......unsigned char *words...... -VfixZ8 .........long length....G0011111 ..........char *words........... -VfixN16 .........long length....G0100101 ......unsigned short *words..... -VfixZ16 .........long length....G0100111 ........ short *words........... -VfixN32 .........long length....G0101101 ......unsigned long *words...... -VfixZ32 .........long length....G0101111 ..........long *words........... +VfixN8 .........long length....G0010101 ......unsigned char *words...... +VfixZ8 .........long length....G0010111 ..........char *words........... +VfixN16 .........long length....G0011101 ......unsigned short *words..... +VfixZ16 .........long length....G0011111 ........ short *words........... +VfixN32 .........long length....G0100101 ......unsigned medium *words.... +VfixZ32 .........long length....G0100111 ........medium *words........... +VfixN64 .........long length....G0101101 ......unsigned long *words...... +VfixZ64 .........long length....G0101111 ..........long *words........... VfloR32 .........long length....G0110101 .........float *words........... VfloC32 .........long length....G0110111 .........float *words........... VfloR64 .........long length....G0111101 ........double *words........... VfloC64 .........long length....G0111111 ........double *words........... - spare 01000101 +Vbool .........long length....G1000101 ..........long *words........... contin .........long length....G1001101 .............*regs.............. specfun ................xxxxxxxxG1001111 ...........SCM name............. cclo ..short length..xxxxxx10G1001111 ...........SCM **elts...........} @@ -7016,12 +7311,12 @@ array ...short rank..cxxxxxxxxG1111111 ............*array..............} @menu * Garbage Collection:: Automatically reclaims unused storage * Memory Management for Environments:: +* Dynamic Linking Support:: +* Configure Module Catalog:: +* Automatic C Preprocessor Definitions:: * Signals:: * C Macros:: * Changing Scm:: -* Defining Subrs:: -* Defining Smobs:: -* Defining Ptobs:: * Allocating memory:: * Embedding SCM:: In other programs * Callbacks:: @@ -7117,7 +7412,7 @@ object is freed. If the type header of smob is collected, the smob's @end deftypefun -@node Memory Management for Environments, Signals, Garbage Collection, Operations +@node Memory Management for Environments, Dynamic Linking Support, Garbage Collection, Operations @subsection Memory Management for Environments @ifset html @@ -7219,19 +7514,226 @@ and swept almost like any ordinary segment of the general purpose heap. The only difference is that pairs from the copying heap that become free during a sweep phase are not added to the freelist. -@cindex NO_ENV_CACHE -The environment cache is disabled by adding @code{#define NO_ENV_CACHE} -to @file{eval.c}; all environment cells are then allocated from the -regular heap. +@cindex NO_ENV_CACHE +The environment cache is disabled by adding @code{#define NO_ENV_CACHE} +to @file{eval.c}; all environment cells are then allocated from the +regular heap. + +@subsubheading Relation to Other Work + +This work seems to build upon a considerable amount of previous work +into garbage collection techniques about which a considerable amount +of literature is available. + + +@node Dynamic Linking Support, Configure Module Catalog, Memory Management for Environments, Operations +@subsection Dynamic Linking Support + +@noindent +Dynamic linking has not been ported to all platforms. Operating systems +in the BSD family (a.out binary format) can usually be ported to +@dfn{DLD}. The @dfn{dl} library (@code{#define SUN_DL} for SCM) was a +proposed POSIX standard and may be available on other machines with +@dfn{COFF} binary format. For notes about porting to MS-Windows and +finishing the port to VMS @ref{VMS Dynamic Linking}. + +@noindent +@dfn{DLD} is a library package of C functions that performs +@dfn{dynamic link editing} on GNU/Linux, VAX (Ultrix), Sun 3 (SunOS +3.4 and 4.0), SPARCstation (SunOS 4.0), Sequent Symmetry (Dynix), and +Atari ST. It is available from: + +@ifclear html +@itemize @bullet +@item +ftp.gnu.org:pub/gnu/dld-3.3.tar.gz +@end itemize +@end ifclear + +@ifset html + +ftp.gnu.org:pub/gnu/dld-3.3.tar.gz + +@end ifset + +@noindent +These notes about using libdl on SunOS are from @file{gcc.info}: + +@quotation +On a Sun, linking using GNU CC fails to find a shared library and +reports that the library doesn't exist at all. + +This happens if you are using the GNU linker, because it does only +static linking and looks only for unshared libraries. If you have +a shared library with no unshared counterpart, the GNU linker +won't find anything. + +We hope to make a linker which supports Sun shared libraries, but +please don't ask when it will be finished--we don't know. + +Sun forgot to include a static version of @file{libdl.a} with some +versions of SunOS (mainly 4.1). This results in undefined symbols when +linking static binaries (that is, if you use @samp{-static}). If you +see undefined symbols @samp{_dlclose}, @samp{_dlsym} or @samp{_dlopen} +when linking, compile and link against the file +@file{mit/util/misc/dlsym.c} from the MIT version of X windows. +@end quotation + + +@node Configure Module Catalog, Automatic C Preprocessor Definitions, Dynamic Linking Support, Operations +@subsection 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 Automatic C Preprocessor Definitions, Signals, Configure Module Catalog, Operations +@subsection Automatic C Preprocessor Definitions + +These @samp{#defines} are automatically provided by preprocessors of +various C compilers. SCM uses the presence or absence of these +definitions to configure @dfn{include file} locations and aliases for +library functions. If the definition(s) corresponding to your system +type is missing as your system is configured, add @code{-D@var{flag}} to +the compilation command lines or add a @code{#define @var{flag}} line to +@file{scmfig.h} or the beginning of @file{scmfig.h}. + +@example +#define Platforms: +------- ---------- +ARM_ULIB Huw Rogers free unix library for acorn archimedes +AZTEC_C Aztec_C 5.2a +__CYGWIN__ Cygwin +__CYGWIN32__ Cygwin +_DCC Dice C on AMIGA +__GNUC__ Gnu CC (and DJGPP) +__EMX__ Gnu C port (gcc/emx 0.8e) to OS/2 2.0 +__HIGHC__ MetaWare High C +__IBMC__ C-Set++ on OS/2 2.1 +_MSC_VER MS VisualC++ 4.2 +MWC Mark Williams C on COHERENT +__MWERKS__ Metrowerks Compiler; Macintosh and WIN32 (?) +_POSIX_SOURCE ?? +_QC Microsoft QuickC +__STDC__ ANSI C compliant +__TURBOC__ Turbo C and Borland C +__USE_POSIX ?? +__WATCOMC__ Watcom C on MS-DOS +__ZTC__ Zortech C -@subsubheading Relation to Other Work +_AIX AIX operating system +__APPLE__ Apple Darwin +AMIGA SAS/C 5.10 or Dice C on AMIGA +__amigaos__ Gnu CC on AMIGA +atarist ATARI-ST under Gnu CC +__DragonflyBSD__ DragonflyBSD +__FreeBSD__ FreeBSD +GNUDOS DJGPP (obsolete in version 1.08) +__GO32__ DJGPP (future?) +hpux HP-UX +linux GNU/Linux +macintosh Macintosh (THINK_C and __MWERKS__ define) +MCH_AMIGA Aztec_c 5.2a on AMIGA +__MACH__ Apple Darwin +__MINGW32__ MinGW - Minimalist GNU for Windows +MSDOS Microsoft C 5.10 and 6.00A +_MSDOS Microsoft CLARM and CLTHUMB compilers. +__MSDOS__ Turbo C, Borland C, and DJGPP +__NetBSD__ NetBSD +nosve Control Data NOS/VE +__OpenBSD__ OpenBSD +SVR2 System V Revision 2. +sun SunOS +__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 and Cygwin (Win32 API) +_WIN32_WCE MS Windows CE +vms (and VMS) VAX-11 C under VMS. -This work seems to build upon a considerable amount of previous work -into garbage collection techniques about which a considerable amount -of literature is available. +__alpha DEC Alpha processor +__alpha__ DEC Alpha processor +__hppa__ HP RISC processor +hp9000s800 HP RISC processor +__ia64 GCC on IA64 +__ia64__ GCC on IA64 +_LONGLONG GCC on IA64 +__i386__ DJGPP +i386 DJGPP +_M_ARM Microsoft CLARM compiler defines as 4 for ARM. +_M_ARMT Microsoft CLTHUMB compiler defines as 4 for Thumb. +MULTIMAX Encore computer +ppc PowerPC +__ppc__ PowerPC +pyr Pyramid 9810 processor +__sgi__ Silicon Graphics Inc. +sparc SPARC processor +sequent Sequent computer +tahoe CCI Tahoe processor +vax VAX processor +__x86_64 AMD Opteron +@end example -@node Signals, C Macros, Memory Management for Environments, Operations +@node Signals, C Macros, Automatic C Preprocessor Definitions, Operations @subsection Signals @cindex signals @@ -7262,8 +7764,8 @@ occurs during a time when @code{ints_disabled} is 1, then @code{deferred_proc} is set to non-zero, one of the global variables @code{SIGINT_deferred} or @code{SIGALRM_deferred} is set to 1, and the handler returns. - -@defmacx ALLOW_INTS +@end defmac +@defmac ALLOW_INTS Checks the deferred variables and if set the appropriate handler is called. @@ -7317,7 +7819,7 @@ a call to @code{wta(arg, pos, subr)}. @end defmac -@node Changing Scm, Defining Subrs, C Macros, Operations +@node Changing Scm, Allocating memory, C Macros, Operations @subsection Changing Scm @noindent @@ -7488,171 +7990,7 @@ New syntax can now be added without recompiling SCM by the use of the @xref{Syntax}. -@node Defining Subrs, Defining Smobs, Changing Scm, Operations -@subsection Defining Subrs - -@noindent -If @dfn{CCLO} is @code{#define}d when compiling, the compiled closure -feature will be enabled. It is automatically enabled if dynamic linking -is enabled. - -@noindent -The SCM interpreter directly recognizes subrs taking small numbers of -arguments. In order to create subrs taking larger numbers of arguments -use: - -@defun make_gsubr name req opt rest fcn -returns a cclo (compiled closure) object of name @code{char *} -@var{name} which takes @code{int} @var{req} required arguments, -@code{int} @var{opt} optional arguments, and a list of rest arguments if -@code{int} @var{rest} is 1 (0 for not). - -@code{SCM (*fcn)()} is a pointer to a C function to do the work. - -The C function will always be called with @var{req} + @var{opt} + -@var{rest} arguments, optional arguments not supplied will be passed -@code{UNDEFINED}. An error will be signaled if the subr is called with -too many or too few arguments. Currently a total of 10 arguments may be -specified, but increasing this limit should not be difficult. - -@example -/* A silly example, taking 2 required args, - 1 optional, and a list of rest args */ - -#include - -SCM gsubr_21l(req1,req2,opt,rst) - SCM req1,req2,opt,rst; -@{ - lputs("gsubr-2-1-l:\n req1: ", cur_outp); - display(req1,cur_outp); - lputs("\n req2: ", cur_outp); - display(req2,cur_outp); - lputs("\n opt: ", cur_outp); - display(opt,cur_outp); - lputs("\n rest: ", cur_outp); - display(rst,cur_outp); - newline(cur_outp); - return UNSPECIFIED; -@} - -void init_gsubr211() -@{ - make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); -@} -@end example -@end defun - - -@node Defining Smobs, Defining Ptobs, Defining Subrs, Operations -@subsection Defining Smobs - -@noindent -Here is an example of how to add a new type named @code{@i{foo}} to SCM. -The following lines need to be added to your code: - -@table @code -@item long tc16_@i{foo}; -The type code which will be used to identify the new type. -@item static smobfuns @i{foo}smob = @{mark@i{foo},free@i{foo},print@i{foo},equalp@i{foo}@}; -smobfuns is a structure composed of 4 functions: - -@example -typedef struct @{ - SCM (*mark)P((SCM)); - sizet (*free)P((CELLPTR)); - int (*print)P((SCM exp, SCM port, int writing)); - SCM (*equalp)P((SCM, SCM)); -@} smobfuns; -@end example - -@table @code -@item smob.mark -is a function of one argument of type @code{SCM} (the cell to mark) and -returns type @code{SCM} which will then be marked. If no further -objects need to be marked then return an immediate object such as -@code{BOOL_F}. The smob cell itself will already have been marked. -@emph{Note@:} This is different from SCM versions prior to 5c5. Only -additional data specific to a smob type need be marked by @code{smob.mark}. - - 2 functions are provided: - -@table @code -@item markcdr(ptr) -returns @code{CDR(ptr)}. -@item mark0(ptr) -is a no-op used for smobs containing no additional @code{SCM} data. 0 -may also be used in this case. -@end table - -@item smob.free -is a function of one argument of type @code{CELLPTR} (the cell to -collected) and returns type @code{sizet} which is the number of -@code{malloc}ed bytes which were freed. @code{Smob.free} should free -any @code{malloc}ed storage associated with this object. The function -free0(ptr) is provided which does not free any storage and returns 0. -@item smob.print -is 0 or a function of 3 arguments. The first, of type @code{SCM}, is -the smob object. The second, of type @code{SCM}, is the stream on which -to write the result. The third, of type int, is 1 if the object should -be @code{write}n, 0 if it should be @code{display}ed, and 2 if it should -be @code{write}n for an error report. This function should return non-zero -if it printed, and zero otherwise (in which case a hexadecimal number will -be printed). -@item smob.equalp -is 0 or a function of 2 @code{SCM} arguments. Both of these arguments -will be of type @code{tc16@i{foo}}. This function should return -@code{BOOL_T} if the smobs are equal, @code{BOOL_F} if they are not. If -@code{smob.equalp} is 0, @code{equal?} will return @code{BOOL_F} if they -are not @code{eq?}. -@end table - -@item tc16_@i{foo} = newsmob(&@i{foo}smob); -Allocates the new type with the functions from @code{@i{foo}smob}. This -line goes in an @code{init_} routine. -@end table - -@noindent -Promises and macros in @file{eval.c} and arbiters in @file{repl.c} -provide examples of SMOBs. There are a maximum of 256 SMOBs. -Smobs that must allocate blocks of memory should use, for example, -@code{must_malloc} rather than @code{malloc} @xref{Allocating memory}. - - -@node Defining Ptobs, Allocating memory, Defining Smobs, Operations -@subsection Defining Ptobs - -@noindent -@dfn{ptob}s are similar to smobs but define new types of port to which -SCM procedures can read or write. The following functions are defined -in the @code{ptobfuns}: - -@example -typedef struct @{ - SCM (*mark)P((SCM ptr)); - int (*free)P((FILE *p)); - int (*print)P((SCM exp, SCM port, int writing)); - SCM (*equalp)P((SCM, SCM)); - int (*fputc)P((int c, FILE *p)); - int (*fputs)P((char *s, FILE *p)); - sizet (*fwrite)P((char *s, sizet siz, sizet num, FILE *p)); - int (*fflush)P((FILE *stream)); - int (*fgetc)P((FILE *p)); - int (*fclose)P((FILE *p)); -@} ptobfuns; -@end example - -@noindent -The @code{.free} component to the structure takes a @code{FILE *} or -other C construct as its argument, unlike @code{.free} in a smob, which -takes the whole smob cell. Often, @code{.free} and @code{.fclose} can be -the same function. See @code{fptob} and @code{pipob} in @file{sys.c} -for examples of how to define ptobs. -Ptobs that must allocate blocks of memory should use, for example, -@code{must_malloc} rather than @code{malloc} @xref{Allocating memory}. - - -@node Allocating memory, Embedding SCM, Defining Ptobs, Operations +@node Allocating memory, Embedding SCM, Changing Scm, Operations @subsection Allocating memory SCM maintains a count of bytes allocated using malloc, and calls the garbage collector when that number exceeds a dynamically managed limit. @@ -8011,8 +8349,8 @@ any messages from error calls by @code{scm_addr}. @code{scm_addr} is useful for performing C operations on strings or other uniform arrays (@pxref{Uniform Array}). - -@deftypefunx unsigned long scm_base_addr(SCM @var{ra}, char *@var{s_name}) +@end deftypefun +@deftypefun unsigned long scm_base_addr(SCM @var{ra}, char *@var{s_name}) Returns a pointer (cast to an @code{unsigned long}) to the beginning of storage of array @var{ra}. Note that if @var{ra} is a shared-array, the strorage accessed this way may be much larger than diff --git a/scmfig.h b/scmfig.h old mode 100644 new mode 100755 index a8e8667..07b91f4 --- a/scmfig.h +++ b/scmfig.h @@ -403,39 +403,6 @@ rgx.c init_rgx(); regcomp and regexec. */ # endif #endif -/* Define BIGDIG to an integer type whose size is smaller than long if - you want bignums. BIGRAD is one greater than the biggest BIGDIG. */ -/* Define DIGSTOOBIG if the digits equivalent to a long won't fit in a long. */ -#ifdef BIGNUMS -# ifdef _UNICOS -# define DIGSTOOBIG -# if (1L << 31) <= USHRT_MAX -# define BIGDIG unsigned short -# else -# define BIGDIG unsigned int -# endif -# define BITSPERDIG 32 -# else -# define BIGDIG unsigned short -# define BITSPERDIG (sizeof(BIGDIG)*CHAR_BIT) -# endif -# define BIGRAD (1L << BITSPERDIG) -# define DIGSPERLONG ((sizet)((sizeof(long)*CHAR_BIT+BITSPERDIG-1)/BITSPERDIG)) -# define BIGUP(x) ((unsigned long)(x) << BITSPERDIG) -# define BIGDN(x) ((x) >> BITSPERDIG) -# define BIGLO(x) ((x) & (BIGRAD-1)) -/* NUMDIGS_MAX is the maximum number of digits for BIGNUMS */ -# ifndef NUMDIGS_MAX -# define NUMDIGS_MAX 1000 -# endif -#endif - -#ifndef BIGDIG -# ifndef FLOATS -# define INUMS_ONLY -# endif -#endif - #ifndef __builtin_expect # ifndef __GNUC__ # define __builtin_expect(expr, expected) (expr) @@ -630,6 +597,45 @@ extern ints_infot *ints_info; #endif #define INTBUFLEN (5+LONG_BIT) +/* Define BIGDIG to an integer type whose size is smaller than long if + you want bignums. BIGRAD is one greater than the biggest BIGDIG. */ +/* Define DIGSTOOBIG if the digits equivalent to a long won't fit in a long. */ +#ifdef BIGNUMS +# define SBIGLONG long +# define UBIGLONG unsigned SBIGLONG +# ifdef _UNICOS +# define DIGSTOOBIG +# if (1L << 31) <= USHRT_MAX +# define BIGDIG unsigned short +# else +# define BIGDIG unsigned int +# endif +# define BITSPERDIG 32 +# else +# if INT_MAX < LONG_MAX +# define BIGDIG unsigned int +# else +# define BIGDIG unsigned short +# endif +# endif +# define BITSPERDIG (sizeof(BIGDIG)*CHAR_BIT) +# define BIGRAD (1L << BITSPERDIG) +# define DIGSPERLONG ((sizet)((sizeof(UBIGLONG))/sizeof(BIGDIG))) +# define BIGUP(x) (((UBIGLONG)(x)) << BITSPERDIG) +# define BIGDN(x) (((UBIGLONG)(x)) >> BITSPERDIG) +# define BIGLO(x) ((x) & (BIGRAD-1L)) +/* NUMDIGS_MAX is the maximum number of digits for BIGNUMS */ +# ifndef NUMDIGS_MAX +# define NUMDIGS_MAX 1000 +# endif +#endif + +#ifndef BIGDIG +# ifndef FLOATS +# define INUMS_ONLY +# endif +#endif + /* FLOBUFLEN is the maximum number of characters neccessary for the printed or string representation of an inexact number. */ @@ -747,6 +753,10 @@ typedef SCM *SCMPTR; # endif #endif +#ifdef __APPLE__ +# include +#endif + #ifdef macintosh # include #endif @@ -805,7 +815,7 @@ typedef SCM *SCMPTR; #endif #define SCM_OPENCALL(line) {int gcs = 0;\ - while (!0) {errno = 0; if (line) break;\ + while (!0) {errno = 0; if ((line)) break;\ if (0==gcs++ && SCM_NEED_FDS(errno)) \ gc_for_open_files();\ else if (!SCM_INTERRUPTED(errno)) break;}} diff --git a/scmhob.h b/scmhob.h old mode 100644 new mode 100755 index 59b16f4..66d3f6b --- a/scmhob.h +++ b/scmhob.h @@ -41,12 +41,14 @@ #define VECTOR_LENGTH(v) MAKINUM(LENGTH(v)) #ifdef FLOATS -#include +# include +#else +# define scm_abs scm_iabs #endif #ifdef BIGDIG -#define PRE_TRANSC_FUN(x) (INUMP(x) ? (double) INUM(x) : (REALP(x) ? (double) REALPART(x) : (double) big2dbl(x))) +# define PRE_TRANSC_FUN(x) (INUMP(x) ? (double) INUM(x) : (REALP(x) ? (double) REALPART(x) : (double) big2dbl(x))) #else -#define PRE_TRANSC_FUN(x) (INUMP(x) ? (double) INUM(x) : (double) REALPART(x)) +# define PRE_TRANSC_FUN(x) (INUMP(x) ? (double) INUM(x) : (double) REALPART(x)) #endif #define SIN_FUN(x) (makdbl( sin( PRE_TRANSC_FUN(x)), 0.0)) diff --git a/scmhob.scm b/scmhob.scm old mode 100644 new mode 100755 diff --git a/scmmain.c b/scmmain.c old mode 100644 new mode 100755 index 85e2e09..ace196d --- a/scmmain.c +++ b/scmmain.c @@ -143,7 +143,7 @@ int main(argc, argv) #ifdef CAREFUL_INTS 1 #else - 1 /* freeall || (2 <= verbose) */ /* Free storage when we're done. */ + 1 /* freeall || (2 <= scm_verbose) */ /* Free storage when we're done. */ #endif ); if (2 <= iverbose) fputs(";EXIT\n", stderr); diff --git a/script.c b/script.c old mode 100644 new mode 100755 diff --git a/setjump.h b/setjump.h old mode 100644 new mode 100755 diff --git a/setjump.mar b/setjump.mar old mode 100644 new mode 100755 diff --git a/setjump.s b/setjump.s old mode 100644 new mode 100755 diff --git a/socket.c b/socket.c old mode 100644 new mode 100755 diff --git a/split.scm b/split.scm old mode 100644 new mode 100755 diff --git a/subr.c b/subr.c old mode 100644 new mode 100755 index 95eed21..57e035a --- a/subr.c +++ b/subr.c @@ -1,5 +1,5 @@ /* "subr.c" integer and other Scheme procedures - * Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. + * Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2013 Free Software Foundation, Inc. * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as @@ -36,9 +36,10 @@ static char s_symbol2string[] = "symbol->string", extern char s_inexactp[]; #define s_exactp (s_inexactp+2) static char s_oddp[] = "odd?", s_evenp[] = "even?"; -static char s_quotient[] = "quotient", +static char s_rquotient[] = "round-quotient", s_remainder[] = "remainder", s_modulo[] = "modulo"; static char s_gcd[] = "gcd"; +#define s_quotient (s_rquotient+6) static char s_ci_eq[] = "char-ci=?", s_ch_lessp[] = "char 1) */ + /* printf("%s / %s\n", */ + /* CHARS(number2string(num, MAKINUM(10))), */ + /* CHARS(number2string(den, MAKINUM(10)))); */ +#ifdef BIGDIG + if (NINUMP(num)) { + long w; + ASRTER(NIMP(num) && BIGP(num), num, ARG1, s_rquotient); + if (NINUMP(den)) { + ASRTGO(NIMP(den) && BIGP(den), badden); + return divbigbig(BDIGITS(num), NUMDIGS(num), BDIGITS(den), NUMDIGS(den), + BIGSIGN(num) ^ BIGSIGN(den), 3); + } + if (!(quo = INUM(den))) goto ov; + if (1==quo) return num; + /* divbigdig() hasn't been extended to perform rounding */ + /* if (quo < 0) quo = -quo; */ + /* if (quo < BIGRAD) { */ + /* w = copybig(num, BIGSIGN(num) ? (den>0) : (den<0)); */ + /* divbigdig(BDIGITS(w), NUMDIGS(w), (BIGDIG)quo); */ + /* return normbig(w); */ + /* } */ +# ifndef DIGSTOOBIG + w = pseudolong(quo); + return divbigbig(BDIGITS(num), NUMDIGS(num), (BIGDIG *)&w, DIGSPERLONG, + BIGSIGN(num) ? (den>0) : (den<0), 3); +# else + { BIGDIG quodigs[DIGSPERLONG]; + longdigs(quo, quodigs); + return divbigbig(BDIGITS(num), NUMDIGS(num), quodigs, DIGSPERLONG, + BIGSIGN(num) ? (den>0) : (den<0), 3); + } +# endif + } + if (NINUMP(den)) { +# ifndef RECKLESS + if (!(NIMP(den) && BIGP(den))) + badden: wta(den, (char *)ARG2, s_rquotient); +# endif + if (NUMDIGS(den) > DIGSPERLONG || + (NUMDIGS(den)==DIGSPERLONG && BDIGITS(den)[DIGSPERLONG-1] >= BIGRAD/2)) + return INUM0; + quo = num2long(den, (char *)ARG2, s_rquotient); + rem = INUM(num)%quo; + if (labs(2*rem) > labs(quo)) + return MAKINUM(((INUM(num) < 0)==(quo < 0)) ? 1 : -1); + else return INUM0; + } +#else + ASRTER(INUMP(num), num, ARG1, s_rquotient); + ASRTER(INUMP(den), den, ARG2, s_rquotient); +#endif + if ((quo = INUM(den))==0) + ov: wta(den, (char *)OVFLOW, s_rquotient); + quo = INUM(num)/quo; + { +# if (__TURBOC__==1) + rem = ((den<0) ? -INUM(num) : INUM(num))%INUM(den); +# else + rem = INUM(num)%INUM(den); +# endif +#ifdef BADIVSGNS + if (rem==0) ; + else if (rem < 0) { + if (num < 0) ; + else quo--; + } else if (num < 0) quo++; +#endif + if ((1 & quo) + ? labs(2*rem) >= labs(INUM(den)) + : labs(2*rem) > labs(INUM(den))) + quo = quo + (((INUM(num) < 0)==(INUM(den) < 0)) ? 1 : -1); + } + if (!FIXABLE(quo)) +#ifdef BIGDIG + return long2big(quo); +#else + wta(num, (char *)OVFLOW, s_rquotient); +#endif + return MAKINUM(quo); +} + +/* SCM scm_round_quotient(num, den) */ +/* SCM num, den; */ +/* { */ +/* SCM quo = lquotient(num, den); */ +/* SCM rem = lremainder(num, den); */ +/* if (BOOL_T==((BOOL_T==evenp(quo) ? greaterp : greqp) */ +/* (scm_ash(scm_iabs(rem), MAKINUM(1L)), scm_iabs(den)))) */ +/* quo = sum(quo, MAKINUM(negativep(num)==negativep(den) ? 1L : -1L)); */ +/* return quo; */ +/* } */ + SCM lquotient(x, y) SCM x, y; { @@ -319,8 +418,7 @@ SCM lquotient(x, y) return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), BIGSIGN(x) ^ BIGSIGN(y), 2); } - z = INUM(y); - ASRTGO(z, ov); + if (!(z = INUM(y))) goto ov; if (1==z) return x; if (z < 0) z = -z; if (z < BIGRAD) { @@ -458,9 +556,9 @@ SCM lgcd(x, y) SCM x, y; { register long u, v, k, t; - tailrec: if (UNBNDP(y)) return UNBNDP(x) ? INUM0 : x; #ifdef BIGDIG + tailrec: if (NINUMP(x)) { big_gcd: ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_gcd); @@ -567,7 +665,7 @@ SCM scm_big_ior P((BIGDIG *x, sizet nx, int xsgn, SCM bigy)); SCM scm_big_and P((BIGDIG *x, sizet nx, int xsgn, SCM bigy, int zsgn)); SCM scm_big_xor P((BIGDIG *x, sizet nx, int xsgn, SCM bigy)); SCM scm_big_test P((BIGDIG *x, sizet nx, int xsgn, SCM bigy)); -SCM scm_big_ash P((SCM x, long cnt)); +SCM scm_big_ash P((SCM x, int cnt)); SCM scm_copy_big_dec(b, sign) SCM b; @@ -770,8 +868,6 @@ static SCM scm_copy_big_2scomp(x, blen, sign) sizet i; if (INUMP(x)) { long lx = INUM(x); - if (nres < (LONG_BIT + BITSPERDIG - 1)/BITSPERDIG) - nres = (LONG_BIT + BITSPERDIG - 1)/BITSPERDIG; res = mkbig(nres, sign); rds = BDIGITS(res); if (lx < 0) { @@ -848,15 +944,13 @@ static void scm_2scomp1(b) SCM scm_big_ash(x, cnt) SCM x; - long cnt; + int cnt; { SCM res; - BIGDIG *resds; - unsigned long d; - int sign, ishf; - long i, fshf, blen, n; + BIGDIG *resds, d; + int sign, i, ishf, fshf, blen, n; if (INUMP(x)) { - blen = LONG_BIT; + blen = INUM(scm_intlength(x)); sign = INUM(x) < 0 ? 0x0100 : 0; } else { @@ -871,12 +965,13 @@ SCM scm_big_ash(x, cnt) resds = BDIGITS(res); n = NUMDIGS(res) - ishf - 1; for (i = 0; i < n; i++) { - d = (resds[i + ishf]>>fshf) | - ((resds[i + ishf + 1])<<(BITSPERDIG - fshf) & (BIGRAD - 1)); + d = (resds[i + ishf]>>fshf); + if (fshf) + d |= ((resds[i + ishf + 1])<<(BITSPERDIG - fshf) & (BIGRAD - 1)); resds[i] = d; } d = (resds[i + ishf]>>fshf); - if (sign) d |= ((BIGRAD - 1)<<(BITSPERDIG - fshf) & (BIGRAD - 1)); + if (sign && fshf) d |= ((BIGRAD - 1)<<(BITSPERDIG - fshf) & (BIGRAD - 1)); resds[i] = d; n = NUMDIGS(res); d = sign ? BIGRAD - 1 : 0; @@ -888,16 +983,18 @@ SCM scm_big_ash(x, cnt) fshf = cnt % BITSPERDIG; res = scm_copy_big_2scomp(x, blen + cnt, sign); resds = BDIGITS(res); - for (i = NUMDIGS(res) - 1; i > ishf; i--) { - d = (((resds[i - ishf])<>(BITSPERDIG - fshf)); - resds[i] = d; - } - d = (((resds[i - ishf])<1){for (i=NUMDIGS(res); i--;) printf(" %08x",resds[i]); printf("\n");} */ + for (i = NUMDIGS(res) - 1; i > ishf; i--) + if (fshf) { + d = (((resds[i - ishf])<>(BITSPERDIG - fshf)); + resds[i] = d; + } else resds[i] = resds[i - ishf]; + d = fshf ? (((resds[i - ishf])<= 0; i--) - resds[i] = 0; + for (i--; i >= 0; i--) resds[i] = 0; } + /* if (scm_verbose>1){for (i=NUMDIGS(res); i--;) printf(" %08x",resds[i]); printf("\n");} */ if (sign) scm_2scomp1(res); return normbig(res); } @@ -1170,17 +1267,18 @@ SCM scm_lognot(n) SCM scm_ash(n, cnt) SCM n, cnt; { - SCM res = INUM(n); + SCM res; + long ni = INUM(n); + int icnt = INUM(cnt); ASRTER(INUMP(cnt), cnt, ARG2, s_ash); - cnt = INUM(cnt); if (INUMP(n)) { - if (cnt < 0) { - if (-cnt >= LONG_BIT) return INUM0; - return MAKINUM(SRS(res, -cnt)); + if (icnt < 0) { + if (-icnt >= LONG_BIT) return INUM0; + return MAKINUM(SRS(ni, -icnt)); } - if (cnt >= LONG_BIT) goto ovflow; - res = MAKINUM(res<>cnt != INUM(n)) + if (icnt >= LONG_BIT) goto ovflow; + res = MAKINUM(ni<>icnt != INUM(n)) goto ovflow; else return res; @@ -1188,8 +1286,8 @@ SCM scm_ash(n, cnt) #ifdef BIGDIG ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_ash); ovflow: - if (0==cnt) return n; - return scm_big_ash(n, cnt); + if (0==icnt) return n; + return scm_big_ash(n, icnt); #else ovflow: wta(n, INUMP(n) ? (char *)OVFLOW : (char *)ARG1, s_ash); @@ -1201,10 +1299,11 @@ SCM scm_bitfield(n, start, end) SCM n, start, end; { int sign; + int istart = INUM(start); + int iend = INUM(end); ASRTER(INUMP(start), start, ARG2, s_bitfield); ASRTER(INUMP(end), end, ARG3, s_bitfield); - start = INUM(start); end = INUM(end); - ASRTER(end >= start, MAKINUM(end), OUTOFRANGE, s_bitfield); + ASRTER(iend >= istart, MAKINUM(iend), OUTOFRANGE, s_bitfield); #ifdef BIGDIG if (NINUMP(n)) { BIGDIG *ds; @@ -1212,29 +1311,29 @@ SCM scm_bitfield(n, start, end) ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_bitfield); sign = BIGSIGN(n); big: - if (sign) n = scm_copy_big_2scomp(n, (sizet)end, 0); - n = scm_big_ash(n, -start); + if (sign) n = scm_copy_big_2scomp(n, (sizet)iend, 0); + n = scm_big_ash(n, -istart); if (INUMP(n)) { - if (end - start >= LONG_BIT - 2) return n; - return MAKINUM(INUM(n) & ((1L<<(end - start)) - 1)); + if (iend - istart >= LONG_BIT - 2) return n; + return MAKINUM(INUM(n) & ((1L<<(iend - istart)) - 1)); } nd = NUMDIGS(n); ds = BDIGITS(n); - i = (end - start) / BITSPERDIG; + i = (iend - istart) / BITSPERDIG; if (i >= nd) return n; - ds[i] &= ((1 << ((end - start) % BITSPERDIG)) - 1); + ds[i] &= ((1 << ((iend - istart) % BITSPERDIG)) - 1); for (++i; i < nd; i++) ds[i] = 0; return normbig(n); } - if (end >= LONG_BIT - 2) { + if (iend >= LONG_BIT - 2) { sign = INUM(n) < 0; goto big; } #else ASRTER(INUMP(n), n, ARG1, s_bitfield); - ASRTER(end < LONG_BIT - 2, MAKINUM(end), OUTOFRANGE, s_bitfield); + ASRTER(iend < LONG_BIT - 2, MAKINUM(iend), OUTOFRANGE, s_bitfield); #endif - return MAKINUM((INUM(n)>>start) & ((1L<<(end - start)) - 1)); + return MAKINUM((INUM(n)>>istart) & ((1L<<(iend - istart)) - 1)); } SCM scm_bitif(mask, n0, n1) @@ -1298,8 +1397,12 @@ SCM scm_bitwise_bit_count(n) if (NINUMP(n)) { sizet i; BIGDIG *ds, d; ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_bitwise_bit_count); - if (BIGSIGN(n)) - return scm_lognot(scm_bitwise_bit_count(difference(MAKINUM(-1L), n))); + if (BIGSIGN(n)) { + SCM df = difference(MAKINUM(-1L), n); + SCM bc = scm_bitwise_bit_count(df); + bigrecy(df); + return scm_lognot(bc); + } ds = BDIGITS(n); for (i = NUMDIGS(n); i--; ) for (d = ds[i]; d; d >>= 4) c += logtab[15 & d]; @@ -1325,7 +1428,12 @@ SCM scm_logcount(n) #ifdef BIGDIG if (NINUMP(n)) { ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_logcount); - if (BIGSIGN(n)) return scm_bitwise_bit_count(difference(MAKINUM(-1L), n)); + if (BIGSIGN(n)) { + SCM df = difference(MAKINUM(-1L), n); + SCM bc = scm_bitwise_bit_count(df); + bigrecy(df); + return bc; + } return scm_bitwise_bit_count(n); } #else @@ -1347,7 +1455,12 @@ SCM scm_intlength(n) if (NINUMP(n)) { BIGDIG *ds, d; ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_intlength); - if (BIGSIGN(n)) return scm_intlength(difference(MAKINUM(-1L), n)); + if (BIGSIGN(n)) { + SCM df = difference(MAKINUM(-1L), n); + SCM si = scm_intlength(df); + bigrecy(df); + return si; + } ds = BDIGITS(n); d = ds[c = NUMDIGS(n)-1]; for (c *= BITSPERDIG; d; d >>= 4) {c += 4; l = ilentab[15 & d];} @@ -1761,6 +1874,7 @@ SCM mkbig(nlen, sign) ALLOW_INTS; return v; } +/* big2inum() frees bignum b when it returns an INUM */ SCM big2inum(b, l) SCM b; sizet l; @@ -1769,9 +1883,14 @@ SCM big2inum(b, l) BIGDIG *tmp = BDIGITS(b); while (l--) num = BIGUP(num) + tmp[l]; if (TYP16(b)==tc16_bigpos) { - if (POSFIXABLE(num)) return MAKINUM(num); + if (POSFIXABLE(num)) { + bigrecy(b); + return MAKINUM(num); + }} + else if (UNEGFIXABLE(num)) { + bigrecy(b); + return MAKINUM(-(long)num); } - else if (UNEGFIXABLE(num)) return MAKINUM(-(long)num); return b; } char s_adjbig[] = "adjbig"; @@ -1824,7 +1943,7 @@ SCM long2big(n) if (n < 0) n = -n; while (i < DIGSPERLONG) { digits[i++] = BIGLO(n); - n = BIGDN((unsigned long)n); + n = BIGDN(n); } return ans; } @@ -1853,7 +1972,7 @@ int bigcomp(x, y) if (ysign > xsign) return -1; if ((ylen = NUMDIGS(y)) > (xlen = NUMDIGS(x))) return (xsign) ? -1 : 1; if (ylen < xlen) return (xsign) ? 1 : -1; - while(xlen-- && (BDIGITS(y)[xlen]==BDIGITS(x)[xlen])); + while (xlen-- && (BDIGITS(y)[xlen]==BDIGITS(x)[xlen])); if (-1==xlen) return 0; return (BDIGITS(y)[xlen] > BDIGITS(x)[xlen]) ? (xsign ? -1 : 1) : (xsign ? 1 : -1); @@ -1890,7 +2009,7 @@ SCM addbig(x, nx, xsgn, bigy, sgny) sizet nx; /* Assumes nx <= NUMDIGS(bigy) */ int xsgn, sgny; /* Assumes xsgn and sgny equal either 0 or 0x0100 */ { - long num = 0; + SBIGLONG num = 0; sizet i = 0, ny = NUMDIGS(bigy); SCM z = copybig(bigy, BIGSIGN(bigy) ^ sgny); BIGDIG *zds = BDIGITS(z); @@ -1938,7 +2057,7 @@ SCM mulbig(x, nx, y, ny, sgn) int sgn; { sizet i = 0, j = nx + ny; - unsigned long n = 0; + UBIGLONG n = 0; SCM z = mkbig(j, sgn); BIGDIG *zds = BDIGITS(z); while (j--) zds[j] = 0; @@ -1946,7 +2065,7 @@ SCM mulbig(x, nx, y, ny, sgn) j = 0; if (x[i]) { do { - n += zds[i + j] + ((unsigned long) x[i] * y[j]); + n += zds[i + j] + ((UBIGLONG) x[i] * y[j]); zds[i + j++] = BIGLO(n); n = BIGDN(n); } while (j < ny); @@ -1955,12 +2074,12 @@ SCM mulbig(x, nx, y, ny, sgn) } while (++i < nx); return normbig(z); } -unsigned int divbigdig(ds, h, div) +UBIGLONG divbigdig(ds, h, div) BIGDIG *ds; sizet h; BIGDIG div; { - register unsigned long t2 = 0; + register UBIGLONG t2 = 0L; while(h--) { t2 = BIGUP(t2) + ds[h]; ds[h] = t2 / div; @@ -1975,7 +2094,7 @@ SCM divbigint(x, z, sgn, mode) { if (z < 0) z = -z; if (z < BIGRAD) { - register unsigned long t2 = 0; + register UBIGLONG t2 = 0; register BIGDIG *ds = BDIGITS(x); sizet nd = NUMDIGS(x); while(nd--) t2 = (BIGUP(t2) + ds[nd]) % z; @@ -1984,7 +2103,7 @@ SCM divbigint(x, z, sgn, mode) } { # ifndef DIGSTOOBIG - unsigned long t2 = pseudolong(z); + UBIGLONG t2 = pseudolong(z); return divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&t2, DIGSPERLONG, sgn, mode); # else @@ -1994,108 +2113,180 @@ SCM divbigint(x, z, sgn, mode) # endif } } -SCM divbigbig(x, nx, y, ny, sgn, modes) + +static SCM scm_copy_big_ash1 P((BIGDIG *xds, sizet xlen, BIGDIG dscl)); +/* Make a copy of 2*xds and divide by dscl if dscl > 0 */ +SCM scm_copy_big_ash1 (xds, xlen, dscl) + BIGDIG *xds; + sizet xlen; + BIGDIG dscl; +{ + sizet rlen = xlen + 1, i; + SCM dencell = mkbig(rlen, 0); + BIGDIG *dends = BDIGITS(dencell); + dends[xlen] = xds[xlen-1]>>(BITSPERDIG - 1); + for (i = xlen - 1; i > 0; i--) + dends[i] = (((xds[i])<<1) & (BIGRAD - 1)) + | ((xds[i-1])>>(BITSPERDIG - 1)); + dends[0] = (((xds[0])<<1) & (BIGRAD - 1)); + while(rlen && !dends[rlen-1]) rlen--; + if (dscl) { + divbigdig(dends, rlen, dscl); + while(rlen && !dends[rlen-1]) rlen--; + } + SETNUMDIGS(dencell, rlen, TYP16(dencell)); + return dencell; +} + +SCM divbigbig(x, xlen, y, ylen, sgn, mode) BIGDIG *x, *y; - sizet nx, ny; - int sgn, modes; - /* modes description + sizet xlen, ylen; + int sgn, mode; + /* mode description 0 remainder 1 modulo 2 quotient - 3 quotient but returns 0 if division is not exact. */ -{ - sizet i = 0, j = 0; - long num = 0; - unsigned long t2 = 0; - SCM z, newy; - BIGDIG d = 0, qhat, *zds, *yds; - /* algorithm requires nx >= ny */ - if (nx < ny) - switch (modes) { + 3 quotient with round-toward-even + 4 quotient but returns NULL if division is not exact. */ +{ + int roundup = 0; /* used for round-quotient */ + sizet i = 0, j = 0; /* loop indexes */ + SBIGLONG dds = 0; /* double-digit signed */ + UBIGLONG ddu = 0; /* double-digit unsigned */ + SCM quocell, dencell; + sizet rlen; + BIGDIG *quods, /* quotient digits */ + *dends, /* scaled denominator digits */ + dscl = 0, /* unscale quotient from scaled divisor */ + qhat; + while(!y[ylen-1]) ylen--; /* in case y came in as a psuedolong */ + if (xlen < ylen) + switch (mode) { case 0: /* remainder -- just return x */ - z = mkbig(nx, sgn); zds = BDIGITS(z); - do {zds[i] = x[i];} while (++i < nx); - return z; + quocell = mkbig(xlen, sgn); quods = BDIGITS(quocell); + do {quods[i] = x[i];} while (++i < xlen); + return quocell; case 1: /* modulo -- return y-x */ - z = mkbig(ny, sgn); zds = BDIGITS(z); + quocell = mkbig(ylen, sgn); quods = BDIGITS(quocell); do { - num += (long) y[i] - x[i]; - if (num < 0) {zds[i] = num + BIGRAD; num = -1;} - else {zds[i] = num; num = 0;} - } while (++i < nx); - while (i < ny) { - num += y[i]; - if (num < 0) {zds[i++] = num + BIGRAD; num = -1;} - else {zds[i++] = num; num = 0;} + dds += (long) y[i] - x[i]; + if (dds < 0) {quods[i] = dds + BIGRAD; dds = -1;} + else {quods[i] = dds; dds = 0;} + } while (++i < xlen); + while (i < ylen) { + dds += y[i]; + if (dds < 0) {quods[i++] = dds + BIGRAD; dds = -1;} + else {quods[i++] = dds; dds = 0;} } goto doadj; case 2: return INUM0; /* quotient is zero */ - case 3: return 0; /* the division is not exact */ + case 3: /* round-toward-even */ + /* Use dencell and dends variables to double the numerator */ + dencell = scm_copy_big_ash1(x, xlen, dscl); + dends = BDIGITS(dencell); + rlen = NUMDIGS(dencell); + if (rlen < ylen) return INUM0;; + if (rlen > ylen) goto retone; + i = rlen; + while (i-- && (y[i]==dends[i])); + if (-1==i || (y[i] > dends[i])) return INUM0; + retone: + return MAKINUM(sgn ? -1 : 1); + case 4: return 0; /* the division is not exact */ } - - z = mkbig(nx==ny ? nx+2 : nx+1, sgn); zds = BDIGITS(z); - if (nx==ny) zds[nx+1] = 0; - while(!y[ny-1]) ny--; /* in case y came in as a psuedolong */ - if (y[ny-1] < (BIGRAD>>1)) { /* normalize operands */ - d = BIGRAD/(y[ny-1]+1); - newy = mkbig(ny, 0); yds = BDIGITS(newy); - while(j < ny) - {t2 += (unsigned long) y[j]*d; yds[j++] = BIGLO(t2); t2 = BIGDN(t2);} - y = yds; j = 0; t2 = 0; - while(j < nx) - {t2 += (unsigned long) x[j]*d; zds[j++] = BIGLO(t2); t2 = BIGDN(t2);} - zds[j] = t2; + /* main algorithm requires xlen >= ylen */ + quocell = mkbig(xlen==ylen ? xlen+2 : xlen+1, sgn); quods = BDIGITS(quocell); + if (xlen==ylen) quods[xlen+1] = 0; + if (y[ylen-1] < (BIGRAD>>1)) { /* normalize operands */ + dscl = BIGRAD/(y[ylen-1]+1); + dencell = mkbig(ylen, 0); dends = BDIGITS(dencell); + while(j < ylen) { + ddu += (UBIGLONG) y[j]*dscl; + dends[j++] = BIGLO(ddu); ddu = BIGDN(ddu); + } + j = 0; ddu = 0; /* y = dends; */ + while(j < xlen) { + ddu += (UBIGLONG) x[j]*dscl; + quods[j++] = BIGLO(ddu); ddu = BIGDN(ddu); + } + quods[j] = ddu; + } else { + dends = y; + quods[j = xlen] = 0; + while (j--) quods[j] = x[j]; } - else {zds[j = nx] = 0; while (j--) zds[j] = x[j];} - j = nx==ny ? nx+1 : nx; /* dividend needs more digits than divisor */ + j = xlen==ylen ? xlen+1 : xlen; /* dividend needs more digits than divisor */ do { /* loop over digits of quotient */ - if (zds[j]==y[ny-1]) qhat = BIGRAD-1; - else qhat = (BIGUP(zds[j]) + zds[j-1])/y[ny-1]; + if (quods[j]==dends[ylen-1]) qhat = BIGRAD-1; + else qhat = (BIGUP(quods[j]) + quods[j-1])/dends[ylen-1]; if (!qhat) continue; - i = 0; num = 0; t2 = 0; + i = 0; dds = 0; ddu = 0; do { /* multiply and subtract */ - t2 += (unsigned long) y[i] * qhat; - num += zds[j - ny + i] - BIGLO(t2); - if (num < 0) {zds[j - ny + i] = num + BIGRAD; num = -1;} - else {zds[j - ny + i] = num; num = 0;} - t2 = BIGDN(t2); - } while (++i < ny); - num += zds[j - ny + i] - t2; /* borrow from high digit; don't update */ - while (num) { /* "add back" required */ - i = 0; num = 0; qhat--; + ddu += (UBIGLONG) dends[i] * qhat; + dds += quods[j - ylen + i] - BIGLO(ddu); + if (dds < 0) {quods[j - ylen + i] = dds + BIGRAD; dds = -1;} + else {quods[j - ylen + i] = dds; dds = 0;} + ddu = BIGDN(ddu); + } while (++i < ylen); + dds += quods[j - ylen + i] - ddu; /* borrow from high digit; don't update */ + while (dds) { /* "add back" required */ + i = 0; dds = 0; qhat--; do { - num += (long) zds[j - ny + i] + y[i]; - zds[j - ny + i] = BIGLO(num); - num = BIGDN(num); - } while (++i < ny); - num--; + dds += (long) quods[j - ylen + i] + dends[i]; + quods[j - ylen + i] = BIGLO(dds); + dds = BIGDN(dds); + } while (++i < ylen); + dds--; + } + if (mode >= 2) quods[j] = qhat; /* returning quotient */ + } while (--j >= ylen); + switch (mode) { + case 4: /* check that remainder==0 */ + for (j = ylen;j && !quods[j-1];--j) ; if (j) return 0; + case 3: /* round toward even */ + /* Reuse dencell and dends variables to double the remainder */ + dencell = scm_copy_big_ash1(quods, ylen, dscl); + dends = BDIGITS(dencell); + rlen = NUMDIGS(dencell); + if (rlen > ylen) roundup = 1; + else if (rlen < ylen) ; + else { + i = rlen; + while (i-- && (y[i]==dends[i])); + if (-1==i) { + if (0==roundup && quods[ylen] & 1) roundup = 1; + } else if (y[i] < dends[i]) roundup = 1; + } + case 2: /* move quotient down in quocell */ + j = (xlen==ylen ? xlen+2 : xlen+1) - ylen; + for (i = 0;i < j;i++) quods[i] = quods[i+ylen]; + ylen = i; + if (roundup) { + i = 0; dds = 1; + while (i < ylen) { + dds += quods[i]; + quods[i++] = BIGLO(dds); + dds = BIGDN(dds); + if (!dds) break; + } } - if (modes & 2) zds[j] = qhat; - } while (--j >= ny); - switch (modes) { - case 3: /* check that remainder==0 */ - for (j = ny;j && !zds[j-1];--j) ; if (j) return 0; - case 2: /* move quotient down in z */ - j = (nx==ny ? nx+2 : nx+1) - ny; - for (i = 0;i < j;i++) zds[i] = zds[i+ny]; - ny = i; break; case 1: /* subtract for modulo */ - i = 0; num = 0; j = 0; - do {num += y[i] - zds[i]; - j = j | zds[i]; - if (num < 0) {zds[i] = num + BIGRAD; num = -1;} - else {zds[i] = num; num = 0;} - } while (++i < ny); + i = 0; dds = 0; j = 0; + do {dds += dends[i] - quods[i]; + j = j | quods[i]; + if (dds < 0) {quods[i] = dds + BIGRAD; dds = -1;} + else {quods[i] = dds; dds = 0;} + } while (++i < ylen); if (!j) return INUM0; case 0: /* just normalize remainder */ - if (d) divbigdig(zds, ny, d); + if (dscl) divbigdig(quods, ylen, dscl); } doadj: - for (j = ny;j && !zds[j-1];--j) ; + for (j = ylen;j && !quods[j-1];--j) ; if (j * BITSPERDIG <= sizeof(SCM)*CHAR_BIT) - if (INUMP(z = big2inum(z, j))) return z; - return adjbig(z, j); + if (INUMP(quocell = big2inum(quocell, j))) return quocell; + return adjbig(quocell, j); } #endif @@ -2158,6 +2349,8 @@ static iproc subr2s[] = { {s_assq, assq}, {s_assoc, assoc}, {s_quotient, lquotient}, + /* {"rq", rq}, */ + {s_rquotient, scm_round_quotient}, {s_remainder, lremainder}, {s_modulo, modulo}, {s_logtest, scm_logtest}, diff --git a/syntest1.scm b/syntest1.scm old mode 100644 new mode 100755 diff --git a/syntest2.scm b/syntest2.scm old mode 100644 new mode 100755 diff --git a/sys.c b/sys.c old mode 100644 new mode 100755 index bfef80e..d837d30 --- a/sys.c +++ b/sys.c @@ -69,6 +69,7 @@ char s_nogrow[] = "could not grow", s_heap[] = "heap", static char s_segs[] = "segments", s_numheaps[] = "number of heaps"; static char s_input_portp[] = "input-port?", s_output_portp[] = "output-port?"; +#define s_portp (&s_input_portp[6]) static char s_port_closedp[] = "port-closed?"; static char s_try_open_file[] = "try-open-file"; #define s_open_file (&s_try_open_file[4]) @@ -211,6 +212,12 @@ SCM close_port(port) ALLOW_INTS; return ret; } +SCM scm_portp(x) + SCM x; +{ + if (IMP(x)) return BOOL_F; + return PORTP(x) ? BOOL_T : BOOL_F; +} SCM input_portp(x) SCM x; { @@ -256,7 +263,9 @@ SCM scm_port_type(port) SCM ltmpnam() { char name[L_tmpnam]; - SYSCALL(tmpnam(name);); + char* ret; + SYSCALL(ret = tmpnam(name);); + if (! ret) return BOOL_F; return makfrom0str(name); } #else @@ -549,7 +558,7 @@ static int sfputc(c, p) } sizet sfwrite(str, siz, num, p) sizet siz, num; - char *str; SCM p; + const void *str; SCM p; { SCM sstr; sstr = makfromstr(str, siz * num); @@ -558,7 +567,7 @@ sizet sfwrite(str, siz, num, p) return num; } static int sfputs(s, p) - char *s; SCM p; + const char *s; SCM p; { sfwrite(s, 1, strlen(s), p); return 0; @@ -723,6 +732,12 @@ static int sysputc(c, p) syswrite(&cc, 1, 1, p); return c; } +static int sysflush(p) + FILE *p; +{ + syswrite("", 0, 0, p); + return 0; +} static ptobfuns sysptob = { 0, mark0, @@ -732,7 +747,7 @@ static ptobfuns sysptob = { sysputc, sysputs, syswrite, - noop0, + sysflush, noop0, noop0}; @@ -1178,6 +1193,7 @@ static iproc subr0s[] = { static iproc subr1s[] = { {s_input_portp, input_portp}, {s_output_portp, output_portp}, + {s_portp, scm_portp}, {s_port_closedp, port_closedp}, {s_close_port, close_port}, {"eof-object?", eof_objectp}, @@ -1358,6 +1374,13 @@ SCM symhash; /* This used to be a sys_protect, but Radey Shouman added GC for unused, UNDEFINED symbols.*/ +int no_symhash_gc = +#ifdef NO_SYM_GC + !0 /* Hobbit-compiled code must not GC symhash. */ +#else + 0 +#endif + ; int symhash_dim = NUM_HASH_BUCKETS; /* sym2vcell looks up the symbol in the symhash table. */ SCM sym2vcell(sym) @@ -2063,6 +2086,13 @@ void init_storage(stack_start_ptr, init_heap_size) scm_estk = BOOL_F; scm_port_table = 0; scm_port_table_len = 0; + no_symhash_gc = +#ifdef NO_SYM_GC + !0 /* Hobbit-compiled code must not GC symhash. */ +#else + 0 +#endif + ; #ifdef SHORT_SIZET if (sizeof(sizet) >= sizeof(long)) @@ -2334,17 +2364,17 @@ void igc(what, basecont) gc_start(what); if (errjmp_bad) wta(UNDEFINED, s_recursive, s_gc); errjmp_bad = s_gc; -#ifdef NO_SYM_GC - gc_mark(symhash); -#else - /* 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 - opposed to the vector or bucket lists). */ - mark_syms(symhash); - /* mark_sym_values() can be called anytime after mark_syms. */ - mark_sym_values(symhash); -#endif + if (no_symhash_gc) /* Hobbit-compiled code needs this. */ + gc_mark(symhash); + else { + /* 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 + opposed to the vector or bucket lists). */ + mark_syms(symhash); + /* mark_sym_values() can be called anytime after mark_syms. */ + mark_sym_values(symhash); + } mark_subrs(); egc_mark(); if (stackbase) { @@ -2382,9 +2412,8 @@ void igc(what, basecont) while(j--) gc_mark(sys_protects[j]); mark_finalizers(&gc_finalizers, &gc_finalizers_pending); -#ifndef NO_SYM_GC - sweep_symhash(symhash); -#endif + if (!no_symhash_gc) /* if not Hobbit-compiled code. */ + sweep_symhash(symhash); gc_sweep(!stackbase); sweep_port_table(); egc_sweep(); @@ -2422,7 +2451,8 @@ void free_storage() heap_cells -= seg_cells; free((char *)hplims[hplim_ind]); hplims[hplim_ind] = 0; - growth_mon(s_heap, heap_cells, s_cells, 0); fflush(stderr); + /* At this point, sys_errp is no longer valid */ + /* growth_mon(s_heap, heap_cells, s_cells, 0); fflush(stderr); */ }} if (heap_cells) wta(MAKINUM(heap_cells), s_not_free, s_heap); if (hplim_ind) wta((SCM)MAKINUM(hplim_ind), s_not_free, s_hplims); @@ -2435,10 +2465,10 @@ void free_storage() scm_free_gra(&finals_gra); scm_free_gra(&smobs_gra); scm_free_gra(&subrs_gra); - gc_end(); - ALLOW_INTS; /* A really bad idea, but printing does it anyway. */ - exit_report(); - lfflush(sys_errp); + /* gc_end(); */ + /* ALLOW_INTS; */ /* A really bad idea, but printing does it anyway. */ + /* exit_report(); */ + /* lfflush(sys_errp); */ /* This causes segfault in fc9 */ scm_free_gra(&ptobs_gra); lmallocated = mallocated = 0; /* Can't do gc_end() here because it uses ptobs which have been freed */ @@ -2477,7 +2507,9 @@ void gc_mark(p) case tcs_cons_nimcar: if (GCMARKP(ptr)) break; SETGCMARK(ptr); - if (IMP(CDR(ptr))) { /* IMP works even with a GC mark */ + if (IMP(CDR(ptr)) /* IMP works even with a GC mark */ + || (CONSP(GCCDR(ptr)) && GCMARKP(GCCDR(ptr))) + ) { ptr = CAR(ptr); goto gc_mark_nimp; } @@ -2536,12 +2568,10 @@ void gc_mark(p) ASRTER(!(CHARS(ptr)[HUGE_LENGTH(ptr)]), MAKINUM(HUGE_LENGTH(ptr)), s_wrong_length, s_gc); case tc7_ssymbol: + case tc7_VfixN8: case tc7_VfixZ8: case tc7_VfixZ16: case tc7_VfixN16: + case tc7_VfixZ32: case tc7_VfixN32: case tc7_VfixZ64: case tc7_VfixN64: + case tc7_VfloR32: case tc7_VfloC32: case tc7_VfloR64: case tc7_VfloC64: case tc7_Vbool: - case tc7_VfixZ32: case tc7_VfixN32: - case tc7_VfixZ16: case tc7_VfixN16: - case tc7_VfixN8: case tc7_VfixZ8: - case tc7_VfloR32: case tc7_VfloC32: - case tc7_VfloR64: case tc7_VfloC64: SETGC8MARK(ptr); case tcs_subrs: break; @@ -2807,7 +2837,6 @@ static void gc_sweep(contin_bad) lmallocated = lmallocated - gc_malloc_collected; } -#ifndef NO_SYM_GC /* mark_syms marks those symbols of hash table V which have non-UNDEFINED values. */ static void mark_syms(v) @@ -2880,7 +2909,6 @@ static void sweep_symhash(v) VELTS(v)[k] &= ~1L; /* We may have deleted the first cell */ } } -#endif /* This function should be called after all other marking is done. */ static void mark_finalizers(finalizers, pending) diff --git a/time.c b/time.c old mode 100644 new mode 100755 index 575518e..7789e92 --- a/time.c +++ b/time.c @@ -104,7 +104,6 @@ #ifdef __OpenBSD__ # include # include -# include # define USE_GETTIMEOFDAY #endif #ifdef __TURBOC__ @@ -308,18 +307,40 @@ SCM your_time() #else /* LACK_FTIME */ # ifdef USE_GETTIMEOFDAY int scm_ftime(time_buffer) - struct timeb *time_buffer; + struct timeval *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; + struct timezone t_z; + if (gettimeofday(time_buffer, &t_z) < 0) return -1; return 0;} + +struct timeval your_base = {0, 0}; +# define TIMETRIES 10 +SCM your_time() +{ + long tmp; + struct timeval time_buffer1; + struct timeval time_buffer2; + int cnt = 0; + tryagain: + cnt++; + scm_ftime(&time_buffer1); + scm_ftime(&time_buffer2); + if (time_buffer1.tv_sec==time_buffer2.tv_sec) { + if (time_buffer1.tv_usec > time_buffer2.tv_usec) + time_buffer2.tv_sec = time_buffer2.tv_sec + 1; + } + else if ((1 + time_buffer1.tv_sec)==time_buffer2.tv_sec) ; + else if (cnt < TIMETRIES) goto tryagain; + else { /* could not read two ftime()s within one second in 10 tries */ + scm_warn("ftime()s too fast", "", MAKINUM(TIMETRIES)); + return MAKINUM(-1); + } + tmp = CLKTCK*(time_buffer2.tv_usec - your_base.tv_usec); + tmp = CLKTCK*(time_buffer2.tv_sec - your_base.tv_sec) + tmp/1000000; + return MAKINUM(tmp); +} # else /* USE_GETTIMEOFDAY */ # define scm_ftime ftime -# endif /* USE_GETTIMEOFDAY */ struct timeb your_base = {0}; # define TIMETRIES 10 SCM your_time() @@ -346,6 +367,7 @@ SCM your_time() tmp = CLKTCK*(time_buffer2.time - your_base.time) + tmp/1000; return MAKINUM(tmp); } +# endif /* USE_GETTIMEOFDAY */ #endif /* LACK_FTIME */ long my_base = 0; diff --git a/turtle b/turtle deleted file mode 100644 index c35625d..0000000 --- a/turtle +++ /dev/null @@ -1,20 +0,0 @@ -#define turtle_width 40 -#define turtle_height 40 -static char turtle_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, - 0xff, 0x00, 0x00, 0x00, 0xe0, 0x84, 0x07, 0x00, 0x00, 0x10, 0x0c, 0x78, - 0x00, 0x00, 0x0c, 0x08, 0xc0, 0x00, 0x00, 0x02, 0x18, 0x40, 0x03, 0x00, - 0x01, 0x28, 0x40, 0x02, 0x80, 0x0f, 0xcc, 0x7f, 0x02, 0xc0, 0xf8, 0x07, - 0x10, 0x06, 0x40, 0x00, 0x04, 0x30, 0x0c, 0x60, 0x00, 0x04, 0x7c, 0x08, - 0xf8, 0x00, 0x04, 0xc2, 0x0f, 0x8c, 0x01, 0x0f, 0x01, 0x0b, 0x26, 0x01, - 0xf1, 0x01, 0x11, 0x03, 0x81, 0x01, 0x81, 0x20, 0x07, 0x83, 0x80, 0x80, - 0x40, 0x9a, 0x83, 0x00, 0x8f, 0xf8, 0x42, 0xc6, 0xff, 0xe3, 0x0f, 0x7e, - 0x63, 0x18, 0x22, 0x00, 0xc0, 0x31, 0xf0, 0x13, 0x00, 0x00, 0x11, 0x00, - 0x11, 0x00, 0x00, 0x0f, 0x00, 0x1b, 0x00, 0x00, 0x06, 0x00, 0x0e, 0x0e, - 0x00, 0x00, 0x00, 0x80, 0x09, 0x00, 0x00, 0x00, 0xc0, 0x88, 0x00, 0x00, - 0x00, 0x00, 0xff, 0x00, 0x00, 0x02, 0x00, 0x08, 0x00, 0x00, 0x05, 0x38, - 0x08, 0x00, 0x80, 0x08, 0x44, 0x08, 0x00, 0x40, 0x04, 0x44, 0x08, 0x00, - 0x20, 0x02, 0x48, 0x04, 0x00, 0x10, 0x01, 0x70, 0x06, 0x00, 0x88, 0x00, - 0xc0, 0x01, 0x00, 0x44, 0x00, 0x40, 0x00, 0x00, 0x22, 0x0e, 0x40, 0x00, - 0x00, 0x11, 0x0a, 0x40, 0x00, 0x00, 0x09, 0x0c, 0x40, 0x00, 0x80, 0x06, - 0x3e, 0x20, 0x00, 0x80, 0xf1, 0xc1, 0x1f, 0x00}; diff --git a/turtlegr.c b/turtlegr.c deleted file mode 100644 index c0245c8..0000000 --- a/turtlegr.c +++ /dev/null @@ -1,1298 +0,0 @@ - -/* file turtlegr.c * - * Copyright (C) 1992 sjm@ee.tut.fi * - * jtl@cc.tut.fi * - * * - * Turtlegraphics primitives for the * - * SCM interpreter by Aubrey Jaffer * - * * - * Last modification: 13.10.1992 * - * * - * Versions: * - * 12.3.1992 The first version. * - * 13.3.1992 Added the possibility to pass * - * floating point args. * - * 15.3.1992 Graphics cards other than EGA * - * are now supported. * - * 9.4.1992 The internal representation * - * of X & Y is now float. * - * 13.10.1992 Added X11 support. * - * A major rewrite of certain * - * parts. * - * Put -DX11 -DFLOATS to CFLAGS * - * in Makefile to get it. * - * * - * REMEMBER to define INITS=init_turtlegr() * - * in the Makefile. * - * */ - -/* * - * This code tries to compromise between two very different * - * systems: MSDOS and UNIX with the X11 windowing system. * - * The MSDOS version was build first and it really shows. :) * - * The X port is a partial rewrite of the old MSDOS stuff * - * and plays around with #ifdef's a lot. The result is, * - * eventually, a C source which is expected to compile * - * under both MSDOS and UNIX (X11). * - * The X code handles colors emulating CGA palette. It tries * - * to act sensibly even on a monochrome screen and when the * - * color palette is full. * - * X event handling is implemented with polling whenever * - * appropriate. This is not The Right Way to do it in X, but * - * it was easiest to adopt in this case. * - * Another solution would have been to make the X graphics * - * a separate process, but I didn't want to because I wanted * - * to keep it simple. I can't tell how good an example of porting * - * MSDOS software to X this is, but it works. * - * * - * This has been tested with SunOs 4.1.2 with X11R5, Linux 0.98.1 * - * with Xfree86 1.1 (X11R5 port) and in MSDOS with BC 3.1. * - * Because the code uses only the basic Xlib calls, it should * - * compile without problems under _any_ UNIX with X11R4 or newer. * - * * - * Please send bugreports to sjm@ee.tut.fi. * - * I'm especially interested in hearing about ports to other * - * platforms than those tested by me. * - * * - * - sjm * - * */ - - -/****************************************************/ -/***** GENERIC includes & defines *****/ -/****************************************************/ -#include "scm.h" /* includes scmfig.h as well */ -#include "patchlvl.h" /* Guess... */ -#include /* sin(), cos(), fmod() */ -#include /* atexit() */ - -/****************************************************/ -/***** X11 specific includes & defines *****/ -/****************************************************/ -#ifdef X11 - -/* Xlib include files */ -# include -# include -# include -# include - -# include "turtle" -# define BITMAPDEPTH 1 - -# define PROGNAME "scm" -# define CLASSNAME "Scm" -# define WINDOWNAME "TurtleSCM graphics window" -# define ICONNAME "TurtleSCM" - -# define GR_MAX_XSIZE 1024 -# define GR_MAX_YSIZE 1024 -# define GR_DEF_XSIZE 640 -# define GR_DEF_YSIZE 480 -# define GR_MIN_XSIZE 64 -# define GR_MIN_YSIZE 64 - -/* Fake CGA colormap with X - yuk! */ -# define GR_COLORS 16 /* CGA/EGA counterpart */ -# define GR_COLOR00 "black" /* black */ -# define GR_COLOR01 "blue2" /* blue */ -# define GR_COLOR02 "green2" /* green */ -# define GR_COLOR03 "cyan2" /* cyan */ -# define GR_COLOR04 "red3" /* red */ -# define GR_COLOR05 "magenta2" /* magenta */ -# define GR_COLOR06 "yellow2" /* brown */ -# define GR_COLOR07 "light gray" /* white */ -# define GR_COLOR08 "gray" /* gray */ -# define GR_COLOR09 "blue1" /* light blue */ -# define GR_COLOR10 "green1" /* light green */ -# define GR_COLOR11 "cyan1" /* light cyan */ -# define GR_COLOR12 "red1" /* light red */ -# define GR_COLOR13 "magenta1" /* light magenta */ -# define GR_COLOR14 "yellow1" /* yellow */ -# define GR_COLOR15 "white" /* bright white */ - -# ifdef __STDC__ -static void gr_events( int ); -# else -static void gr_events(); -# endif - -#else -/****************************************************/ -/***** PC specific includes & defines *****/ -/****************************************************/ -# include -# include /* for getenv() */ -# include /* for fputs() */ -# define BGIDIR_ENVSTRING "BGIDIR" -#endif - -/********************************************/ -/***** GENERIC code, declarations *****/ -/********************************************/ -#define SIN( x ) \ - sin( ((x)/180.0) * M_PI ) -#define COS( x ) \ - cos( ((x)/180.0) * M_PI ) - -static int gr_graphicsavail = 0; -static int gr_grmode_on = 0; -static float gr_dir = 0.0; -static int gr_max_x=0, gr_max_y=0, gr_max_color=0; -static float gr_x=0.0, gr_y=0.0; -static int gr_color = 0; - -static char s_gr_draw[] = "draw"; -static char s_gr_move[] = "move"; -static char s_gr_setcolor[] = "set-color!"; -static char s_gr_turnright[] = "turn-right"; -static char s_gr_turnleft[] = "turn-left"; -static char s_gr_turnto[] = "turn-to!"; - -static char s_gr_getdot[] = "get-dot"; -static char s_gr_drawTo[] = "draw-to!"; -static char s_gr_drawto[] = "draw-to"; -static char s_gr_moveTo[] = "move-to!"; - -static char s_gr_setdot[] = "set-dot!"; -static char s_gr_validXYC[] = "valid-xyc?"; - -#ifdef __GNUC__ -inline -#else -static -#endif -int valid_XYC( x, y, color ) -int x, y, color; -{ -#ifdef X11 - /* Check for changed window size */ - gr_events(0); -#endif - if( (x <= gr_max_x) && (y <= gr_max_y) && (color <= gr_max_color) - && (x >= 0) && (y >= 0) && (color >= 0) ) - return( 1 ); - else - return( 0 ); -} /* valid_XYC() */ - - -/********************************************************************/ -/***** X11 specific variable and function declarations *****/ -/********************************************************************/ -#ifdef X11 -static Display *gr_display; /* The X display */ -static int gr_screen; /* The X screen number */ -static Window gr_win; /* The drawable Window */ -static GC gr_gc; /* Graphics Context */ -static unsigned long gr_colortbl[GR_COLORS]; /* Color table */ -static XEvent gr_event; /* Event structure */ - -/* These are needed for XSetWMProperties */ -static char *gr_windowname = WINDOWNAME; -static char *gr_iconname = ICONNAME; -static char gr_progname[] = PROGNAME; -static char gr_classname[] = CLASSNAME; -static int gr_argc = 1; -static char *gr_argv[] = { gr_progname, NULL }; - -static void gr_eventhandler( event ) -XEvent event; -{ - switch( event.type ) { - - case ConfigureNotify: -# ifdef TESTING - fputs( "Received ConfigureNotify event\n", stderr ); -# endif - gr_max_x = event.xconfigure.width - 1; - gr_max_y = event.xconfigure.height - 1; - break; - - case MapNotify: -# ifdef TESTING - fputs( "Received MapNotify event\n", stderr ); -# endif - break; - - case DestroyNotify: -# ifdef TESTING - fputs( "Received DestroyNotify event\n", stderr ); -# endif - break; - - case UnmapNotify: -# ifdef TESTING - fputs( "Received UnmapNotify event\n", stderr ); -# endif - break; - - case Expose: -# ifdef TESTING - fputs( "Received Expose event\n", stderr ); -# endif - if( event.xexpose.count != 0 ) - break; - break; - - case ClientMessage: -# ifdef TESTING - fputs( "Received ClientMessage event\n", stderr ); -# endif - break; - - default: - /* Throw away any unknown events */ - break; - - } /* switch */ -} - -static void gr_events( expected ) -int expected; -{ -int i; - - /* Get at least 'expected' events */ - for( i = 0; i < expected; ++i ) { - XNextEvent( gr_display, &gr_event ); - gr_eventhandler( gr_event ); - } - /* Handle all remaining events if there are any */ - /* XPending will call XFlush() if it doesn't find events at once */ - while( XPending(gr_display) ) { - XNextEvent( gr_display, &gr_event ); - gr_eventhandler( gr_event ); - } /* while */ -} /* gr_events() */ - -static void gr_typedevent( type ) -int type; -{ - do { - XNextEvent( gr_display, &gr_event ); - gr_eventhandler( gr_event ); - } while( gr_event.type != type ); - /* Handle all remaining events if there are any */ - /* XPending will call XFlush() if it doesn't find events at once */ - while( XPending(gr_display) ) { - XNextEvent( gr_display, &gr_event ); - gr_eventhandler( gr_event ); - } /* while */ -} - - -/********************************************************************/ -/***** PC specific variable and function declarations *****/ -/********************************************************************/ -#else - -static int gr_max_display_mode; -static int gr_drivernum; - -#endif - - -/********************************************************************/ -/********************************************************************/ -/*** User callable SCM routines begin here *** - *** *** - *** ***/ - - -SCM gr_helpgr() -{ - fputs( "\ -Ret Name nargs args returns\n\ ----------------------------------------------------------\n\ -B graphics-avail? 0 - #t if graphics available\n\ -B graphics-mode! 0 - #f if no graphics\n\ -B text-mode! 0 - #t on success\n\ -B clear-graphics! 0 - #f if not in graphics mode\n\ -i max-x 0 - maximum value of x\n\ -i max-y 0 - maximum value of y\n\ -i max-color 0 - maximum value of color\n\ -B valid-xyc? 3 x y color #t if valid\n\ -B set-dot! 3 x y color #t on success\n\ -i get-dot 2 x y color of the dot in (x,y)\n\ - or #f if (x,y) not legal\n\ -\n\ -NOTE: Origin (0,0) is in the upper left corner.\n\n\ -", stdout ); - return BOOL_T; -} /* gr_helpgr() */ - - -SCM gr_helpturtlegr() -{ - fputs( "\ -Ret Name nargs args returns\n\ ----------------------------------------------------------\n\ -B goto-home! 0 - #f if not in graphics mode\n\ -B goto-center! 0 - #f if not in graphics mode\n\ -B goto-nw! 0 - #f if not in graphics mode\n\ -B goto-ne! 0 - #f if not in graphics mode\n\ -B goto-sw! 0 - #f if not in graphics mode\n\ -B goto-se! 0 - #f if not in graphics mode\n\ -B draw 1 length #t if target within drawing area\n\ -B draw-to 2 x y #t if (x,y) within drawing area\n\ -B draw-to! 2 x y #t if (x,y) within drawing area\n\ -B move 1 length #t if target within drawing area\n\ -B move-to! 2 x y #t if (x,y) within drawing area\n\ -i where-x 0 - current x-coordinate\n\ -i where-y 0 - current y-coordinate\n\ -i turn-right 1 angle drawing direction in degrees\n\ -i turn-left 1 angle drawing direction in degrees\n\ -i turn-to! 1 angle drawing direction in degrees\n\ -i what-direction 0 - drawing direction in degrees\n\ -B set-color! 1 color #t if color valid\n\ -i what-color 0 - current drawing color\n\n\ -", stdout ); - return BOOL_T; -} /* gr_helpturtlegr() */ - - -SCM gr_available() -{ - if( gr_graphicsavail ) - return BOOL_T; - else - return BOOL_F; -} /* gr_available() */ - - -SCM gr_maxx() -{ - if( !gr_grmode_on ) - return BOOL_F; -#ifdef X11 - /* Check for changed window size */ - gr_events(0); -#endif - return MAKINUM( (long)gr_max_x ); -} /* gr_maxx() */ - - -SCM gr_maxy() -{ - if( !gr_grmode_on ) - return BOOL_F; -#ifdef X11 - /* Check for changed window size */ - gr_events(0); -#endif - return MAKINUM( (long)gr_max_y ); -} /* gr_maxy() */ - -SCM gr_maxc() -{ - if( !gr_grmode_on ) - return BOOL_F; - return MAKINUM( (long)gr_max_color ); -} /* gr_maxc() */ - - -SCM gr_validXYC( x, y, c ) -SCM x, y, c; -{ -int xi, yi, ci; - - ASRTER( NUMBERP(x), x, ARG1, s_gr_validXYC ); - ASRTER( NUMBERP(y), y, ARG2, s_gr_validXYC ); - ASRTER( NUMBERP(c), c, ARG3, s_gr_validXYC ); - if( !gr_grmode_on ) - return BOOL_F; - - if( INUMP(x) ) - xi = (int)(INUM(x)); - else - xi = (int)(REALPART(x)); - - if( INUMP(y) ) - yi = (int)(INUM(y)); - else - yi = (int)(REALPART(y)); - - if( INUMP(c) ) - ci = (int)(INUM(c)); - else - ci = (int)(REALPART(c)); - -/* valid_XYC() calls gr_events() */ - - if( valid_XYC( xi, yi, ci ) ) - return BOOL_T; - else - return BOOL_F; -} /* gr_validXYC() */ - - -SCM gr_grmode() -{ - if( !gr_graphicsavail ) - return BOOL_F; -#ifdef X11 - /* bwuah... but it works :) */ - if( !gr_grmode_on ) { - XMapWindow( gr_display, gr_win ); - gr_typedevent( MapNotify ); - } -#else /* PC version */ - setgraphmode( gr_max_display_mode ); -#endif - gr_grmode_on = 1; - return BOOL_T; -} /* gr_grmode() */ - -SCM gr_txtmode() -{ - if( !gr_graphicsavail ) - return BOOL_F; -#ifdef X11 - /* bwuah... but it works :) */ - if( gr_grmode_on ) { - XUnmapWindow( gr_display, gr_win ); - gr_typedevent( UnmapNotify ); - } -#else /* PC version */ - restorecrtmode(); -#endif - gr_grmode_on = 0; - return BOOL_T; -} /* gr_txtmode() */ - - -SCM gr_cleargraph() -{ - if( !gr_grmode_on ) - return BOOL_F; -#ifdef X11 - XClearWindow( gr_display, gr_win ); - gr_events(0); -#else /* PC version */ - cleardevice(); -#endif - return BOOL_T; -} /* gr_cleargraph() */ - - -SCM gr_setdot( x, y, c ) -SCM x, y, c; -{ -int xi, yi, ci; - - ASRTER( NUMBERP(x), x, ARG1, s_gr_setdot ); - ASRTER( NUMBERP(y), y, ARG2, s_gr_setdot ); - ASRTER( NUMBERP(c), c, ARG3, s_gr_setdot ); - if( !gr_grmode_on ) - return BOOL_F; - - if( INUMP(x) ) - xi = (int)(INUM(x)); - else - xi = (int)(REALPART(x)); - - if( INUMP(y) ) - yi = (int)(INUM(y)); - else - yi = (int)(REALPART(y)); - - if( INUMP(c) ) - ci = (int)(INUM(c)); - else - ci = (int)(REALPART(c)); -#ifdef TESTING - fprintf( stderr, "set-dot! called (%d,%d,%d)\n", xi, yi, ci ); -#endif - if( !valid_XYC( xi, yi, ci ) ) - return BOOL_F; -#ifdef X11 - /* Set the drawing color */ - XSetForeground( gr_display, gr_gc, gr_colortbl[ ci ] ); - XDrawPoint( gr_display, gr_win, gr_gc, xi, yi ); - /* Restore the drawing color */ - XSetForeground( gr_display, gr_gc, gr_colortbl[ gr_color ] ); - gr_events(0); -#else /* PC version */ - putpixel( xi, yi, ci ); -#endif - return BOOL_T; -} /* gr_setdot() */ - - -SCM gr_getdot( x, y ) -SCM x, y; -{ -int xi, yi; -#ifdef X11 -XImage *xim; -XWindowAttributes wattr; -unsigned long dot; -int i; -#endif - ASRTER( NUMBERP(x), x, ARG1, s_gr_getdot ); - ASRTER( NUMBERP(y), y, ARG2, s_gr_getdot ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(x) ) - xi = (int)(INUM(x)); - else - xi = (int)(REALPART(x)); - - if( INUMP(y) ) - yi = (int)(INUM(y)); - else - yi = (int)(REALPART(y)); -#ifdef TESTING - fprintf( stderr, "get-dot called (%d,%d)\n", xi, yi ); -#endif - if( !valid_XYC( xi, yi, 0 ) ) - return BOOL_F; -#ifdef X11 - /* Now, this IS ugly. But it's there if you need it. */ - - /* Have to make sure that the window is mapped. Tough... */ - XGetWindowAttributes( gr_display, gr_win, &wattr ); - if( wattr.map_state == IsUnmapped ) { - XMapWindow( gr_display, gr_win ); - gr_typedevent( MapNotify ); - } - /* I KNOW this sucks. */ - xim = XGetImage( gr_display, gr_win, xi, yi, 1, 1, AllPlanes, XYPixmap ); - dot = XGetPixel( xim, 0, 0 ); - for( i = 0; i < GR_COLORS; ++i ) { - if( gr_colortbl[i] == dot ) - return MAKINUM( (long)i ); - } - /* This should never happen. There's garbage in the window! */ - fprintf( stderr, "%s: %s: Got an illegal pixel value %lu. \ -Is there garbage?\n", gr_progname, s_gr_getdot, dot ); - return BOOL_F; -#else /* PC version */ - return MAKINUM( (long)getpixel( xi, yi ) ); -#endif -} /* gr_getdot() */ - -SCM gr_draw( S ) -SCM S; -{ -float xf, yf; -float sf; -int ok; - - ASRTER( NUMBERP(S), S, ARG1, s_gr_draw ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(S) ) - sf = (float)(INUM(S)); - else - sf = REALPART(S); -#ifdef TESTING - fprintf( stderr, "draw called (%f)\n", sf ); -#endif - ok = 1; - xf = gr_x + ( COS( gr_dir ) * sf ); - yf = gr_y + ( SIN( gr_dir ) * sf ); - if( (int)xf > gr_max_x ) { - xf = (float)gr_max_x; - ok = 0; - } - else if( xf < 0.0 ) { - xf = 0.0; - ok = 0; - } - if( (int)yf > gr_max_y ) { - yf = (float)gr_max_y; - ok = 0; - } - else if( yf < 0.0 ) { - yf = 0.0; - ok = 0; - } -#ifdef X11 - XDrawLine( gr_display, gr_win, gr_gc, - (int)gr_x, (int)gr_y, - (int)xf, (int)yf ); - gr_events(0); -#else /* PC version */ - line( (int)gr_x, (int)gr_y, (int)xf, (int)yf ); -#endif - gr_x = xf; - gr_y = yf; - if( ok ) - return BOOL_T; - else - return BOOL_F; -} /* gr_draw() */ - - -SCM gr_move( S ) -SCM S; -{ -float xf, yf; -float sf; -int ok; - - ASRTER( NUMBERP(S), S, ARG1, s_gr_move ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(S) ) - sf = (float)(INUM(S)); - else - sf = REALPART(S); -#ifdef TESTING - fprintf( stderr, "move called (%f)\n", sf ); -#endif - ok = 1; - xf = gr_x + ( COS( gr_dir ) * sf ); - yf = gr_y + ( SIN( gr_dir ) * sf ); - - if( (int)xf > gr_max_x ) { - xf = (float)gr_max_x; - ok = 0; - } - else if( xf < 0.0 ) { - xf = 0.0; - ok = 0; - } - if( (int)yf > gr_max_y ) { - yf = (float)gr_max_y; - ok = 0; - } - else if( yf < 0.0 ) { - yf = 0.0; - ok = 0; - } - gr_x = xf; - gr_y = yf; - if( ok ) - return BOOL_T; - else - return BOOL_F; -} /* gr_move() */ - - -SCM gr_drawto( x, y ) -SCM x, y; -{ -int xi, yi; - - ASRTER( NUMBERP(x), x, ARG1, s_gr_drawto ); - ASRTER( NUMBERP(y), y, ARG2, s_gr_drawto ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(x) ) - xi = (int)(INUM(x)); - else - xi = (int)(REALPART(x)); - - if( INUMP(y) ) - yi = (int)(INUM(y)); - else - yi = (int)(REALPART(y)); -#ifdef TESTING - fprintf( stderr, "draw-to called (%d,%d)\n", xi, yi ); -#endif - if( !valid_XYC( xi, yi, 0 ) ) - return BOOL_F; -#ifdef X11 - XDrawLine( gr_display, gr_win, gr_gc, - (int)gr_x, (int)gr_y, xi, yi ); - gr_events(0); -#else /* PC version */ - line( (int)gr_x, (int)gr_y, xi, yi ); -#endif - return BOOL_T; -} /* gr_drawto() */ - - -SCM gr_drawTo( x, y ) -SCM x, y; -{ -float xf, yf; - - ASRTER( NUMBERP(x), x, ARG1, s_gr_drawTo ); - ASRTER( NUMBERP(y), y, ARG2, s_gr_drawTo ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(x) ) - xf = (float)(INUM(x)); - else - xf = (REALPART(x)); - - if( INUMP(y) ) - yf = (float)(INUM(y)); - else - yf = (REALPART(y)); -#ifdef TESTING - fprintf( stderr, "draw-to! called (%d,%d)\n", (int)xf, (int)yf ); -#endif - if( !valid_XYC( (int)xf, (int)yf, 0 ) ) - return BOOL_F; -#ifdef X11 - XDrawLine( gr_display, gr_win, gr_gc, - (int)gr_x, (int)gr_y, - (int)xf, (int)yf ); - gr_events(0); -#else /* PC version */ - line( (int)gr_x, (int)gr_y, (int)xf, (int)yf ); -#endif - gr_x = xf; - gr_y = yf; - return BOOL_T; -} /* gr_drawTo() */ - - -SCM gr_moveTo( x, y ) -SCM x, y; -{ -float xf, yf; - - ASRTER( NUMBERP(x), x, ARG1, s_gr_moveTo ); - ASRTER( NUMBERP(y), y, ARG2, s_gr_moveTo ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(x) ) - xf = (float)(INUM(x)); - else - xf = (REALPART(x)); - - if( INUMP(y) ) - yf = (float)(INUM(y)); - else - yf = (REALPART(y)); -#ifdef TESTING - fprintf( stderr, "move-to! called (%d,%d)\n", (int)xf, (int)yf ); -#endif - if( !valid_XYC( (int)xf, (int)yf, 0 ) ) - return BOOL_F; - gr_x = xf; - gr_y = yf; - return BOOL_T; -} /* gr_moveTo() */ - - -SCM gr_setcolor( c ) -SCM c; -{ -int color; - - ASRTER( NUMBERP(c), c, ARG1, s_gr_setcolor ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(c) ) - color = (int)(INUM(c)); - else - color = (int)(REALPART(c)); -#ifdef TESTING - fprintf( stderr, "set-color! called (%d)\n", color ); -#endif - if( !valid_XYC( 0, 0, color ) ) - return BOOL_F; - gr_color = color; -#ifdef X11 - /* Set the drawing color */ - XSetForeground( gr_display, gr_gc, gr_colortbl[ gr_color ] ); - gr_events(0); -#else /* PC version */ - setcolor( gr_color ); -#endif - return BOOL_T; -} /* gr_setcolor() */ - - -SCM gr_turnright( d ) -SCM d; -{ -float df; - - ASRTER( NUMBERP(d), d, ARG1, s_gr_turnright ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(d) ) - df = (float)(INUM(d)); - else - df = REALPART(d); - df = fmod( df, 360.0 ); - gr_dir -= df; - gr_dir = fmod( gr_dir, 360.0 ); - return MAKINUM( (long)(gr_dir+.5) ); -} /* gr_turnright() */ - - -SCM gr_turnleft( d ) -SCM d; -{ -float df; - - ASRTER( NUMBERP(d), d, ARG1, s_gr_turnleft ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(d) ) - df = (float)(INUM(d)); - else - df = REALPART(d); - df = fmod( df, 360.0 ); - gr_dir += df; - gr_dir = fmod( gr_dir, 360.0 ); - return MAKINUM( (long)(gr_dir+.5) ); -} /* gr_turnleft() */ - - -SCM gr_turnto( d ) -SCM d; -{ -float df; - - ASRTER( NUMBERP(d), d, ARG1, s_gr_turnto ); - if( !gr_grmode_on ) - return BOOL_F; - if( INUMP(d) ) - df = (float)(INUM(d)); - else - df = REALPART(d); - df = fmod( df, 360.0 ); - gr_dir = df; - return MAKINUM( (long)(gr_dir+.5) ); -} /* gr_turnto() */ - - -SCM gr_gotohome() -{ - if( !gr_grmode_on ) - return BOOL_F; - gr_x = gr_y = 0.0; - return BOOL_T; -} /* gr_gotohome() */ - - -SCM gr_gotocenter() -{ - if( !gr_grmode_on ) - return BOOL_F; -#ifdef X11 - /* Check for changed window size */ - gr_events(0); -#endif - gr_x = ((float)gr_max_x+1.0) / 2.0; - gr_y = ((float)gr_max_y+1.0) / 2.0; - return BOOL_T; -} /* gr_gotocenter() */ - - -SCM gr_gotonw() -{ - if( !gr_grmode_on ) - return BOOL_F; -#ifdef X11 - /* Check for changed window size */ - gr_events(0); -#endif - gr_x = 0.0; - gr_y = 0.0; - return BOOL_T; -} /* gr_gotonw() */ - - -SCM gr_gotosw() -{ - if( !gr_grmode_on ) - return BOOL_F; -#ifdef X11 - /* Check for changed window size */ - gr_events(0); -#endif - gr_x = 0.0; - gr_y = (float)gr_max_y; - return BOOL_T; -} /* gr_gotosw() */ - - -SCM gr_gotone() -{ - if( !gr_grmode_on ) - return BOOL_F; -#ifdef X11 - /* Check for changed window size */ - gr_events(0); -#endif - gr_x = (float)gr_max_x; - gr_y = 0.0; - return BOOL_T; -} /* gr_gotone() */ - - -SCM gr_gotose() -{ - if( !gr_grmode_on ) - return BOOL_F; -#ifdef X11 - /* Check for changed window size */ - gr_events(0); -#endif - gr_x = (float)gr_max_x; - gr_y = (float)gr_max_y; - return BOOL_T; -} /* gr_gotose() */ - - -SCM gr_whatcolor() -{ - if( !gr_grmode_on ) - return BOOL_F; - return MAKINUM( (long)gr_color ); -} /* gr_whatcolor() */ - - -SCM gr_whatdirection() -{ - if( !gr_grmode_on ) - return BOOL_F; - return MAKINUM( (long)(gr_dir+.5) ); -} /* gr_whatdirection() */ - - -SCM gr_wherex() -{ - if( !gr_grmode_on ) - return BOOL_F; - return MAKINUM( (long)gr_x ); -} /* gr_wherex() */ - - -SCM gr_wherey() -{ - if( !gr_grmode_on ) - return BOOL_F; - return MAKINUM( (long)gr_y ); -} /* gr_wherey() */ - - -static iproc graph0[] = { - { "help-gr", gr_helpgr }, - { "help-turtlegr", gr_helpturtlegr }, - { "graphics-mode!", gr_grmode }, - { "text-mode!", gr_txtmode }, - { "clear-graphics!", gr_cleargraph }, - { "graphics-avail?", gr_available }, - { "max-x", gr_maxx }, - { "max-y", gr_maxy }, - { "max-color", gr_maxc }, - { "what-color", gr_whatcolor }, - { "what-direction", gr_whatdirection }, - { "where-x", gr_wherex }, - { "where-y", gr_wherey }, - { "goto-home!", gr_gotohome }, - { "goto-center!", gr_gotocenter }, - { "goto-nw!", gr_gotonw }, - { "goto-sw!", gr_gotosw }, - { "goto-ne!", gr_gotone }, - { "goto-se!", gr_gotose }, - {0, 0} - }; - -static iproc graph1[] = { - { s_gr_draw, gr_draw }, - { s_gr_move, gr_move }, - { s_gr_setcolor, gr_setcolor }, - { s_gr_turnright, gr_turnright }, - { s_gr_turnleft, gr_turnleft }, - { s_gr_turnto, gr_turnto }, - {0, 0} - }; - -static iproc graph2[] = { - { s_gr_getdot, gr_getdot }, - { s_gr_drawTo, gr_drawTo }, - { s_gr_drawto, gr_drawto }, - { s_gr_moveTo, gr_moveTo }, - {0, 0} - }; - -static iproc graph3[] = { - { s_gr_setdot, gr_setdot }, - { s_gr_validXYC, gr_validXYC }, - {0, 0} - }; - -#if defined __STDC__ || defined __TURBOC__ -void close_turtlegr() -{ -# ifdef X11 - gr_events(0); - XFreeColors( gr_display, DefaultColormap(gr_display, gr_screen), - gr_colortbl, GR_COLORS, AllPlanes ); - XFreeGC( gr_display, gr_gc ); - XUnmapWindow( gr_display, gr_win ); - XDestroyWindow( gr_display, gr_win ); -# else /* PC version */ - closegraph(); -# endif -} /* close_turtlegr() */ -#endif - -void init_banner(); /* from scm.c */ - -void init_turtlegr() /* detects if graphics is available; must be - called among program initializations */ -{ -#ifdef X11 - char *display_name = NULL; /* Server to connect to */ - Pixmap icon_pixmap; /* Icon */ - XSizeHints size_hints; /* Preferred sizes */ - XSetWindowAttributes win_attribs; /* Window attributes */ - XWMHints wm_hints; /* Window manager hints */ - XClassHint class_hints; /* Class hints */ - XTextProperty window_name, icon_name; /* Names for Icon & Window */ - XGCValues gc_values; /* Graphics Context values */ - static char *colorname[GR_COLORS] = { - GR_COLOR00, GR_COLOR01, GR_COLOR02, GR_COLOR03, - GR_COLOR04, GR_COLOR05, GR_COLOR06, GR_COLOR07, - GR_COLOR08, GR_COLOR09, GR_COLOR10, GR_COLOR11, - GR_COLOR12, GR_COLOR13, GR_COLOR14, GR_COLOR15 - }; - XColor x_color; /* X11 Color structure */ - unsigned long mask; /* Mask for selections */ - int i; /* loop counter variable */ - -#else /* PC version */ -int errcode; -#endif - -/***************************/ -/* generic initializations */ -/***************************/ - gr_x = gr_y = gr_dir = 0.0; - gr_max_x = gr_max_y = gr_max_color = 0; - - gr_graphicsavail = 0; /* DEFAULT is no graphics - you can do without */ - -/********************************************/ -/***** Initialize X11 turtlegraphics *****/ -/********************************************/ -#ifdef X11 - /* connect to X server */ - if( (gr_display = XOpenDisplay(display_name)) != NULL ) - { - - /*****************************/ - /* connection to X server OK */ - /*****************************/ - - gr_screen = DefaultScreen( gr_display ); /* X screen number */ - - /* Create a window with Black background and border */ - gr_win - = XCreateSimpleWindow( gr_display, - RootWindow( gr_display, gr_screen), - 0, 0, /* initial placement */ - GR_DEF_XSIZE, GR_DEF_YSIZE, - 3, /* border width */ - /* border pixel value */ - BlackPixel(gr_display, gr_screen), - /* background pixel value */ - BlackPixel(gr_display, gr_screen) ); - - /* Select input (events) for the window */ - XSelectInput( gr_display, gr_win, - StructureNotifyMask|ExposureMask ); - - /* Check for backing store capability */ - if( !DoesBackingStore(DefaultScreenOfDisplay(gr_display)) ) - { - fprintf( stderr, "%s: Warning: \ -X server does not offer backing store capability.\n\ -Window cannot be redrawn if obscured. Sorry...\n", gr_progname ); - } - else - { - /* Enable the backing store feature of X server - and set bit gravity */ - win_attribs.bit_gravity = NorthWestGravity; - win_attribs.backing_store = Always; - mask = CWBitGravity | CWBackingStore; - XChangeWindowAttributes( gr_display, gr_win, mask, &win_attribs ); - } - - /* Make names of Window and Icon for window manager */ - if( XStringListToTextProperty(&gr_windowname, 1, &window_name) == 0 ) { - (void)fprintf( stderr, "%s: Structure allocation for windowName\ - failed.\n", gr_progname ); - exit( 42 ); - } - if( XStringListToTextProperty(&gr_iconname, 1, &icon_name) == 0 ) { - (void)fprintf( stderr, "%s: Structure allocation for iconName\ - failed.\n", gr_progname ); - exit( 42 ); - } - - /* Create the icon */ - icon_pixmap = XCreateBitmapFromData( gr_display, gr_win, turtle_bits, - turtle_width, turtle_height ); - - /* Window size, state, icon etc. hints for the window manager */ - size_hints.flags = PPosition | PMaxSize | PMinSize | USSize; - /* position and desired size are given to XCreateSimpleWindow call */ - size_hints.min_width = GR_MIN_XSIZE; - size_hints.min_height = GR_MIN_YSIZE; - size_hints.max_width = GR_MAX_XSIZE; - size_hints.max_height = GR_MAX_YSIZE; - wm_hints.flags = StateHint | IconPixmapHint | InputHint; - wm_hints.initial_state = NormalState; - wm_hints.input = False; - wm_hints.icon_pixmap = icon_pixmap; - class_hints.res_name = gr_progname; - class_hints.res_class = gr_classname; - XSetWMProperties( gr_display, gr_win, &window_name, &icon_name, - gr_argv, gr_argc, - &size_hints, &wm_hints, &class_hints ); - - - /* Handle colors; this is quite complicated in X11 */ - - if( DefaultDepth( gr_display, gr_screen ) == 1 ) - { - /* Only 1 bitplane, BW screen */ - /* Emulate colors with 0 as Black and 1-15 White */ - gr_colortbl[0] = BlackPixel( gr_display, gr_screen ); - for( i = 1; i < GR_COLORS; ++i ) - gr_colortbl[i] = WhitePixel( gr_display, gr_screen ); -# ifdef TESTING - fprintf( stderr, "%s: 1-plane system, substituting White for \ -colors 1-15.\n", gr_progname ); - fprintf( stderr, "%s: Pixel value is %lu for Black, \ -%lu for White\n", gr_progname, gr_colortbl[0], gr_colortbl[1] ); -# endif - } - else - { - /* more than 1 bitplane */ - for( i = 0; i < GR_COLORS; ++i ) - { - /* Initialize the colortable using named colors */ - if( XParseColor( gr_display, - DefaultColormap(gr_display, gr_screen), - colorname[ i ], &x_color ) ) - { - if( !XAllocColor( gr_display, - DefaultColormap(gr_display, gr_screen), - &x_color ) ) - { - fprintf( stderr, "%s: Can't allocate color \ -\"%s\" (%d). Substituting White.\n", - gr_progname, - colorname[ i ], i ); - gr_colortbl[i] = WhitePixel( gr_display, gr_screen ); - } - else - { - /* succeeded in allocating color */ - gr_colortbl[ i ] = x_color.pixel; -# ifdef TESTING - fprintf( stderr, "%s: Pixel value is %lu for %s.\n", - gr_progname, gr_colortbl[i], colorname[i] ); -# endif - } - } - else - { - /* could not parse color */ - fprintf( stderr, - "%s: Color name \"%s\" (%d) not in database. \ -Substituting White.\n", - gr_progname, colorname[i], i ); - gr_colortbl[i] = WhitePixel( gr_display, gr_screen ); - } - } /* for */ - } /* else */ - gr_max_color = GR_COLORS - 1; - - /* Create and initialize a default GC */ - gr_gc = XCreateGC( gr_display, gr_win, 0L, &gc_values ); - - /* Initialize the drawing color, default's black */ - XSetForeground( gr_display, gr_gc, gr_colortbl[ 0 ] ); - XSetBackground( gr_display, gr_gc, gr_colortbl[ 0 ] ); - gr_color = 0; - - /* OK, we _do_ have graphics available */ - gr_graphicsavail = 1; - -# ifdef __STDC__ - /* Let's do the Right Thing if possible :) */ - atexit( close_turtlegr ); -# endif - } /* if */ - else { - gr_graphicsavail = 0; - } -/********************************************/ -/***** Initialize PC turtlegraphics *****/ -/********************************************/ -#else /* PC version */ - gr_drivernum = DETECT; - - detectgraph( &gr_drivernum, &gr_max_display_mode ); - if( gr_drivernum != grNotDetected ) { - if( !getenv( BGIDIR_ENVSTRING ) ) - fprintf( stderr, - "You really should set the %s environment variable.\n", - BGIDIR_ENVSTRING ); - initgraph( &gr_drivernum, &gr_max_display_mode, - getenv( BGIDIR_ENVSTRING ) ); - errcode = graphresult(); - if( errcode != grOk ) { - fputs( "Graphics error: ", stderr ); - fputs( grapherrormsg( errcode ), stderr ); - exit( EXIT_FAILURE ); - } - moveto( 0, 0 ); - gr_x = gr_y = 0.0; - setcolor( 0 ); - gr_color = 0; - gr_max_x = getmaxx(); - gr_max_y = getmaxy(); - gr_max_color = getmaxcolor(); - gr_max_display_mode = getmaxmode(); - restorecrtmode(); - gr_graphicsavail = 1; - atexit( close_turtlegr ); - } - else { - gr_graphicsavail = 0; - } -#endif - -/* generic */ - init_iprocs( graph0, tc7_subr_0 ); - init_iprocs( graph1, tc7_subr_1 ); - init_iprocs( graph2, tc7_subr_2 ); - init_iprocs( graph3, tc7_subr_3 ); - gr_grmode_on = 0; - -#ifndef X11 - /* PC version clears screen so this must be repeated */ - init_banner(); -#endif - - fputs("\nSCM Turtlegraphics Copyright (C) 1992 sjm@cc.tut.fi, jtl@cc.tut.fi\n\ -Type `(help-gr)' or `(help-turtlegr)' for a quick reference of\n\ -the new primitives.\n", stderr); - - if( !gr_graphicsavail ) { -#ifdef X11 - fprintf( stderr, "%s: No X server found. \ -Turtlegraphics not available.\n", gr_progname ); -#else - fputs( "No graphics adapter detected. \ -Turtlegraphics not available.\n", stderr ); -#endif - } - else { -#ifdef X11 - gr_events(0); -#else - ; -#endif - } -} /* init_turtlegr() */ diff --git a/ugsetjump.s b/ugsetjump.s old mode 100644 new mode 100755 diff --git a/unexalpha.c b/unexalpha.c old mode 100644 new mode 100755 diff --git a/unexec.c b/unexec.c old mode 100644 new mode 100755 diff --git a/unexelf.c b/unexelf.c old mode 100644 new mode 100755 diff --git a/unexhp9k800.c b/unexhp9k800.c old mode 100644 new mode 100755 diff --git a/unexmacosx.c b/unexmacosx.c new file mode 100755 index 0000000..a2673d2 --- /dev/null +++ b/unexmacosx.c @@ -0,0 +1,1226 @@ +/* Dump Emacs in Mach-O format for use on Mac OS X. + Copyright (C) 2001, 2002, 2003, 2004, 2005, + 2006, 2007 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 3 of the +License, 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. If not, see +. */ + +/* Contributed by Andrew Choi (akochoi@mac.com). */ + +/* Documentation note. + + Consult the following documents/files for a description of the + Mach-O format: the file loader.h, man pages for Mach-O and ld, old + NEXTSTEP documents of the Mach-O format. The tool otool dumps the + mach header (-h option) and the load commands (-l option) in a + Mach-O file. The tool nm on Mac OS X displays the symbol table in + a Mach-O file. For examples of unexec for the Mach-O format, see + the file unexnext.c in the GNU Emacs distribution, the file + unexdyld.c in the Darwin port of GNU Emacs 20.7, and unexdyld.c in + the Darwin port of XEmacs 21.1. Also the Darwin Libc source + contains the source code for malloc_freezedry and malloc_jumpstart. + Read that to see what they do. This file was written completely + from scratch, making use of information from the above sources. */ + +/* The Mac OS X implementation of unexec makes use of Darwin's `zone' + memory allocator. All calls to malloc, realloc, and free in Emacs + are redirected to unexec_malloc, unexec_realloc, and unexec_free in + this file. When temacs is run, all memory requests are handled in + the zone EmacsZone. The Darwin memory allocator library calls + maintain the data structures to manage this zone. Dumping writes + its contents to data segments of the executable file. When emacs + is run, the loader recreates the contents of the zone in memory. + However since the initialization routine of the zone memory + allocator is run again, this `zone' can no longer be used as a + heap. That is why emacs uses the ordinary malloc system call to + allocate memory. Also, when a block of memory needs to be + reallocated and the new size is larger than the old one, a new + block must be obtained by malloc and the old contents copied to + it. */ + +/* Peculiarity of the Mach-O files generated by ld in Mac OS X + (possible causes of future bugs if changed). + + The file offset of the start of the __TEXT segment is zero. Since + the Mach header and load commands are located at the beginning of a + Mach-O file, copying the contents of the __TEXT segment from the + input file overwrites them in the output file. Despite this, + unexec works fine as written below because the segment load command + for __TEXT appears, and is therefore processed, before all other + load commands except the segment load command for __PAGEZERO, which + remains unchanged. + + Although the file offset of the start of the __TEXT segment is + zero, none of the sections it contains actually start there. In + fact, the earliest one starts a few hundred bytes beyond the end of + the last load command. The linker option -headerpad controls the + minimum size of this padding. Its setting can be changed in + s/darwin.h. A value of 0x690, e.g., leaves room for 30 additional + load commands for the newly created __DATA segments (at 56 bytes + each). Unexec fails if there is not enough room for these new + segments. + + The __TEXT segment contains the sections __text, __cstring, + __picsymbol_stub, and __const and the __DATA segment contains the + sections __data, __la_symbol_ptr, __nl_symbol_ptr, __dyld, __bss, + and __common. The other segments do not contain any sections. + These sections are copied from the input file to the output file, + except for __data, __bss, and __common, which are dumped from + memory. The types of the sections __bss and __common are changed + from S_ZEROFILL to S_REGULAR. Note that the number of sections and + their relative order in the input and output files remain + unchanged. Otherwise all n_sect fields in the nlist records in the + symbol table (specified by the LC_SYMTAB load command) will have to + be changed accordingly. +*/ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#if defined (__ppc__) +#include +#endif +#include "macosx-config.h" + +#undef malloc +#undef realloc +#undef free +#ifdef HAVE_MALLOC_MALLOC_H +#include +#else +#include +#endif + +#include + +#ifdef _LP64 +#define mach_header mach_header_64 +#define segment_command segment_command_64 +#undef VM_REGION_BASIC_INFO_COUNT +#define VM_REGION_BASIC_INFO_COUNT VM_REGION_BASIC_INFO_COUNT_64 +#undef VM_REGION_BASIC_INFO +#define VM_REGION_BASIC_INFO VM_REGION_BASIC_INFO_64 +#undef LC_SEGMENT +#define LC_SEGMENT LC_SEGMENT_64 +#define vm_region vm_region_64 +#define section section_64 +#undef MH_MAGIC +#define MH_MAGIC MH_MAGIC_64 +#endif + +#define VERBOSE 1 + +/* Size of buffer used to copy data from the input file to the output + file in function unexec_copy. */ +#define UNEXEC_COPY_BUFSZ 1024 + +/* Regions with memory addresses above this value are assumed to be + mapped to dynamically loaded libraries and will not be dumped. */ +#define VM_DATA_TOP (20 * 1024 * 1024) + +/* Type of an element on the list of regions to be dumped. */ +struct region_t { + vm_address_t address; + vm_size_t size; + vm_prot_t protection; + vm_prot_t max_protection; + + struct region_t *next; +}; + +/* Head and tail of the list of regions to be dumped. */ +static struct region_t *region_list_head = 0; +static struct region_t *region_list_tail = 0; + +/* Pointer to array of load commands. */ +static struct load_command **lca; + +/* Number of load commands. */ +static int nlc; + +/* The highest VM address of segments loaded by the input file. + Regions with addresses beyond this are assumed to be allocated + dynamically and thus require dumping. */ +static vm_address_t infile_lc_highest_addr = 0; + +/* The lowest file offset used by the all sections in the __TEXT + segments. This leaves room at the beginning of the file to store + the Mach-O header. Check this value against header size to ensure + the added load commands for the new __DATA segments did not + overwrite any of the sections in the __TEXT segment. */ +static unsigned long text_seg_lowest_offset = 0x10000000; + +/* Mach header. */ +static struct mach_header mh; + +/* Offset at which the next load command should be written. */ +static unsigned long curr_header_offset = sizeof (struct mach_header); + +/* Offset at which the next segment should be written. */ +static unsigned long curr_file_offset = 0; + +static unsigned long pagesize; +#define ROUNDUP_TO_PAGE_BOUNDARY(x) (((x) + pagesize - 1) & ~(pagesize - 1)) + +static int infd, outfd; + +static int in_dumped_exec = 0; + +static malloc_zone_t *emacs_zone; + +/* file offset of input file's data segment */ +static off_t data_segment_old_fileoff = 0; + +static struct segment_command *data_segment_scp; + +/* Read N bytes from infd into memory starting at address DEST. + Return true if successful, false otherwise. */ +static int +unexec_read (void *dest, size_t n) +{ + return n == read (infd, dest, n); +} + +/* Write COUNT bytes from memory starting at address SRC to outfd + starting at offset DEST. Return true if successful, false + otherwise. */ +static int +unexec_write (off_t dest, const void *src, size_t count) +{ + if (lseek (outfd, dest, SEEK_SET) != dest) + return 0; + + return write (outfd, src, count) == count; +} + +/* Write COUNT bytes of zeros to outfd starting at offset DEST. + Return true if successful, false otherwise. */ +static int +unexec_write_zero (off_t dest, size_t count) +{ + char buf[UNEXEC_COPY_BUFSZ]; + ssize_t bytes; + + bzero (buf, UNEXEC_COPY_BUFSZ); + if (lseek (outfd, dest, SEEK_SET) != dest) + return 0; + + while (count > 0) + { + bytes = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; + if (write (outfd, buf, bytes) != bytes) + return 0; + count -= bytes; + } + + return 1; +} + +/* Copy COUNT bytes from starting offset SRC in infd to starting + offset DEST in outfd. Return true if successful, false + otherwise. */ +static int +unexec_copy (off_t dest, off_t src, ssize_t count) +{ + ssize_t bytes_read; + ssize_t bytes_to_read; + + char buf[UNEXEC_COPY_BUFSZ]; + + if (lseek (infd, src, SEEK_SET) != src) + return 0; + + if (lseek (outfd, dest, SEEK_SET) != dest) + return 0; + + while (count > 0) + { + bytes_to_read = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; + bytes_read = read (infd, buf, bytes_to_read); + if (bytes_read <= 0) + return 0; + if (write (outfd, buf, bytes_read) != bytes_read) + return 0; + count -= bytes_read; + } + + return 1; +} + +/* Debugging and informational messages routines. */ + +static void +unexec_error (char *format, ...) +{ + va_list ap; + + va_start (ap, format); + fprintf (stderr, "unexec: "); + vfprintf (stderr, format, ap); + fprintf (stderr, "\n"); + va_end (ap); + exit (1); +} + +static void +print_prot (vm_prot_t prot) +{ + if (prot == VM_PROT_NONE) + printf ("none"); + else + { + putchar (prot & VM_PROT_READ ? 'r' : ' '); + putchar (prot & VM_PROT_WRITE ? 'w' : ' '); + putchar (prot & VM_PROT_EXECUTE ? 'x' : ' '); + putchar (' '); + } +} + +static void +print_region (vm_address_t address, vm_size_t size, vm_prot_t prot, + vm_prot_t max_prot) +{ + printf ("%#10lx %#8lx ", (long) address, (long) size); + print_prot (prot); + putchar (' '); + print_prot (max_prot); + putchar ('\n'); +} + +static void +print_region_list () +{ + struct region_t *r; + + printf (" address size prot maxp\n"); + + for (r = region_list_head; r; r = r->next) + print_region (r->address, r->size, r->protection, r->max_protection); +} + +static void +print_regions () +{ + task_t target_task = mach_task_self (); + vm_address_t address = (vm_address_t) 0; + vm_size_t size; + struct vm_region_basic_info info; + mach_msg_type_number_t info_count = VM_REGION_BASIC_INFO_COUNT; + mach_port_t object_name; + + printf (" address size prot maxp\n"); + + while (vm_region (target_task, &address, &size, VM_REGION_BASIC_INFO, + (vm_region_info_t) &info, &info_count, &object_name) + == KERN_SUCCESS && info_count == VM_REGION_BASIC_INFO_COUNT) + { + print_region (address, size, info.protection, info.max_protection); + + if (object_name != MACH_PORT_NULL) + mach_port_deallocate (target_task, object_name); + + address += size; + } +} + +/* Build the list of regions that need to be dumped. Regions with + addresses above VM_DATA_TOP are omitted. Adjacent regions with + identical protection are merged. Note that non-writable regions + cannot be omitted because they some regions created at run time are + read-only. */ +static void +build_region_list () +{ + task_t target_task = mach_task_self (); + vm_address_t address = (vm_address_t) 0; + vm_size_t size; + struct vm_region_basic_info info; + mach_msg_type_number_t info_count = VM_REGION_BASIC_INFO_COUNT; + mach_port_t object_name; + struct region_t *r; + +#if VERBOSE + printf ("--- List of All Regions ---\n"); + printf (" address size prot maxp\n"); +#endif + + while (vm_region (target_task, &address, &size, VM_REGION_BASIC_INFO, + (vm_region_info_t) &info, &info_count, &object_name) + == KERN_SUCCESS && info_count == VM_REGION_BASIC_INFO_COUNT) + { + /* Done when we reach addresses of shared libraries, which are + loaded in high memory. */ + if (address >= VM_DATA_TOP) + break; + +#if VERBOSE + print_region (address, size, info.protection, info.max_protection); +#endif + + /* If a region immediately follows the previous one (the one + most recently added to the list) and has identical + protection, merge it with the latter. Otherwise create a + new list element for it. */ + if (region_list_tail + && info.protection == region_list_tail->protection + && info.max_protection == region_list_tail->max_protection + && region_list_tail->address + region_list_tail->size == address) + { + region_list_tail->size += size; + } + else + { + r = (struct region_t *) malloc (sizeof (struct region_t)); + + if (!r) + unexec_error ("cannot allocate region structure"); + + r->address = address; + r->size = size; + r->protection = info.protection; + r->max_protection = info.max_protection; + + r->next = 0; + if (region_list_head == 0) + { + region_list_head = r; + region_list_tail = r; + } + else + { + region_list_tail->next = r; + region_list_tail = r; + } + + /* Deallocate (unused) object name returned by + vm_region. */ + if (object_name != MACH_PORT_NULL) + mach_port_deallocate (target_task, object_name); + } + + address += size; + } + + printf ("--- List of Regions to be Dumped ---\n"); + print_region_list (); +} + + +#define MAX_UNEXEC_REGIONS 400 + +static int num_unexec_regions; +typedef struct { + vm_range_t range; + vm_size_t filesize; +} unexec_region_info; +static unexec_region_info unexec_regions[MAX_UNEXEC_REGIONS]; + +static void +unexec_regions_recorder (task_t task, void *rr, unsigned type, + vm_range_t *ranges, unsigned num) +{ + vm_address_t p; + vm_size_t filesize; + + while (num && num_unexec_regions < MAX_UNEXEC_REGIONS) + { + /* Subtract the size of trailing null pages from filesize. It + can be smaller than vmsize in segment commands. In such a + case, trailing pages are initialized with zeros. */ + for (p = ranges->address + ranges->size; p > ranges->address; + p -= sizeof (int)) + if (*(((int *) p)-1)) + break; + filesize = ROUNDUP_TO_PAGE_BOUNDARY (p - ranges->address); + assert (filesize <= ranges->size); + + unexec_regions[num_unexec_regions].filesize = filesize; + unexec_regions[num_unexec_regions++].range = *ranges; + printf ("%#10lx (sz: %#8lx/%#8lx)\n", (long) (ranges->address), + (long) filesize, (long) (ranges->size)); + ranges++; num--; + } +} + +static kern_return_t +unexec_reader (task_t task, vm_address_t address, vm_size_t size, void **ptr) +{ + *ptr = (void *) address; + return KERN_SUCCESS; +} + +static void +find_emacs_zone_regions () +{ + num_unexec_regions = 0; + + emacs_zone->introspect->enumerator (mach_task_self(), 0, + MALLOC_PTR_REGION_RANGE_TYPE + | MALLOC_ADMIN_REGION_RANGE_TYPE, + (vm_address_t) emacs_zone, + unexec_reader, + unexec_regions_recorder); + + if (num_unexec_regions == MAX_UNEXEC_REGIONS) + unexec_error ("find_emacs_zone_regions: too many regions"); +} + +static int +unexec_regions_sort_compare (const void *a, const void *b) +{ + vm_address_t aa = ((unexec_region_info *) a)->range.address; + vm_address_t bb = ((unexec_region_info *) b)->range.address; + + if (aa < bb) + return -1; + else if (aa > bb) + return 1; + else + return 0; +} + +static void +unexec_regions_merge () +{ + int i, n; + unexec_region_info r; + + qsort (unexec_regions, num_unexec_regions, sizeof (unexec_regions[0]), + &unexec_regions_sort_compare); + n = 0; + r = unexec_regions[0]; + for (i = 1; i < num_unexec_regions; i++) + { + if (r.range.address + r.range.size == unexec_regions[i].range.address + && r.range.size - r.filesize < 2 * pagesize) + { + r.filesize = r.range.size + unexec_regions[i].filesize; + r.range.size += unexec_regions[i].range.size; + } + else + { + unexec_regions[n++] = r; + r = unexec_regions[i]; + } + } + unexec_regions[n++] = r; + num_unexec_regions = n; +} + + +/* More informational messages routines. */ + +static void +print_load_command_name (int lc) +{ + switch (lc) + { + case LC_SEGMENT: +#ifndef _LP64 + printf ("LC_SEGMENT "); +#else + printf ("LC_SEGMENT_64 "); +#endif + break; + case LC_LOAD_DYLINKER: + printf ("LC_LOAD_DYLINKER "); + break; + case LC_LOAD_DYLIB: + printf ("LC_LOAD_DYLIB "); + break; + case LC_SYMTAB: + printf ("LC_SYMTAB "); + break; + case LC_DYSYMTAB: + printf ("LC_DYSYMTAB "); + break; + case LC_UNIXTHREAD: + printf ("LC_UNIXTHREAD "); + break; + case LC_PREBOUND_DYLIB: + printf ("LC_PREBOUND_DYLIB"); + break; + case LC_TWOLEVEL_HINTS: + printf ("LC_TWOLEVEL_HINTS"); + break; + default: + printf ("unknown "); + } +} + +static void +print_load_command (struct load_command *lc) +{ + print_load_command_name (lc->cmd); + printf ("%8d", lc->cmdsize); + + if (lc->cmd == LC_SEGMENT) + { + struct segment_command *scp; + struct section *sectp; + int j; + + scp = (struct segment_command *) lc; + printf (" %-16.16s %#10lx %#8lx\n", + scp->segname, (long) (scp->vmaddr), (long) (scp->vmsize)); + + sectp = (struct section *) (scp + 1); + for (j = 0; j < scp->nsects; j++) + { + printf (" %-16.16s %#10lx %#8lx\n", + sectp->sectname, (long) (sectp->addr), (long) (sectp->size)); + sectp++; + } + } + else + printf ("\n"); +} + +/* Read header and load commands from input file. Store the latter in + the global array lca. Store the total number of load commands in + global variable nlc. */ +static void +read_load_commands () +{ + int i; + + if (!unexec_read (&mh, sizeof (struct mach_header))) + unexec_error ("cannot read mach-o header"); + + if (mh.magic != MH_MAGIC) + unexec_error ("input file not in Mach-O format"); + + if (mh.filetype != MH_EXECUTE) + unexec_error ("input Mach-O file is not an executable object file"); + +#if VERBOSE + printf ("--- Header Information ---\n"); + printf ("Magic = 0x%08x\n", mh.magic); + printf ("CPUType = %d\n", mh.cputype); + printf ("CPUSubType = %d\n", mh.cpusubtype); + printf ("FileType = 0x%x\n", mh.filetype); + printf ("NCmds = %d\n", mh.ncmds); + printf ("SizeOfCmds = %d\n", mh.sizeofcmds); + printf ("Flags = 0x%08x\n", mh.flags); +#endif + + nlc = mh.ncmds; + lca = (struct load_command **) malloc (nlc * sizeof (struct load_command *)); + + for (i = 0; i < nlc; i++) + { + struct load_command lc; + /* Load commands are variable-size: so read the command type and + size first and then read the rest. */ + if (!unexec_read (&lc, sizeof (struct load_command))) + unexec_error ("cannot read load command"); + lca[i] = (struct load_command *) malloc (lc.cmdsize); + memcpy (lca[i], &lc, sizeof (struct load_command)); + if (!unexec_read (lca[i] + 1, lc.cmdsize - sizeof (struct load_command))) + unexec_error ("cannot read content of load command"); + if (lc.cmd == LC_SEGMENT) + { + struct segment_command *scp = (struct segment_command *) lca[i]; + + if (scp->vmaddr + scp->vmsize > infile_lc_highest_addr) + infile_lc_highest_addr = scp->vmaddr + scp->vmsize; + + if (strncmp (scp->segname, SEG_TEXT, 16) == 0) + { + struct section *sectp = (struct section *) (scp + 1); + int j; + + for (j = 0; j < scp->nsects; j++) + if (sectp->offset < text_seg_lowest_offset) + text_seg_lowest_offset = sectp->offset; + } + } + } + + printf ("Highest address of load commands in input file: %#8x\n", + infile_lc_highest_addr); + + printf ("Lowest offset of all sections in __TEXT segment: %#8lx\n", + text_seg_lowest_offset); + + printf ("--- List of Load Commands in Input File ---\n"); + printf ("# cmd cmdsize name address size\n"); + + for (i = 0; i < nlc; i++) + { + printf ("%1d ", i); + print_load_command (lca[i]); + } +} + +/* Copy a LC_SEGMENT load command other than the __DATA segment from + the input file to the output file, adjusting the file offset of the + segment and the file offsets of sections contained in it. */ +static void +copy_segment (struct load_command *lc) +{ + struct segment_command *scp = (struct segment_command *) lc; + unsigned long old_fileoff = scp->fileoff; + struct section *sectp; + int j; + + scp->fileoff = curr_file_offset; + + sectp = (struct section *) (scp + 1); + for (j = 0; j < scp->nsects; j++) + { + sectp->offset += curr_file_offset - old_fileoff; + sectp++; + } + + printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", + scp->segname, (long) (scp->fileoff), (long) (scp->filesize), + (long) (scp->vmsize), (long) (scp->vmaddr)); + + if (!unexec_copy (scp->fileoff, old_fileoff, scp->filesize)) + unexec_error ("cannot copy segment from input to output file"); + curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write load command to header"); + + curr_header_offset += lc->cmdsize; +} + +/* Copy a LC_SEGMENT load command for the __DATA segment in the input + file to the output file. We assume that only one such segment load + command exists in the input file and it contains the sections + __data, __bss, __common, __la_symbol_ptr, __nl_symbol_ptr, and + __dyld. The first three of these should be dumped from memory and + the rest should be copied from the input file. Note that the + sections __bss and __common contain no data in the input file + because their flag fields have the value S_ZEROFILL. Dumping these + from memory makes it necessary to adjust file offset fields in + subsequently dumped load commands. Then, create new __DATA segment + load commands for regions on the region list other than the one + corresponding to the __DATA segment in the input file. */ +static void +copy_data_segment (struct load_command *lc) +{ + struct segment_command *scp = (struct segment_command *) lc; + struct section *sectp; + int j; + unsigned long header_offset, old_file_offset; + + /* The new filesize of the segment is set to its vmsize because data + blocks for segments must start at region boundaries. Note that + this may leave unused locations at the end of the segment data + block because the total of the sizes of all sections in the + segment is generally smaller than vmsize. */ + scp->filesize = scp->vmsize; + + printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", + scp->segname, curr_file_offset, (long)(scp->filesize), + (long)(scp->vmsize), (long) (scp->vmaddr)); + + /* Offsets in the output file for writing the next section structure + and segment data block, respectively. */ + header_offset = curr_header_offset + sizeof (struct segment_command); + + sectp = (struct section *) (scp + 1); + for (j = 0; j < scp->nsects; j++) + { + old_file_offset = sectp->offset; + sectp->offset = sectp->addr - scp->vmaddr + curr_file_offset; + /* The __data section is dumped from memory. The __bss and + __common sections are also dumped from memory but their flag + fields require changing (from S_ZEROFILL to S_REGULAR). The + other three kinds of sections are just copied from the input + file. */ + if (strncmp (sectp->sectname, SECT_DATA, 16) == 0) + { + if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) + unexec_error ("cannot write section %s", SECT_DATA); + if (!unexec_write (header_offset, sectp, sizeof (struct section))) + unexec_error ("cannot write section %s's header", SECT_DATA); + } + else if (strncmp (sectp->sectname, SECT_COMMON, 16) == 0) + { + sectp->flags = S_REGULAR; + if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) + unexec_error ("cannot write section %s", sectp->sectname); + if (!unexec_write (header_offset, sectp, sizeof (struct section))) + unexec_error ("cannot write section %s's header", sectp->sectname); + } + else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0) + { + extern char *my_endbss_static; + unsigned long my_size; + + sectp->flags = S_REGULAR; + + /* Clear uninitialized local variables in statically linked + libraries. In particular, function pointers stored by + libSystemStub.a, which is introduced in Mac OS X 10.4 for + binary compatibility with respect to long double, are + cleared so that they will be reinitialized when the + dumped binary is executed on other versions of OS. */ + my_size = (unsigned long)my_endbss_static - sectp->addr; + if (!(sectp->addr <= (unsigned long)my_endbss_static + && my_size <= sectp->size)) + unexec_error ("my_endbss_static is not in section %s", + sectp->sectname); + if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size)) + unexec_error ("cannot write section %s", sectp->sectname); + if (!unexec_write_zero (sectp->offset + my_size, + sectp->size - my_size)) + unexec_error ("cannot write section %s", sectp->sectname); + if (!unexec_write (header_offset, sectp, sizeof (struct section))) + unexec_error ("cannot write section %s's header", sectp->sectname); + } + else if (strncmp (sectp->sectname, "__la_symbol_ptr", 16) == 0 + || strncmp (sectp->sectname, "__nl_symbol_ptr", 16) == 0 + || strncmp (sectp->sectname, "__la_sym_ptr2", 16) == 0 + || strncmp (sectp->sectname, "__dyld", 16) == 0 + || strncmp (sectp->sectname, "__const", 16) == 0 + || strncmp (sectp->sectname, "__cfstring", 16) == 0) + { + if (!unexec_copy (sectp->offset, old_file_offset, sectp->size)) + unexec_error ("cannot copy section %s", sectp->sectname); + if (!unexec_write (header_offset, sectp, sizeof (struct section))) + unexec_error ("cannot write section %s's header", sectp->sectname); + } + else + unexec_error ("unrecognized section name in __DATA segment"); + + printf (" section %-16.16s at %#8lx - %#8lx (sz: %#8lx)\n", + sectp->sectname, (long) (sectp->offset), + (long) (sectp->offset + sectp->size), (long) (sectp->size)); + + header_offset += sizeof (struct section); + sectp++; + } + + curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); + + if (!unexec_write (curr_header_offset, scp, sizeof (struct segment_command))) + unexec_error ("cannot write header of __DATA segment"); + curr_header_offset += lc->cmdsize; + + /* Create new __DATA segment load commands for regions on the region + list that do not corresponding to any segment load commands in + the input file. + */ + for (j = 0; j < num_unexec_regions; j++) + { + struct segment_command sc; + + sc.cmd = LC_SEGMENT; + sc.cmdsize = sizeof (struct segment_command); + strncpy (sc.segname, SEG_DATA, 16); + sc.vmaddr = unexec_regions[j].range.address; + sc.vmsize = unexec_regions[j].range.size; + sc.fileoff = curr_file_offset; + sc.filesize = unexec_regions[j].filesize; + sc.maxprot = VM_PROT_READ | VM_PROT_WRITE; + sc.initprot = VM_PROT_READ | VM_PROT_WRITE; + sc.nsects = 0; + sc.flags = 0; + + printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", + sc.segname, (long) (sc.fileoff), (long) (sc.filesize), + (long) (sc.vmsize), (long) (sc.vmaddr)); + + if (!unexec_write (sc.fileoff, (void *) sc.vmaddr, sc.filesize)) + unexec_error ("cannot write new __DATA segment"); + curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (sc.filesize); + + if (!unexec_write (curr_header_offset, &sc, sc.cmdsize)) + unexec_error ("cannot write new __DATA segment's header"); + curr_header_offset += sc.cmdsize; + mh.ncmds++; + } +} + +/* Copy a LC_SYMTAB load command from the input file to the output + file, adjusting the file offset fields. */ +static void +copy_symtab (struct load_command *lc, long delta) +{ + struct symtab_command *stp = (struct symtab_command *) lc; + + stp->symoff += delta; + stp->stroff += delta; + + printf ("Writing LC_SYMTAB command\n"); + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write symtab command to header"); + + curr_header_offset += lc->cmdsize; +} + +/* Fix up relocation entries. */ +static void +unrelocate (const char *name, off_t reloff, int nrel) +{ + int i, unreloc_count; + struct relocation_info reloc_info; + struct scattered_relocation_info *sc_reloc_info + = (struct scattered_relocation_info *) &reloc_info; + + for (unreloc_count = 0, i = 0; i < nrel; i++) + { + if (lseek (infd, reloff, L_SET) != reloff) + unexec_error ("unrelocate: %s:%d cannot seek to reloc_info", name, i); + if (!unexec_read (&reloc_info, sizeof (reloc_info))) + unexec_error ("unrelocate: %s:%d cannot read reloc_info", name, i); + reloff += sizeof (reloc_info); + + if (sc_reloc_info->r_scattered == 0) + switch (reloc_info.r_type) + { + case GENERIC_RELOC_VANILLA: + if (reloc_info.r_address >= data_segment_scp->vmaddr + && reloc_info.r_address < (data_segment_scp->vmaddr + + data_segment_scp->vmsize)) + { + off_t src_off = data_segment_old_fileoff + + reloc_info.r_address - data_segment_scp->vmaddr; + off_t dst_off = data_segment_scp->fileoff + + reloc_info.r_address - data_segment_scp->vmaddr; + + if (!unexec_copy (dst_off, src_off, 1 << reloc_info.r_length)) + unexec_error ("unrelocate: %s:%d cannot copy original value", + name, i); + unreloc_count++; + } + break; + default: + unexec_error ("unrelocate: %s:%d cannot handle type = %d", + name, i, reloc_info.r_type); + } + else + switch (sc_reloc_info->r_type) + { +#if defined (__ppc__) + case PPC_RELOC_PB_LA_PTR: + /* nothing to do for prebound lazy pointer */ + break; +#endif + default: + unexec_error ("unrelocate: %s:%d cannot handle scattered type = %d", + name, i, sc_reloc_info->r_type); + } + } + + if (nrel > 0) + printf ("Fixed up %d/%d %s relocation entries in data segment.\n", + unreloc_count, nrel, name); +} + +/* Copy a LC_DYSYMTAB load command from the input file to the output + file, adjusting the file offset fields. */ +static void +copy_dysymtab (struct load_command *lc, long delta) +{ + struct dysymtab_command *dstp = (struct dysymtab_command *) lc; + + unrelocate ("local", dstp->locreloff, dstp->nlocrel); + unrelocate ("external", dstp->extreloff, dstp->nextrel); + + if (dstp->nextrel > 0) { + dstp->extreloff += delta; + } + + if (dstp->nlocrel > 0) { + dstp->locreloff += delta; + } + + if (dstp->nindirectsyms > 0) + dstp->indirectsymoff += delta; + + printf ("Writing LC_DYSYMTAB command\n"); + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write symtab command to header"); + + curr_header_offset += lc->cmdsize; +} + +/* Copy a LC_TWOLEVEL_HINTS load command from the input file to the output + file, adjusting the file offset fields. */ +static void +copy_twolevelhints (struct load_command *lc, long delta) +{ + struct twolevel_hints_command *tlhp = (struct twolevel_hints_command *) lc; + + if (tlhp->nhints > 0) { + tlhp->offset += delta; + } + + printf ("Writing LC_TWOLEVEL_HINTS command\n"); + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write two level hint command to header"); + + curr_header_offset += lc->cmdsize; +} + +/* Copy other kinds of load commands from the input file to the output + file, ones that do not require adjustments of file offsets. */ +static void +copy_other (struct load_command *lc) +{ + printf ("Writing "); + print_load_command_name (lc->cmd); + printf (" command\n"); + + if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) + unexec_error ("cannot write symtab command to header"); + + curr_header_offset += lc->cmdsize; +} + +/* Loop through all load commands and dump them. Then write the Mach + header. */ +static void +dump_it () +{ + int i; + long linkedit_delta = 0; + + printf ("--- Load Commands written to Output File ---\n"); + + for (i = 0; i < nlc; i++) + switch (lca[i]->cmd) + { + case LC_SEGMENT: + { + struct segment_command *scp = (struct segment_command *) lca[i]; + if (strncmp (scp->segname, SEG_DATA, 16) == 0) + { + /* save data segment file offset and segment_command for + unrelocate */ + if (data_segment_old_fileoff) + unexec_error ("cannot handle multiple DATA segments" + " in input file"); + data_segment_old_fileoff = scp->fileoff; + data_segment_scp = scp; + + copy_data_segment (lca[i]); + } + else + { + if (strncmp (scp->segname, SEG_LINKEDIT, 16) == 0) + { + if (linkedit_delta) + unexec_error ("cannot handle multiple LINKEDIT segments" + " in input file"); + linkedit_delta = curr_file_offset - scp->fileoff; + } + + copy_segment (lca[i]); + } + } + break; + case LC_SYMTAB: + copy_symtab (lca[i], linkedit_delta); + break; + case LC_DYSYMTAB: + copy_dysymtab (lca[i], linkedit_delta); + break; + case LC_TWOLEVEL_HINTS: + copy_twolevelhints (lca[i], linkedit_delta); + break; + default: + copy_other (lca[i]); + break; + } + + if (curr_header_offset > text_seg_lowest_offset) + unexec_error ("not enough room for load commands for new __DATA segments"); + + printf ("%ld unused bytes follow Mach-O header\n", + text_seg_lowest_offset - curr_header_offset); + + mh.sizeofcmds = curr_header_offset - sizeof (struct mach_header); + if (!unexec_write (0, &mh, sizeof (struct mach_header))) + unexec_error ("cannot write final header contents"); +} + +/* Take a snapshot of Emacs and make a Mach-O format executable file + from it. The file names of the output and input files are outfile + and infile, respectively. The three other parameters are + ignored. */ +void +unexec (char *outfile, char *infile, void *start_data, void *start_bss, + void *entry_address) +{ + if (in_dumped_exec) + unexec_error ("Unexec from a dumped executable is not supported."); + + pagesize = getpagesize (); + infd = open (infile, O_RDONLY, 0); + if (infd < 0) + { + unexec_error ("cannot open input file `%s'", infile); + } + + outfd = open (outfile, O_WRONLY | O_TRUNC | O_CREAT, 0755); + if (outfd < 0) + { + close (infd); + unexec_error ("cannot open output file `%s'", outfile); + } + + build_region_list (); + read_load_commands (); + + find_emacs_zone_regions (); + unexec_regions_merge (); + + in_dumped_exec = 1; + + dump_it (); + + close (outfd); +} + + +void +unexec_init_emacs_zone () +{ + emacs_zone = malloc_create_zone (0, 0); + malloc_set_zone_name (emacs_zone, "EmacsZone"); +} + +#ifndef MACOSX_MALLOC_MULT16 +#define MACOSX_MALLOC_MULT16 1 +#endif + +typedef struct unexec_malloc_header { + union { + char c[8]; + size_t size; + } u; +} unexec_malloc_header_t; + +#if MACOSX_MALLOC_MULT16 + +#define ptr_in_unexec_regions(p) ((((vm_address_t) (p)) & 8) != 0) + +#else + +int +ptr_in_unexec_regions (void *ptr) +{ + int i; + + for (i = 0; i < num_unexec_regions; i++) + if ((vm_address_t) ptr - unexec_regions[i].range.address + < unexec_regions[i].range.size) + return 1; + + return 0; +} + +#endif + +void * +unexec_malloc (size_t size) +{ + if (in_dumped_exec) + { + void *p; + + p = malloc (size); +#if MACOSX_MALLOC_MULT16 + assert (((vm_address_t) p % 16) == 0); +#endif + return p; + } + else + { + unexec_malloc_header_t *ptr; + + ptr = (unexec_malloc_header_t *) + malloc_zone_malloc (emacs_zone, size + sizeof (unexec_malloc_header_t)); + ptr->u.size = size; + ptr++; +#if MACOSX_MALLOC_MULT16 + assert (((vm_address_t) ptr % 16) == 8); +#endif + return (void *) ptr; + } +} + +void * +unexec_realloc (void *old_ptr, size_t new_size) +{ + if (in_dumped_exec) + { + void *p; + + if (ptr_in_unexec_regions (old_ptr)) + { + size_t old_size = ((unexec_malloc_header_t *) old_ptr)[-1].u.size; + size_t size = new_size > old_size ? old_size : new_size; + + p = (size_t *) malloc (new_size); + if (size) + memcpy (p, old_ptr, size); + } + else + { + p = realloc (old_ptr, new_size); + } +#if MACOSX_MALLOC_MULT16 + assert (((vm_address_t) p % 16) == 0); +#endif + return p; + } + else + { + unexec_malloc_header_t *ptr; + + ptr = (unexec_malloc_header_t *) + malloc_zone_realloc (emacs_zone, (unexec_malloc_header_t *) old_ptr - 1, + new_size + sizeof (unexec_malloc_header_t)); + ptr->u.size = new_size; + ptr++; +#if MACOSX_MALLOC_MULT16 + assert (((vm_address_t) ptr % 16) == 8); +#endif + return (void *) ptr; + } +} + +void +unexec_free (void *ptr) +{ + if (in_dumped_exec) + { + if (!ptr_in_unexec_regions (ptr)) + free (ptr); + } + else + malloc_zone_free (emacs_zone, (unexec_malloc_header_t *) ptr - 1); +} + +/* arch-tag: 1a784f7b-a184-4c4f-9544-da8619593d72 + (do not change this comment) */ diff --git a/unexsgi.c b/unexsgi.c old mode 100644 new mode 100755 diff --git a/unexsunos4.c b/unexsunos4.c old mode 100644 new mode 100755 diff --git a/unif.c b/unif.c old mode 100644 new mode 100755 index 490d2a7..ca05d3b --- a/unif.c +++ b/unif.c @@ -138,6 +138,8 @@ long scm_prot2type(prot) case BOOL_T: return tc7_Vbool; case MAKINUM(8L): return tc7_VfixN8; case MAKINUM(16L): return tc7_VfixN16; + case MAKINUM(64L): return tc7_VfixN64; + case MAKINUM(-64L): return tc7_VfixZ64; case MAKINUM(32L): return tc7_VfixN32; case MAKINUM(-32L): return tc7_VfixZ32; case MAKINUM(-16L): return tc7_VfixZ16; @@ -226,19 +228,12 @@ SCM arrayp(v, prot) if (enclosed++) return BOOL_F; v = ARRAY_V(v); goto loop; + case tc7_vector: + case tc7_VfloR64: case tc7_VfloC64: case tc7_VfloR32: case tc7_VfloC32: + case tc7_VfixN64: case tc7_VfixZ64: case tc7_VfixN32: case tc7_VfixZ32: + case tc7_VfixN16: case tc7_VfixZ16: case tc7_VfixN8: case tc7_VfixZ8: case tc7_Vbool: case tc7_string: - case tc7_VfixN32: - case tc7_VfixZ32: - case tc7_VfixN16: - case tc7_VfixZ16: - case tc7_VfixN8: - case tc7_VfixZ8: - case tc7_VfloR32: - case tc7_VfloC32: - case tc7_VfloR64: - case tc7_VfloC64: - case tc7_vector: if (UNBNDP(prot)) return BOOL_T; if (scm_prot2type(prot)==typ) return BOOL_T; } @@ -1731,11 +1726,11 @@ SCM list2ura(ndim, prot, lst) SCM row=lst; SCM ra; long n; - sizet k = INUM(ndim); - ASRTER(INUMP(ndim), ndim, ARG1, s_list2ura); - for (; k--; NIMP(row) && (row = CAR(row))) { + int k = INUM(ndim); + ASRTER(INUMP(ndim) && k >= 0, ndim, ARG1, s_list2ura); + for (; --k >= 0 ; (NIMP(row) && (row = CAR(row)))) { n = ilength(row); - ASRTER(n>=0, lst, ARG2, s_list2ura); + ASRTER(n>=0, lst, ARG3, s_list2ura); shp = cons(MAKINUM(n), shp); } ra = dims2ura(reverse(shp), prot, EOL); @@ -1942,6 +1937,10 @@ int raprin1(exp, port, writing) lputc('A', port); break; case tc7_string: lputs("A:char", port); break; + case tc7_VfixN64: + lputs("A:fixN64b", port); break; + case tc7_VfixZ64: + lputs("A:fixZ64b", port); break; case tc7_VfixN32: lputs("A:fixN32b", port); break; case tc7_VfixZ32: @@ -1994,6 +1993,8 @@ SCM array_prot(ra) case tc7_vector: return EOL; case tc7_Vbool: return BOOL_T; case tc7_string: return MAKICHR('a'); + case tc7_VfixN64: return MAKINUM(64L); + case tc7_VfixZ64: return MAKINUM(-64L); case tc7_VfixN32: return MAKINUM(32L); case tc7_VfixZ32: return MAKINUM(-32L); case tc7_VfixN16: return MAKINUM(16L); diff --git a/unix.c b/unix.c old mode 100644 new mode 100755 diff --git a/version.txi b/version.txi old mode 100644 new mode 100755 index 8c730ca..89f18e9 --- a/version.txi +++ b/version.txi @@ -1,2 +1,2 @@ -@set SCMVERSION 5e5 -@set SCMDATE February 2008 +@set SCMVERSION 5f2 +@set SCMDATE January 2015 diff --git a/wbtab.scm b/wbtab.scm old mode 100644 new mode 100755 index cf15647..102828d --- a/wbtab.scm +++ b/wbtab.scm @@ -1,5 +1,5 @@ ;;; "wbtab.scm" database tables using WB b-trees. -; Copyright 1996, 2000, 2001, 2003 Aubrey Jaffer +; Copyright 1996, 2000, 2001, 2003, 2008 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -23,14 +23,8 @@ (require 'byte-number) (require 'relational-database) ;for make-relational-system -;;; WB-SEG:LOCKS has one extra location at end for loop end test -(defvar wb-seg:locks (let ((locks (make-vector (+ 1 wb:num-segs) #f))) - (do ((i (+ -2 (vector-length locks)) (+ -1 i))) - ((negative? i) locks) - (vector-set! locks i (make-arbiter i))))) -(defvar wb-seg:files (make-vector (+ 1 wb:num-segs) #f)) -(defvar wb-seg:roots (make-vector (+ 1 wb:num-segs) #f)) -(defvar wb-seg:mut?s (make-vector (+ 1 wb:num-segs) #f)) +(init-wb 75 150 2048) + ;@ (define wb-table ;; foiled indentation so etags will recognize definitions @@ -90,88 +84,58 @@ ((or (negative? k) (null? lst)) ans) (set-cdr! tail (list (car lst)))))))) -;;;; Segments - -(define (find-free-seg) - (do ((i 0 (+ 1 i)) - (arb (vector-ref wb-seg:locks 0) - (vector-ref wb-seg:locks (+ 1 i)))) - ((or (not arb) (try-arbiter arb)) - (and arb i)))) -(define (release-seg seg) - (and seg - (release-arbiter (vector-ref wb-seg:locks seg)) - #f)) - ;;;; Create, open, write, sync, or close database. -(define (seg-open-base seg filename writable?) - (vector-set! wb-seg:files seg filename) - (vector-set! wb-seg:mut?s seg writable?) - (vector-set! wb-seg:roots seg (open-db seg root-name)) - (cond ((wb:err? (vector-ref wb-seg:roots seg)) - (close-base seg) - #f) - (else seg))) - ;;; Because B-trees grow in depth only very slowly, we might as well ;;; put everything into one B-tree named "rwb". (define (make-base filename dim types) - (define seg (find-free-seg)) - (cond ((not seg) #f) - ((wb:err? (make-seg seg filename 2048)) (release-seg seg) #f) - ((wb:err? (open-seg seg filename 2)) (release-seg seg) #f) + (define seg (make-seg filename 2048)) + (cond ((not seg) + (slib:error 'make-base "couldn't make new base" filename) + #f) ((or (wb:err? (bt:put! (create-db seg #\T root-name) free-id "1")) (wb:err? (bt:put! (open-bt seg 0 1) "base-table" "wb-table"))) - (release-seg seg) (slib:error 'make-base "couldn't modify new base" filename) #f) - (else (seg-open-base seg filename #t)))) + (else seg))) (define (open-base filename writable?) - (define seg (find-free-seg)) - (cond ((wb:err? (open-seg seg filename (if writable? 2 0))) - (release-seg seg) #f) - (else (seg-open-base seg filename writable?)))) + (open-seg filename writable?)) (define (write-base seg filename) - (cond ((and filename - (equal? filename (vector-ref wb-seg:files seg))) + (cond ((and filename (equal? filename (SEG:STR seg))) (let ((status (close-seg seg #f))) (cond ((wb:err? status) #f) - ((wb:err? (open-seg seg filename 2)) #f) - (else #t)))) + (else + (set! seg (open-seg filename #t)) + (cond ((not seg) #f) + (else #t)))))) (else ;;(slib:error 'write-base "WB can't change database filename" filename) #f))) (define (sync-base seg) - (and seg (write-base seg (vector-ref wb-seg:files seg)))) + (and seg (write-base seg (SEG:STR seg)))) (define (close-base seg) - (cond ((wb:err? (close-seg seg #f)) - (let ((status (close-seg seg #t))) - (release-seg seg) - (not (wb:err? status)))) - (else (release-seg seg) #t))) + (not (wb:err? (close-seg seg #f)))) ;;;; Make, open, and destroy tables. (define (make-table seg dim types) - (and (vector-ref wb-seg:mut?s seg) - (let* ((tns (bt:rem (vector-ref wb-seg:roots seg) free-id)) + (and (SEG:MUTABLE? seg) + (let* ((root (open-db seg root-name)) + (tns (bt:rem root free-id)) (base-id (and (string? tns) (string->number tns)))) (cond ((not tns) (slib:error 'make-table 'free-id "in use?") #f) ((not base-id) - (bt:put (vector-ref wb-seg:roots seg) free-id tns) + (bt:put root free-id tns) (slib:error 'make-table "free-id corrupted" base-id) #f) - ((not (bt:put (vector-ref wb-seg:roots seg) - free-id - (number->string (+ 1 base-id)))) + ((not (bt:put root free-id (number->string (+ 1 base-id)))) (slib:error 'make-table "free-id lock broken") #f) (else base-id))))) diff --git a/x.c b/x.c old mode 100644 new mode 100755 index d619724..e6db874 --- a/x.c +++ b/x.c @@ -665,8 +665,8 @@ void scm2XPoint(signp, dat, ipr, pos, s_caller) ASRTGO(ARRAYP(dat) && 1==ARRAY_NDIM(dat) && 0==ARRAY_DIMS(dat)[0].lbnd && 1==ARRAY_DIMS(dat)[0].ubnd, badarg); - x = aref(dat, MAKINUM(0)); - y = aref(dat, MAKINUM(1)); + x = aref(dat, MAKINUM(0L)); + y = aref(dat, MAKINUM(1L)); break; } ASRTGO(INUMP(x) && INUMP(y), badarg); @@ -2147,7 +2147,7 @@ SCM xldraw_lines(sdbl, sgc, sargs, funcod, s_caller) goto loop; } } else { - unsigned long rabase; + void* rabase; ASRTGO(NULLP(sargs), wna); rabase = scm_base_addr(sarg, s_caller); switch (funcod) { diff --git a/x.h b/x.h old mode 100644 new mode 100755 diff --git a/x11.scm b/x11.scm index ad6691c..58368f4 100644 --- a/x11.scm +++ b/x11.scm @@ -72,7 +72,8 @@ (define x:Colormap-Notify 32) (define x:Client-Message 33) (define x:Mapping-Notify 34) -(define x:LAST-Event 35) +(define x:Generic-Event 35) +(define x:LAST-Event 36) (define x:Shift-Mask 1) (define x:Lock-Mask 2) (define x:Control-Mask 4) @@ -434,16 +435,16 @@ (define x:Queued-After-Reading 1) (define x:Queued-After-Flush 2) (define x:All-Planes -1) -(define x:XN-Required-Char-Set 134532633) -(define x:XN-Query-Orientation 134532672) -(define x:XN-Base-Font-Name 134532712) -(define x:XNOM-Automatic 134532745) -(define x:XN-Missing-Char-Set 134532774) -(define x:XN-Default-String 134532811) -(define x:XN-Orientation 134532845) -(define x:XN-Directional-Dependent-Drawing 134532874) -(define x:XN-Contextual-Drawing 134532939) -(define x:XN-Font-Info 134532981) +(define x:XN-Required-Char-Set 4214769) +(define x:XN-Query-Orientation 4214808) +(define x:XN-Base-Font-Name 4214848) +(define x:XNOM-Automatic 4214881) +(define x:XN-Missing-Char-Set 4214910) +(define x:XN-Default-String 4214947) +(define x:XN-Orientation 4214981) +(define x:XN-Directional-Dependent-Drawing 4215010) +(define x:XN-Contextual-Drawing 4215075) +(define x:XN-Font-Info 4215117) (define x:XIM-Preedit-Area 1) (define x:XIM-Preedit-Callbacks 2) (define x:XIM-Preedit-Position 4) @@ -453,48 +454,48 @@ (define x:XIM-Status-Callbacks 512) (define x:XIM-Status-Nothing 1024) (define x:XIM-Status-None 2048) -(define x:XN-Va-Nested-List 134533192) -(define x:XN-Query-Input-Style 134533227) -(define x:XN-Client-Window 134533266) -(define x:XN-Input-Style 134533298) -(define x:XN-Focus-Window 134533326) -(define x:XN-Resource-Name 134533356) -(define x:XN-Resource-Class 134533388) -(define x:XN-Geometry-Callback 134533422) -(define x:XN-Destroy-Callback 134533462) -(define x:XN-Filter-Events 134533500) -(define x:XN-Preedit-Start-Callback 134533532) -(define x:XN-Preedit-Done-Callback 134533581) -(define x:XN-Preedit-Draw-Callback 134533628) -(define x:XN-Preedit-Caret-Callback 134533675) -(define x:XN-Preedit-State-Notify-Callback 134533724) -(define x:XN-Preedit-Attributes 134533787) -(define x:XN-Status-Start-Callback 134533829) -(define x:XN-Status-Done-Callback 134533876) -(define x:XN-Status-Draw-Callback 134533921) -(define x:XN-Status-Attributes 134533966) -(define x:XN-Area 134534006) -(define x:XN-Area-Needed 134534021) -(define x:XN-Spot-Location 134534049) -(define x:XN-Colormap 134534081) -(define x:XN-Std-Colormap 134534104) -(define x:XN-Foreground 134534134) -(define x:XN-Background 134534161) -(define x:XN-Background-Pixmap 134534188) -(define x:XN-Font-Set 134534228) -(define x:XN-Line-Space 134534250) -(define x:XN-Cursor 134534276) -(define x:XN-Query-IM-Values-List 134534295) -(define x:XN-Query-IC-Values-List 134534339) -(define x:XN-Visible-Position 134534383) -(define x:XNR6-Preedit-Callback 134534421) -(define x:XN-String-Conversion-Callback 134534463) -(define x:XN-String-Conversion 134534520) -(define x:XN-Reset-State 134534560) -(define x:XN-Hot-Key 134534588) -(define x:XN-Hot-Key-State 134534608) -(define x:XN-Preedit-State 134534639) -(define x:XN-Separatorof-Nested-List 134534671) +(define x:XN-Va-Nested-List 4215328) +(define x:XN-Query-Input-Style 4215363) +(define x:XN-Client-Window 4215402) +(define x:XN-Input-Style 4215434) +(define x:XN-Focus-Window 4215462) +(define x:XN-Resource-Name 4215492) +(define x:XN-Resource-Class 4215524) +(define x:XN-Geometry-Callback 4215558) +(define x:XN-Destroy-Callback 4215598) +(define x:XN-Filter-Events 4215636) +(define x:XN-Preedit-Start-Callback 4215668) +(define x:XN-Preedit-Done-Callback 4215717) +(define x:XN-Preedit-Draw-Callback 4215764) +(define x:XN-Preedit-Caret-Callback 4215811) +(define x:XN-Preedit-State-Notify-Callback 4215860) +(define x:XN-Preedit-Attributes 4215923) +(define x:XN-Status-Start-Callback 4215965) +(define x:XN-Status-Done-Callback 4216012) +(define x:XN-Status-Draw-Callback 4216057) +(define x:XN-Status-Attributes 4216102) +(define x:XN-Area 4216142) +(define x:XN-Area-Needed 4216157) +(define x:XN-Spot-Location 4216185) +(define x:XN-Colormap 4216217) +(define x:XN-Std-Colormap 4216240) +(define x:XN-Foreground 4216270) +(define x:XN-Background 4216297) +(define x:XN-Background-Pixmap 4216324) +(define x:XN-Font-Set 4216364) +(define x:XN-Line-Space 4216386) +(define x:XN-Cursor 4216412) +(define x:XN-Query-IM-Values-List 4216431) +(define x:XN-Query-IC-Values-List 4216475) +(define x:XN-Visible-Position 4216519) +(define x:XNR6-Preedit-Callback 4216557) +(define x:XN-String-Conversion-Callback 4216599) +(define x:XN-String-Conversion 4216656) +(define x:XN-Reset-State 4216696) +(define x:XN-Hot-Key 4216724) +(define x:XN-Hot-Key-State 4216744) +(define x:XN-Preedit-State 4216775) +(define x:XN-Separatorof-Nested-List 4216807) (define x:X-Buffer-Overflow -1) (define x:X-Lookup-None 1) (define x:X-Lookup-Chars 2) diff --git a/xatoms.scm b/xatoms.scm old mode 100644 new mode 100755 diff --git a/xevent.h b/xevent.h old mode 100644 new mode 100755 diff --git a/xevent.scm b/xevent.scm old mode 100644 new mode 100755 diff --git a/xgen.scm b/xgen.scm index 8296775..04a8804 100755 --- a/xgen.scm +++ b/xgen.scm @@ -1,4 +1,4 @@ -#! /usr/local/bin/scm \ %0 %* +#! ./scmlit \ - !# ;;;; "xgen.scm", Convert C Event structs to xevent.h and xevent.scm. ;; Copyright (C) 1991-2000 Free Software Foundation, Inc. @@ -34,7 +34,7 @@ Usage: xgen.scm /usr/include/X11/Xlib.h Creates xevent.h and xevent.scm, from the `typedef struct's in /usr/include/X11/xlib.h. -http://swiss.csail.mit.edu/~jaffer/SCM +http://people.csail.mit.edu/jaffer/SCM " (current-error-port)) #f) -- cgit v1.2.3