diff options
| -rw-r--r-- | ANNOUNCE | 237 | ||||
| -rw-r--r-- | ChangeLog | 274 | ||||
| -rw-r--r-- | Init5e3.scm (renamed from Init5e2.scm) | 148 | ||||
| -rw-r--r-- | Makefile | 143 | ||||
| -rw-r--r-- | README | 27 | ||||
| -rw-r--r-- | Transcen.scm | 170 | ||||
| -rw-r--r-- | Xlibscm.info | 136 | ||||
| -rw-r--r-- | Xlibscm.texi | 126 | ||||
| -rw-r--r-- | bench.scm | 2 | ||||
| -rw-r--r-- | build.scm | 43 | ||||
| -rw-r--r-- | byte.c | 23 | ||||
| -rw-r--r-- | continue-ia64.S | 365 | ||||
| -rw-r--r-- | continue.c | 44 | ||||
| -rw-r--r-- | continue.h | 125 | ||||
| -rw-r--r-- | disarm.scm | 2 | ||||
| -rw-r--r-- | eval.c | 191 | ||||
| -rw-r--r-- | features.txi | 18 | ||||
| -rw-r--r-- | get-contoffset-ia64.c | 107 | ||||
| -rw-r--r-- | hobbit.info | 157 | ||||
| -rw-r--r-- | hobbit.scm | 30 | ||||
| -rw-r--r-- | hobbit.texi | 93 | ||||
| -rw-r--r-- | indexes.texi | 50 | ||||
| -rw-r--r-- | mkimpcat.scm | 36 | ||||
| -rw-r--r-- | patchlvl.h | 4 | ||||
| -rw-r--r-- | platform.txi | 1 | ||||
| -rw-r--r-- | posix.c | 2 | ||||
| -rw-r--r-- | r4rstest.scm | 124 | ||||
| -rw-r--r-- | ramap.c | 300 | ||||
| -rw-r--r-- | repl.c | 24 | ||||
| -rw-r--r-- | rope.c | 48 | ||||
| -rw-r--r-- | scl.c | 115 | ||||
| -rw-r--r-- | scm.1 | 12 | ||||
| -rw-r--r-- | scm.c | 2 | ||||
| -rw-r--r-- | scm.doc | 15 | ||||
| -rw-r--r-- | scm.h | 43 | ||||
| -rw-r--r-- | scm.info | 865 | ||||
| -rw-r--r-- | scm.spec | 8 | ||||
| -rw-r--r-- | scm.texi | 354 | ||||
| -rw-r--r-- | scmfig.h | 19 | ||||
| -rw-r--r-- | setjump.mar | 13 | ||||
| -rw-r--r-- | subr.c | 5 | ||||
| -rw-r--r-- | sys.c | 91 | ||||
| -rw-r--r-- | time.c | 47 | ||||
| -rw-r--r-- | ugsetjump.s | 35 | ||||
| -rw-r--r-- | unif.c | 424 | ||||
| -rw-r--r-- | version.txi | 4 | ||||
| -rw-r--r-- | x.c | 8 |
47 files changed, 3324 insertions, 1786 deletions
@@ -1,4 +1,4 @@ -This message announces the availability of Scheme release scm5e2. +This message announces the availability of Scheme release scm5e3. SCM conforms to Revised^5 Report on the Algorithmic Language Scheme and the IEEE P1178 specification. SCM is written in C and runs under @@ -18,119 +18,132 @@ Links to distributions of SCM and related softwares are at the end of this message. -=-=- -scm5e2 news: - -Hinting GCC branch-predictions nets 10% speed improvement for SCM -running the JACAL symbolic mathematics system. - - * scmfig.h (SCM_EXPECT_TRUE, SCM_EXPECT_FALSE): Added. - (POSFIXABLE, NEGFIXABLE, UNEGFIXABLE): SCM_EXPECT_TRUE. - * scmfig.h (__builtin_expect): Added stub for non-gcc compilers. - - * scm.h: SCM_EXPECT_TRUE and SCM_EXPECT_FALSE replace - __builtin_expect(). - (ASRTER, ASRTGO): SCM_EXPECT_FALSE. - * scm.h (INUMP, IMP, SINGP): Added __builtin_expect() netting more - than 9% speed improvement in JACAL. - - * Makefile (scm5.opt, udscm4.opt): Commented out - -fno-guess-branch-probability flag. - * Makefile (udscm4.opt, scm5.opt): Condition - -fno-guess-branch-probability on `type gcc'. - * Makefile (scm5.opt, udscm4.opt): -fno-guess-branch-probability - improves benchmark speed 10% on i686. - (hfiles): Moved to top of file so that dependencies work. - - * byte.c, continue.c, crs.c, dynl.c, eval.c, gsubr.c, ioext.c, - posix.c, ramap.c, record.c, repl.c, rope.c, sc2.c, scl.c, scm.c, - scm.h, socket.c, subr.c, sys.c, time.c, unif.c, unix.c, x.c: - Regularized `if' syntax. - - * scm.c (l_pause): __CYGWIN__ now has pause(). - * scmfig.h (LACK_FTIME): __CYGWIN__ now has ftime(). - * socket.c (l_lna, l_hostinfo, l_netinfo, l_setnet): Made - conditional on __CYGWIN__. - * ioext.c: __CYGWIN__ has <unistd.h>. - - * scl.c (lasinh, lacosh, latanh): Replaced by libc functions. - * scl.c (sum, difference, divide): Added BIGDIG* cast to &z. - * scl.c (numident): Don't bomb given bignums. - * scl.c (makdbl): (+ -1/0 +5i) ==> -1/0; not 0/0. - * scl.c (apx_log10): Removed unused variable. - * scl.c (scm_magnitude): Renamed from magnitude(). - (scm_abs): Added, real-only. - * scl.c (safe_add_1): Replaces add1. - (scm_truncate): Renamed from ltrunc. - * scm.h (scm_truncate): Renamed from ltrunc. - (scm_floor, scm_ceiling): Added. - * subr.c (absval): Moved to scl.c. - * rope.c (num2dbl): Handle 0/0. - * scl.c (inf2str): Changed to "+inf.0" and "-inf.0". - (istr2flo): Parse "+inf.0", "-inf.0", and - COMPACT_INFINITY_NOTATION. - (istr2flo, inf2str): COMPACT_INFINITY_NOTATION flag enables +/0 - and -/0 infinity notations. - - * Transcen.scm (quo, rem, mod): New names for inexact quotient, - remainder, and modulo. - * Init5e1.scm (abs): Is no longer synonym for magnitude. - * Transcen.scm (exact-round, exact-floor, exact-ceiling) - (exact-truncate): Added SRFI-70 convenience functions. - (limit): Removed. - * Transcen.scm (sequence->limit): Removed use of 1/0 literal. - * Transcen.scm (expt): 0^0 ==> 1. - * scl.c (scm_intexpt): 0^0 ==> 1. - * Transcen.scm, Init5e1.scm (infinite?, finite?): Added. - * scl.c (makdbl, init_scl): Don't bother with scm_narn for MSC. - (scm_finitep): Removed to Transcen.scm and Init5e1.scm. - * scm.h (scm_narn): Renamed from infi. - - * r4rstest.scm (SECTION 6 5 5): Restored 0^0 test. - - * hobbit.scm (*c-keywords*): absval --> scm_abs; magnitude --> - scm_magnitude. - - * rope.c, scm.c, scm.texi, scmmain.c, script.c, socket.c: Added - const to argv. - * scmmain.c, scm.h, scm.c, rope.c, repl.c: Added const decls. - - * build.scm (build:command): Comment to script: [-p <platform>]. - * Makefile (turfiles): Added turtle-graphics files. - * Makefile (DOSCM): Abstracted DOS zip creation. - - * unexelf.c: Imported from emacs-22.0.50 to fix FC4 build. - - * differ.c (diff_mid_split): Unused `m' argument removed. - - * scm.spec (slibpath, dumparch): Added. - -From: Steve VanDevender - * scmfig.h (SHORT_INT, CDR_DOUBLES): For __x86_64 (AMD Opteron). - -From: Thomas Bushnell - * scm.doc, scm.1: Corrected spelling errors. +scm5e3 news: + +Richard Harke ported SCM to the Linux-ia64. + +SRFI-94 Type-Restricted Numerical Functions. + +SRFI-63 uniform array type support expanded to: + + A:floC64b inexact 64.bit binary flonum complex + A:floC32b inexact 32.bit binary flonum complex + A:floC16b inexact 16.bit binary flonum complex + A:floR64b inexact 64.bit binary flonum real + A:floR32b inexact 32.bit binary flonum real + A:floR16b inexact 16.bit binary flonum real + A:fixZ32b exact 32.bit binary fixnum + A:fixZ16b exact 16.bit binary fixnum + A:fixZ8b exact 8.bit binary fixnum + A:fixN32b exact 32.bit nonnegative binary fixnum + A:fixN16b exact 16.bit nonnegative binary fixnum + A:fixN8b exact 8.bit nonnegative binary fixnum + A:bool boolean + string char + +Radey Shouman has changed LETREC to behave like LETREC*: + + * eval.c (ceval_1): Change LETREC behavior to that of LETREC*: + initializers are run in left to right order, and may use + previously evaluated variables bound in the same contour. This + change also applies to LETRECs resulting from internal DEFINE. + + * eval.c (macroexp1): Add #ifdef to switch case handling line numbers + in ceval_1 so that they are safely discarded when MEMOIZE_LOCALS is + not #defined. Perhaps line number generation should be disabled in + that case. + + * scl.c: Changes to allow compilation with MinGW (gnu-win32); + asinh, acosh, and atanh are not yet supported. + +From Aubrey Jaffer: + + * indexes.texi (Indexes): Give each index its own node when not in + info mode. Moved index stuff here so it doesn't break + texinfo-every-node-update. + + * scm.texi (Index): Replaced nodes under Indexes with node Index + when in info mode; fixes indexing in Emacs 21.4.1. + Converted to use @copying. + (Indexes): Reorganized. + (Data Type Representations): Corrected pattern for specfun and cclo. + + * byte.c (subbytes): Added. + (scm_subbytes_read, scm_subbytes_write): Renamed from substring. + + * Makefile (dscm4, dscm5): != is string operator in shell. + "mv -f" for previous scm, slibcat, and implcat. + + * Init5e2.scm (boot-tail): Don't load ScmInit.scm if *script*. + (string-index, read-line): Defined for login->home-directory, which + may be called before REQUIRE is defined. + + * Makefile (dscm4, dscm5): Added randomize_va_space machinations. + (dvi, pdf): New tetex-3.0(-20.FC5) broke them -- fixed. + (SETARCH): Workarounds allow dumping in recent Linux. + + * time.c (linux): defined CLKTCK to (sysconf(_SC_CLK_TCK)). + + * repl.c (scm_read_numbered): Don't #ifndef MEMOIZED_LOCALS. + + * build.scm (dont-memoize-locals): Added feature. + (stack-limit): Removed feature. + + * scmfig.h (STACK_LIMIT): Always defined. + (CHECK_STACK): Condition on scm_verbose. + + * sys.c (stack_check): Always present. + + * Makefile (docs): Added target to make all documentation files; + then invoke xdvi. + + * ugsetjmp.s (_setjump, _longjump): For Ultrix VAX circa 1997. + + * subr.c (mkbig, adjbig): Improved overflow message. + + * mkimpcat.scm (wbtab, rwb-isam): moved to "Simple associations". + (add-source): Use 'source form and check file's existence. + + * scl.c (scm_magnitude): Extend dynamic range by eliminating + intermediate expression swell. + (divide): Use "Smith's formula" to extend dynamic range; + but makes an insignificant difference when compiled with -O3. + (atanh, acosh, asinh): define if #ifndef HAVE_ATANH. + + * scmfig.h (HAVE_ATANH): Decides whether atanh, asinh, and acosh + are supported. + + * r4rstest.scm (5 2 1): Expose Bigloo tprint redefinition bug. + (test-bignum): Convert test bignums from strings. + (have-bignums?): Check bignum arithmetic works. + (test-inexact): Do complex tests only if non-real numbers are + supported. + (test-inexact): Added equal? tests. + (test-inexact): Test for -0.0 lossage. + (test-inexact): Check that / and magnitude work for + very large and very small complex numbers (1e300; 1e-300); -=-=- SCM source is available from: - http://swissnet.ai.mit.edu/ftpdir/scm/scm5e2.zip - swissnet.ai.mit.edu:/pub/scm/scm5e2.zip - http://swissnet.ai.mit.edu/ftpdir/scm/scm-5e2-1.src.rpm - swissnet.ai.mit.edu:/pub/scm/scm-5e2-1.src.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/scm5e3.zip + swissnet.ai.mit.edu:/pub/scm/scm5e3.zip + http://swissnet.ai.mit.edu/ftpdir/scm/scm-5e3-1.src.rpm + swissnet.ai.mit.edu:/pub/scm/scm-5e3-1.src.rpm Also available as i386 binary RPM: - http://swissnet.ai.mit.edu/ftpdir/scm/scm-5e2-1.i386.rpm - swissnet.ai.mit.edu:/pub/scm/scm-5e2-1.i386.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/scm-5e3-1.i386.rpm + swissnet.ai.mit.edu:/pub/scm/scm-5e3-1.i386.rpm SLIB is a portable Scheme library which SCM uses: - http://swissnet.ai.mit.edu/ftpdir/scm/slib3a3.zip - swissnet.ai.mit.edu:/pub/scm/slib3a3.zip + http://swissnet.ai.mit.edu/ftpdir/scm/slib3a4.zip + swissnet.ai.mit.edu:/pub/scm/slib3a4.zip Also available as RPM: - http://swissnet.ai.mit.edu/ftpdir/scm/slib-3a3-1.noarch.rpm - swissnet.ai.mit.edu:/pub/scm/slib-3a3-1.noarch.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/slib-3a4-1.noarch.rpm + swissnet.ai.mit.edu:/pub/scm/slib-3a4-1.noarch.rpm JACAL is a symbolic math system written in Scheme: - http://swissnet.ai.mit.edu/ftpdir/scm/jacal1b6.zip - swissnet.ai.mit.edu:/pub/scm/jacal1b6.zip + http://swissnet.ai.mit.edu/ftpdir/scm/jacal1b7.zip + swissnet.ai.mit.edu:/pub/scm/jacal1b7.zip SLIB-PSD is a portable debugger for Scheme (requires emacs editor): http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz @@ -158,13 +171,13 @@ SCM (similar to XSCM). 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://swissnet.ai.mit.edu/ftpdir/scm/wb1c2.zip - swissnet.ai.mit.edu:/pub/scm/wb1c2.zip - http://swissnet.ai.mit.edu/ftpdir/scm/wb-1c2-1.src.rpm - swissnet.ai.mit.edu:/pub/scm/wb-1c2-1.src.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/wb1c3.zip + swissnet.ai.mit.edu:/pub/scm/wb1c3.zip + http://swissnet.ai.mit.edu/ftpdir/scm/wb-1c3-1.src.rpm + swissnet.ai.mit.edu:/pub/scm/wb-1c3-1.src.rpm Also available as i386 binary RPM: - http://swissnet.ai.mit.edu/ftpdir/scm/wb-1c2-1.i386.rpm - swissnet.ai.mit.edu:/pub/scm/wb-1c2-1.i386.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/wb-1c3-1.i386.rpm + swissnet.ai.mit.edu:/pub/scm/wb-1c3-1.i386.rpm SIMSYNCH is a digital logic simulation system written in SCM. http://swissnet.ai.mit.edu/ftpdir/scm/synch1b0.zip @@ -177,7 +190,7 @@ systems. ftp.gnu.org:pub/gnu/dld/dld-3.3.tar.gz SCM.EXE (314k) is a SCM executable for DOS and MS-Windows. -Note: SCM.EXE still requires slib3a3 and scm5e2 above. +Note: SCM.EXE still requires slib3a4 and scm5e3 above. http://swissnet.ai.mit.edu/ftpdir/scm/scm.exe swissnet.ai.mit.edu:/pub/scm/scm.exe @@ -189,4 +202,4 @@ Note: SCM.EXE still requires slib3a3 and scm5e2 above. Programs for printing and viewing TexInfo documentation (which SCM has) come with GNU Emacs or can be obtained via ftp from: - ftp.gnu.org:pub/gnu/texinfo/texinfo-4.0.tar.gz + ftp://ftp.gnu.org/pub/gnu/texinfo/texinfo-4.8.tar.gz @@ -1,3 +1,277 @@ +2006-10-21 Aubrey Jaffer <jaffer@aubrey.jaffer> + + * patchlvl.h (SCMVERSION): Bumped from 5e2 to 5e3. + +2006-10-20 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Testing): Fixed typo in CHEAP_CONTINUATIONS. + + * Transcen.scm (real-functions): Define real-* in terms of $* for + legacy executables. + + * Makefile (checklit): No longer does test-cont. + (scmflags.h): Fixed crucial typo in CHEAP_CONTINUATIONS. + +2006-10-20 Richard Harke + + * continue-ia64.S: Update. + + * build.scm (link-c-program linux-ia64): Added. "continue-ia64.o". + +2006-10-03 Radey Shouman <shouman@comcast.net> + + * eval.c (ceval_1): Change LETREC behavior to that of LETREC*: + initializers are run in left to right order, and may use + previously evaluated variables bound in the same contour. This + change also applies to LETRECs resulting from internal DEFINE. + +2006-09-26 Aubrey Jaffer <agj@alum.mit.edu> + + * byte.c (subbytes): Added. + +2006-09-21 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Index): Replaced nodes under Indexes with node Index + when in info mode; fixes indexing in Emacs 21.4.1. + + * indexes.texi (Indexes): Give each index its own node when not in + info mode. Moved index stuff here so it doesn't break + texinfo-every-node-update. + +2006-09-19 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.h (BYTESP): Added. + + * byte.c (scm_subbytes_read, scm_subbytes_write): Renamed from + substring. + +2006-09-18 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5e2.scm (integer-log): Added from SRFI-94. + +2006-08-28 Aubrey Jaffer <agj@alum.mit.edu> + + * continue.h (FLUSH_REGISTER_WINDOWS): Undid __ia64__ hack. + + * sys.c (igc): Call mark_regs_ia64() for __ia64__. + + * scl.c: real-atan replaces $atan. + + * Transcen.scm (atan): real-atan replaces $atan. + +2006-08-27 Aubrey Jaffer <agj@alum.mit.edu> + + * Transcen.scm: Aliases defined for `$' prefixes replaced by + `real-'. + + * scm.texi (Numeric, Subr Cells): Most Scheme name `$' prefixes + changed to `real-'. + + * hobbit.texi (Hobbit Options, SCM Primitive Procedures): Added + `real-' prefixed names. + + * hobbit.scm (*float-recognize-ops*, *standard-s->c-fun-table*): + Added `real-' prefixed names. + + * scl.c (cxrs): Most Scheme name `$' prefixes changed to `real-'. + + * eval.c (scm_apply_cxr): Pulled common code out of ceval_1, + apply, and scm_cvapply which applies tc7_cxr. Now signals error + if function returns 0/0. + + * Init5e2.scm (integer-sqrt): Added. + +2006-08-23 Aubrey Jaffer <agj@alum.mit.edu> + + * continue.h, continue.c: Added conditionals for ia64 port. + + * sys.c (igc): Changed second argument to type SCM so it works + with Richard Harke's Linux-ia64 port. + + * get-contoffset-ia64.c (main): Don't try to wrap jmpbuf. + + * Transcen.scm (ln): Added synonym for log. + (quo, rem, mod): Simplified. + +2006-08-16 Aubrey Jaffer <agj@alum.mit.edu> + + * unif.c, sys.c, scl.c, rope.c, repl.c: Added support for + tc7_VfixN8 and tc7_VfixZ8. + + * scm.h, scm.texi (Data Type Representations): Reassigned. + (tc7_VfixN8, tc7_VfixZ8): Added byte arrays. + + * unif.c (aset): VfixN16 use num2ushort. + + * ramap.c (array_copy): Corrected cast. + + * scm.texi (Data Type Representations): Corrected pattern for + specfun and cclo. + + * unif.c, sys.c, scl.c, rope.c, repl.c: Added support for + tc7_VfixN16. + + * scm.h, scm.texi (tc7_VfixN16): Added; reordered tc7 assignments. + +2006-08-15 Aubrey Jaffer <agj@alum.mit.edu> + + * ramap.c, repl.c, rope.c, scl.c, sys.c, unif.c: Added support for + tc7_VfloC32. + + * scm.h, scm.texi (tc7_VfloC32): Added; reordered tc7 assignments. + + * scm.texi (Header Cells, Data Type Representations): Renamed + uniform vector types similarly to SRFI-63. + + * scm.h (tc7_Vbool, tc7_VfixZ16, tc7_VfixN32, tc7_VfixZ32) + (tc7_VfloR32, tc7_VfloR64, tc7_VfloC64): Renamed uniform vector + types similarly to SRFI-63. + + * Makefile (dscm4, dscm5): != is string operator in shell. + "mv -f" for previous scm, slibcat, and implcat. + +2006-08-11 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5e2.scm (provide, slib:load-compiled): Modified to ease + transition from *FEATURES* to SLIB:FEATURES. + + * Makefile (dscm4, dscm5): Added randomize_va_space machinations. + +2006-08-10 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Saving Images): Explains recent Linux machinations. + + * Makefile (dvi, pdf): New tetex-3.0(-20.FC5) broke them -- fixed. + +2006-08-09 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (SETARCH): Workarounds allow dumping in recent Linux. + + * time.c (linux): defined CLKTCK to (sysconf(_SC_CLK_TCK)). + +2006-07-20 Aubrey Jaffer <agj@alum.mit.edu> + + * eval.c (m_body): Removed gratuitous CAUTIOUS conditional. + + * build.scm (manifest): Corrected "get-contoffset-ia64.c". + +2006-06-26 Aubrey Jaffer <agj@alum.mit.edu> + + * build.scm (link-c-program linux-ia64): Create include file and + assemble "continue-ia64.S". + + * get-contoffset-ia64.c: Small program to write ia64 assembly + include file "contoffset-ia64.S" with C offsets from Richard + Harke. Modified to take output filename as argument. + +2006-06-03 Aubrey Jaffer <agj@alum.mit.edu> + + * scm.texi (Debugging Scheme Code): Updated about stack checking. + + * build.scm (stack-limit): Removed feature. + + * scmfig.h (STACK_LIMIT): Always defined. + (CHECK_STACK): Condition on scm_verbose. + + * sys.c (stack_check): Always present. + +2006-06-02 Aubrey Jaffer <agj@alum.mit.edu> + + * continue.h (FLUSH_REGISTER_WINDOWS): Use to mark multiple stacks + on __ia64__. + + * Makefile (sfiles): Added getoffs.c. + (scmflags): CHEAP_CONTIUATIONS for scmlit. + + * build.scm (stack-limit): HEAP_SEG_SIZE/2 was too small on FC2; + now HEAP_SEG_SIZE. + +2006-05-21 Aubrey Jaffer <agj@alum.mit.edu> + + * sys.c (igc): Moved FLUSH_REGISTER_WINDOWS to after setjump(). + + * repl.c (scm_read_numbered): Don't #ifndef MEMOIZED_LOCALS. + + * build.scm (dont-memoize-locals): Added feature. + +2006-05-14 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (docs): Added target to make all documentation files; + then invoke xdvi. + + * scm.texi: Converted to use @copying. + (Indexes): Reorganized. + +2006-05-13 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (5 2 1): Expose Bigloo tprint redefinition bug. + +2006-05-07 Richard Harke + + * continue-ia64.S: Added. + + * continue.c (make_root_continuation, make_continuation) + (dynthrow): #ifndef __ia64__. + +2006-05-07 Aubrey Jaffer <agj@alum.mit.edu> + + * ugsetjmp.s (_setjump, _longjump): For Ultrix VAX circa 1997. + + * Makefile (sfiles): Renamed from vfiles; added continue-ia64.S + and ugsetjump.s. + + * subr.c (mkbig, adjbig): Improved overflow message. + +2006-04-24 Radey Shouman <shouman@comcast.net> + + * eval.c (macroexp1): Add #ifdef to switch case handling line numbers + in ceval_1 so that they are safely discarded when MEMOIZE_LOCALS is + not #defined. Perhaps line number generation should be disabled in + that case. + +2006-04-19 Aubrey Jaffer <agj@alum.mit.edu> + + * Init5e2.scm (boot-tail): Don't load ScmInit.scm if *script*. + +2006-03-24 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (test-bignum): Convert test bignums from strings. + + * Init5e2.scm (string-index, read-line): Defined for + login->home-directory, which may be called before require defined. + + * mkimpcat.scm (wbtab, rwb-isam): moved to "Simple associations". + (add-source): Use 'source form and check file's existence. + +2006-03-23 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (have-bignums?): Check bignum arithmetic works. + (test-inexact): Do complex tests only if non-real numbers are + supported. + +2006-03-18 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (test-inexact): Added equal? tests. + +2006-03-17 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (test-inexact): Test for -0.0 lossage. + +2006-03-14 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (test-inexact): Check that / and magnitude work for + very large and very small complex numbers (1e300; 1e-300); + +2006-03-13 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (scm_magnitude): Extend dynamic range by eliminating + intermediate expression swell. + +2006-03-12 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (divide): Use "Smith's formula" to extend dynamic range; + but makes an insignificant difference when compiled with -O3. + 2006-02-19 Aubrey Jaffer <agj@alum.mit.edu> * scl.c (atanh, acosh, asinh): define if #ifndef HAVE_ATANH. diff --git a/Init5e2.scm b/Init5e3.scm index 447e721..305cea0 100644 --- a/Init5e2.scm +++ b/Init5e3.scm @@ -1,4 +1,4 @@ -;; Copyright (C) 1991-2005 Free Software Foundation, Inc. +;; Copyright (C) 1991-2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -42,7 +42,7 @@ ;;; Author: Aubrey Jaffer. (define (scheme-implementation-type) 'SCM) -(define (scheme-implementation-version) "5e2") +(define (scheme-implementation-version) "5e3") (define (scheme-implementation-home-page) "http://swiss.csail.mit.edu/~jaffer/SCM") @@ -113,15 +113,16 @@ thunk (lambda () (exchange old))))))) -(set! *features* +(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 - vicinity srfi-59 + vicinity srfi-59 srfi-23 srfi-94 srfi-60) ;logical - *features*)) + (if (defined? *features*) *features* slib:features))) +(if (defined? *features*) (set! *features* slib:features)) (define eval (let ((@eval @eval) @@ -531,7 +532,7 @@ (perror "WARN") (errno 0) (display "WARN:" cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) args) + (for-each (lambda (x) (display #\space cep) (write x cep)) args) (newline cep) (force-output cep)) @@ -541,7 +542,7 @@ (perror "ERROR") (errno 0) (display "ERROR:" cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) args) + (for-each (lambda (x) (display #\space cep) (write x cep)) args) (newline cep) (force-output cep) (abort)) @@ -552,7 +553,7 @@ (define (print . args) (define result #f) - (for-each (lambda (x) (set! result x) (write x) (display #\ )) args) + (for-each (lambda (x) (set! result x) (write x) (display #\space)) args) (newline) result) (define (pprint . args) @@ -612,7 +613,7 @@ (define cep (current-error-port)) (cond ((> (verbose) 1) (display - (string-append ";" (make-string load:indent #\ ) "loading " file) + (string-append ";" (make-string load:indent #\space) "loading " file) cep) (set! load:indent (modulo (+ 2 load:indent) 16)) (newline cep))) @@ -623,7 +624,7 @@ (errno 0) (cond ((> (verbose) 1) (set! load:indent (modulo (+ -2 load:indent) 16)) - (display (string-append ";" (make-string load:indent #\ ) + (display (string-append ";" (make-string load:indent #\space) "done loading " filesuf) cep) (newline cep) @@ -692,6 +693,28 @@ ;;; 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))) @@ -700,8 +723,6 @@ (else (call-with-input-file "/etc/passwd" (lambda (iprt) - (require 'string-search) - (require 'line-i/o) (let tryline () (define line (read-line iprt)) (define (get-field) @@ -780,12 +801,19 @@ (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)) + ((apply link:link args) + (if (defined? *features*) (set! slib:features *features*))) (else (error "Couldn't link files " args)))) (provide 'compiled))) @@ -1075,7 +1103,7 @@ (define (scm:print-binding sexp frame) (cond ((not (null? (cdr sexp))) (display "In") - (for-each (lambda (exp) (display #\ ) (display exp)) (cdr sexp)) + (for-each (lambda (exp) (display #\space) (display exp)) (cdr sexp)) (display ": "))) (do ((vars (car frame) (cdr vars)) (vals (cdr frame) (cdr vals))) @@ -1122,7 +1150,7 @@ (display "ERROR: " cep) (if (not (null? args)) (begin (display (car args) cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) + (for-each (lambda (x) (display #\space cep) (write x cep)) (cdr args)))) (newline cep) (cond ((stack-trace) (newline cep))) @@ -1172,6 +1200,50 @@ (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) + (type-error 'integer-sqrt n))))) (if (defined? array?) (begin @@ -1240,28 +1312,28 @@ ;;; 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) +(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) +(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 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))) @@ -1297,6 +1369,7 @@ ;;;; 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 @@ -1325,7 +1398,8 @@ ;;; This loads the user's initialization file, or files named in ;;; program arguments. - (or (eq? (software-type) 'THINKC) + (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)) @@ -1391,7 +1465,7 @@ (define (usage preopt opt postopt success?) (define cep (if success? (current-output-port) (current-error-port))) - (define indent (make-string 6 #\ )) + (define indent (make-string 6 #\space)) (define i 3) (cond ((char? opt) (set! opt (string opt))) ;;((symbol? opt) (set! opt (symbol->string opt))) @@ -55,9 +55,21 @@ SHOBJS = *.so #BUILD = ./build -hsystem -p svr4-gcc-sun-ld BUILD = ./build -hsystem -# Workaround for unexec on Fedora Linux i386 +# Workaround for unexec on Fedora Core 1 Linux i386 #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 + #for RPMs RELEASE = 1 @@ -95,7 +107,7 @@ cfiles = scmmain.c scm.c time.c repl.c ioext.c scl.c sys.c eval.c \ findexec.c script.c debug.c byte.c differ.c ofiles = scm.o time.o repl.o scl.o sys.o eval.o subr.o unif.o rope.o \ continue.o findexec.o script.o debug.o -# ramap.o +# continue-ia64.o ifiles = Init$(VERSION).scm Transcen.scm Link.scm Macro.scm Macexp.scm \ Tscript.scm compile.scm Iedline.scm Idiffer.scm hobfiles = hobbit.scm scmhob.scm scmhob.h @@ -120,6 +132,7 @@ scmflags: echo "#ifndef IMPLINIT" > newflags.h echo "#define IMPLINIT \"$(IMPLINIT)\"" >> newflags.h echo "#endif" >> newflags.h + echo "#define CHEAP_CONTINUATIONS" >> newflags.h echo "#define CAUTIOUS" >> newflags.h -if (cmp -s newflags.h scmflags.h) then rm newflags.h; \ else mv newflags.h scmflags.h; fi @@ -138,6 +151,10 @@ time.o: time.c scm.h scmfig.h scmflags.h subr.o: subr.c scm.h scmfig.h scmflags.h rope.o: rope.c scm.h scmfig.h scmflags.h continue.o: continue.c continue.h setjump.h scm.h scmfig.h scmflags.h +continue-ia64.o: continue-ia64.S get-contoffset-ia64.c + gcc -o get-contoffset-ia64 get-contoffset-ia64.c + ./get-contoffset-ia64 contoffset-ia64.S + gcc -c -o continue-ia64.o continue-ia64.S # Simple build with bignums for running JACAL scm: scmlit @@ -165,23 +182,40 @@ udscm4: $(cfiles) $(hfiles) build.scm build udscm4.opt $(BUILD) -f udscm4.opt -o udscm4 -s $(IMPLPATH) rm $(ofiles) scmmain.o dscm4: udscm4 $(ifiles) require.scm - -rm slibcat implcat + if [ -f /proc/sys/kernel/randomize_va_space -a\ + "`cat /proc/sys/kernel/randomize_va_space`" != "0" ]; then {\ + cat /proc/sys/kernel/randomize_va_space > randomize_va_space.tmp;\ + echo 0 > /proc/sys/kernel/randomize_va_space;\ + } fi + -rm -f slibcat implcat scm~ -mv scm scm~ echo "(quit)" | $(SETARCH) ./udscm4 -no-init-file -o scm + if [ -f randomize_va_space.tmp ]; then {\ + cat randomize_va_space.tmp > /proc/sys/kernel/randomize_va_space;\ + rm randomize_va_space.tmp;\ + } fi # dumpable R5RS interpreter udscm5.opt: $(MAKE) udscm4.opt cat udscm4.opt >> udscm5.opt echo "-F macro" >> udscm5.opt -# echo "-DNO_SYM_GC" >> udscm5.opt -udscm5: $(cfiles) $(hfiles) build.scm build Makefile udscm5.opt +udscm5: $(cfiles) $(hfiles) build.scm build udscm5.opt $(BUILD) -f udscm5.opt -o udscm5 -s $(IMPLPATH) rm $(ofiles) scmmain.o dscm5: udscm5 $(ifiles) require.scm - -rm slibcat implcat + if [ -f /proc/sys/kernel/randomize_va_space -a\ + "`cat /proc/sys/kernel/randomize_va_space`" != "0" ]; then {\ + cat /proc/sys/kernel/randomize_va_space > randomize_va_space.tmp;\ + echo 0 > /proc/sys/kernel/randomize_va_space;\ + } fi + -rm -f slibcat implcat scm~ -mv scm scm~ echo "(quit)" | $(SETARCH) ./udscm5 -no-init-file -r5 -o scm + if [ -f randomize_va_space.tmp ]; then {\ + cat randomize_va_space.tmp > /proc/sys/kernel/randomize_va_space;\ + rm randomize_va_space.tmp;\ + } fi $(MAKE) check $(MAKE) checkmacro @@ -226,19 +260,19 @@ dlls.opt: echo "--compiler-options=-Wall" >> dlls.opt echo "--linker-options=-Wall" >> dlls.opt mydlls: dlls.opt - if [ -f /usr/lib/libreadline.so ]; \ - then $(BUILD) -t dll -f dlls.opt -F edit-line; fi - $(BUILD) -t dll -f dlls.opt -F curses - $(BUILD) -t dll -f dlls.opt -c sc2.c - $(BUILD) -t dll -f dlls.opt -c rgx.c + $(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 unix.c $(BUILD) -t dll -f dlls.opt -c socket.c - $(BUILD) -t dll -f dlls.opt -c ramap.c - $(BUILD) -t dll -f dlls.opt -c byte.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 rwb-isam.scm wbtab.scm: ../wb/rwb-isam.scm ../wb/wbtab.scm cp ../wb/rwb-isam.scm ../wb/wbtab.scm ./ @@ -270,7 +304,7 @@ x.h: x.c xevent.h # Check SCM; SCMLIT function. checklit: - $(SCMLIT) -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)(gc)' \ + $(SCMLIT) -fr4rstest.scm -e'(test-sc4)(test-delay)(gc)' \ -e '(or (null? errs) (quit 1))' check: r4rstest.scm $(SCMEXE) -fr4rstest.scm -e'(test-sc4)(test-cont)(test-delay)(gc)' \ @@ -320,51 +354,36 @@ implcat: $(SHOBJS) mkimpcat.scm $(SCMLIT) -lmkimpcat.scm htmldir=../public_html/ -dvidir=../dvi/ -dvi: $(dvidir)scm.dvi $(dvidir)Xlibscm.dvi $(dvidir)hobbit.dvi -$(dvidir)scm.dvi: version.txi scm.texi platform.txi features.txi\ - $(dvidir)scm.fn Makefile -# cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;texi2dvi $(srcdir)scm.texi - -(cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;texindex scm.??) - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;tex $(srcdir)scm.texi -$(dvidir)scm.fn: - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;tex $(srcdir)scm.texi -$(dvidir)Xlibscm.dvi: version.txi Xlibscm.texi $(dvidir)Xlibscm.fn Makefile -# cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;texi2dvi $(srcdir)Xlibscm.texi - -(cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;texindex Xlibscm.??) - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;tex $(srcdir)Xlibscm.texi -$(dvidir)Xlibscm.fn: - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;tex $(srcdir)Xlibscm.texi -$(dvidir)hobbit.dvi: version.txi hobbit.texi $(dvidir)hobbit.fn Makefile -# cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;texi2dvi $(srcdir)hobbit.texi - -(cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;texindex hobbit.??) - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;tex $(srcdir)hobbit.texi -$(dvidir)hobbit.fn: - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;tex $(srcdir)hobbit.texi -xdvi: $(dvidir)scm.dvi - xdvi -s 3 $(dvidir)scm.dvi -Xdvi: $(dvidir)Xlibscm.dvi - xdvi -s 3 $(dvidir)Xlibscm.dvi -hobdvi: $(dvidir)hobbit.dvi - xdvi -s 3 $(dvidir)hobbit.dvi +dvi: scm.dvi Xlibscm.dvi hobbit.dvi +scm.dvi: version.txi scm.texi platform.txi features.txi Makefile + texi2dvi -b -c $(srcdir)scm.texi +Xlibscm.dvi: version.txi Xlibscm.texi Makefile + texi2dvi -b -c $(srcdir)Xlibscm.texi +hobbit.dvi: version.txi hobbit.texi Makefile + texi2dvi -b -c $(srcdir)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: version.txi scm.texi platform.txi features.txi\ - $(dvidir)scm.fn Makefile - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;pdftex $(srcdir)scm.texi - mv $(dvidir)scm.pdf $(htmldir) -$(htmldir)Xlibscm.pdf: version.txi Xlibscm.texi $(dvidir)Xlibscm.fn Makefile - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;pdftex $(srcdir)Xlibscm.texi - mv $(dvidir)Xlibscm.pdf $(htmldir) -$(htmldir)hobbit.pdf: version.txi hobbit.texi $(dvidir)hobbit.fn Makefile - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;pdftex $(srcdir)hobbit.texi - mv $(dvidir)hobbit.pdf $(htmldir) +$(htmldir)scm.pdf: version.txi scm.texi platform.txi features.txi Makefile + texi2pdf -b -c $(srcdir)scm.texi + mv scm.pdf $(htmldir) +$(htmldir)Xlibscm.pdf: version.txi Xlibscm.texi Makefile + texi2pdf -b -c $(srcdir)Xlibscm.texi + mv Xlibscm.pdf $(htmldir) +$(htmldir)hobbit.pdf: version.txi hobbit.texi Makefile + texi2pdf -b -c $(srcdir)hobbit.texi + mv hobbit.pdf $(htmldir) xpdf: $(htmldir)scm.pdf - xpdf -z 3 $(htmldir)scm.pdf + xpdf $(htmldir)scm.pdf Xpdf: $(htmldir)Xlibscm.pdf - xpdf -z 3 $(htmldir)Xlibscm.pdf + xpdf $(htmldir)Xlibscm.pdf hobpdf: $(htmldir)hobbit.pdf - xpdf -z 3 $(htmldir)hobbit.pdf + xpdf $(htmldir)hobbit.pdf PREVDOCS = prevdocs/ html: $(htmldir)scm_toc.html $(htmldir)Xlibscm_toc.html $(htmldir)hobbit_toc.html @@ -399,7 +418,7 @@ $(PREVDOCS)scm.info: srcdir.mk Makefile ################ INSTALL DEFINITIONS ################ -rpm_prefix=/usr/src/redhat/ +rpm_prefix=$(HOME)/rpmbuild/ prefix = /usr/local/ exec_prefix = $(prefix) @@ -497,6 +516,11 @@ uninstallinfo: scm.doc: scm.1 nroff -man $< | ul -tunknown >$@ +docs: $(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 + #### Stuff for maintaining SCM below #### ver = $(VERSION) @@ -523,10 +547,11 @@ dfiles = ANNOUNCE README COPYING scm.1 scm.doc QUICKREF \ version.txi platform.txi features.txi ChangeLog mfiles = Makefile build.scm build build.bat requires.scm \ .gdbinit mkimpcat.scm disarm.scm scm.spec -vfiles = setjump.mar setjump.s +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) $(vfiles) $(ufiles) $(xfiles) $(turfiles) $(wbfiles) + $(hobfiles) $(sfiles) $(ufiles) $(xfiles) $(turfiles) $(wbfiles) makedev = make -f $(HOME)/makefile.dev CHPAT=$(HOME)/bin/chpat @@ -681,7 +706,7 @@ ctagfiles = $(hfiles) $(cfiles) $(xfiles) ctags: $(ctagfiles) etags $(ctagfiles) -TAGFILES = $(hfiles) $(cfiles) $(ifiles) $(vfiles)\ +TAGFILES = $(hfiles) $(cfiles) $(ifiles) $(sfiles)\ version.txi scm.texi Xlibscm.texi hobbit.texi build $(xfiles) $(mfiles)\ hobbit.scm # # $(ufiles) ChangeLog @@ -1,4 +1,4 @@ -This directory contains the distribution of scm5e2. Scm conforms to +This directory contains the distribution of scm5e3. 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. @@ -27,6 +27,8 @@ NOS/VE, Unicos, VMS, Unix and similar systems. `build.scm' database for compiling and linking new SCM programs. `byte.c' strings as bytes. `compile.scm' Hobbit compilation to C. +`continue-ia64.S'replaces make_root_continuation(), make_continuation(), + and dynthrow() in continue.c `continue.c' continuations. `continue.h' continuations. `crs.c' interactive terminal control. @@ -40,6 +42,7 @@ NOS/VE, Unicos, VMS, Unix and similar systems. `eval.c' evaluator, apply, map, and foreach. `example.scm' example from R4RS which uses inexact numbers. `findexec.c' find the executable file function. +`get-contoffset-ia64.c'makes contoffset-ia64.S for inclusion by continue-ia64.S `gmalloc.c' Gnu malloc(); used for unexec. `gsubr.c' make_gsubr for arbitrary (< 11) arguments to C functions. @@ -104,18 +107,18 @@ 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: - * swiss.csail.mit.edu:/pub/scm/slib3a3.tar.gz + * swiss.csail.mit.edu:/pub/scm/slib3a4.tar.gz - * ftp.gnu.org:/pub/gnu/jacal/slib3a3.tar.gz + * ftp.gnu.org:/pub/gnu/jacal/slib3a4.tar.gz - * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a3.tar.gz + * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a4.tar.gz -Unpack SLIB (`tar xzf slib3a3.tar.gz' or `unzip -ao slib3a3.zip') in an +Unpack SLIB (`tar xzf slib3a4.tar.gz' or `unzip -ao slib3a4.zip') in an appropriate directory for your system; both `tar' and `unzip' will create the directory `slib'. Then create a file `require.scm' in the SCM "implementation-vicinity" -(this is the same directory as where the file `Init5e2.scm' is +(this is the same directory as where the file `Init5e3.scm' is installed). `require.scm' should have the contents: (define (library-vicinity) "/usr/local/lib/slib/") @@ -280,17 +283,17 @@ remove <FLAG> in scmfig.h and Do so and recompile files. recompile scm. add <FLAG> in scmfig.h and recompile scm. -ERROR: Init5e2.scm not found. Assign correct IMPLINIT in makefile +ERROR: Init5e3.scm not found. Assign correct IMPLINIT in makefile or scmfig.h. Define environment variable SCM_INIT_PATH to be the full - pathname of Init5e2.scm. + pathname of Init5e3.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 - Init5e2.scm to point to library or + Init5e3.scm to point to library or remove. Make sure the value of (library-vicinity) has a trailing @@ -351,11 +354,13 @@ 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. `Init5e2.scm'). +output files. `Init5e3.scm'). Spaces or control characters appear Check character defines in in symbol names. `scmfig.h'. Negative numbers turn positive. Check SRS in `scmfig.h'. -VMS: Couldn't unwind stack. #define CHEAP_CONTIUATIONS in +;ERROR: bignum: numerical overflow Increase NUMDIGS_MAX in `scmfig.h' + and recompile. +VMS: Couldn't unwind stack. #define CHEAP_CONTINUATIONS in `scmfig.h'. VAX: botched longjmp. diff --git a/Transcen.scm b/Transcen.scm index 3b87837..fe0330d 100644 --- a/Transcen.scm +++ b/Transcen.scm @@ -1,4 +1,4 @@ -;; Copyright (C) 1992, 1993, 1995, 1997, 2005 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1995, 1997, 2005, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -45,122 +45,162 @@ (define compile-allnumbers #t) ;for HOBBIT compiler -(define $pi (* 4 ($atan 1))) +;;;; Legacy real function names +(cond + ((defined? $exp) + (define real-sqrt $sqrt) + (define real-exp $exp) + (define real-expt $expt) + (define real-ln $log) + (define real-log10 $log10) + + (define real-sin $sin) + (define real-cos $cos) + (define real-tan $tan) + (define real-asin $asin) + (define real-acos $acos) + (define real-atan $atan) + + (define real-sinh $sinh) + (define real-cosh $cosh) + (define real-tanh $tanh) + (define real-asinh $asinh) + (define real-acosh $acosh) + (define real-atanh $atanh)) + + (else + (define $sqrt real-sqrt) + (define $exp real-exp) + (define $expt real-expt) + (define $log real-ln) + (define $log10 real-log10) + + (define $sin real-sin) + (define $cos real-cos) + (define $tan real-tan) + (define $asin real-asin) + (define $acos real-acos) + (define $atan real-atan) + + (define $sinh real-sinh) + (define $cosh real-cosh) + (define $tanh real-tanh) + (define $asinh real-asinh) + (define $acosh real-acosh) + (define $atanh real-atanh))) + +(define $pi (* 4 (real-atan 1))) (define pi $pi) (define (pi* z) (* $pi z)) (define (pi/ z) (/ $pi z)) +;;;; Complex functions + (define (exp z) - (if (real? z) ($exp z) - (make-polar ($exp (real-part z)) (imag-part z)))) + (if (real? z) (real-exp z) + (make-polar (real-exp (real-part z)) (imag-part z)))) -(define (log z) +(define (ln z) (if (and (real? z) (>= z 0)) - ($log z) - (make-rectangular ($log (magnitude z)) (angle z)))) + (real-ln z) + (make-rectangular (real-ln (magnitude z)) (angle z)))) +(define log ln) (define (sqrt z) (if (real? z) - (if (negative? z) (make-rectangular 0 ($sqrt (- z))) - ($sqrt z)) - (make-polar ($sqrt (magnitude z)) (/ (angle z) 2)))) + (if (negative? z) (make-rectangular 0 (real-sqrt (- z))) + (real-sqrt z)) + (make-polar (real-sqrt (magnitude z)) (/ (angle z) 2)))) (define (sinh z) - (if (real? z) ($sinh z) + (if (real? z) (real-sinh z) (let ((x (real-part z)) (y (imag-part z))) - (make-rectangular (* ($sinh x) ($cos y)) - (* ($cosh x) ($sin y)))))) + (make-rectangular (* (real-sinh x) (real-cos y)) + (* (real-cosh x) (real-sin y)))))) (define (cosh z) - (if (real? z) ($cosh z) + (if (real? z) (real-cosh z) (let ((x (real-part z)) (y (imag-part z))) - (make-rectangular (* ($cosh x) ($cos y)) - (* ($sinh x) ($sin y)))))) + (make-rectangular (* (real-cosh x) (real-cos y)) + (* (real-sinh x) (real-sin y)))))) (define (tanh z) - (if (real? z) ($tanh z) + (if (real? z) (real-tanh z) (let* ((x (* 2 (real-part z))) (y (* 2 (imag-part z))) - (w (+ ($cosh x) ($cos y)))) - (make-rectangular (/ ($sinh x) w) (/ ($sin y) w))))) + (w (+ (real-cosh x) (real-cos y)))) + (make-rectangular (/ (real-sinh x) w) (/ (real-sin y) w))))) (define (asinh z) - (if (real? z) ($asinh z) + (if (real? z) (real-asinh z) (log (+ z (sqrt (+ (* z z) 1)))))) (define (acosh z) (if (and (real? z) (>= z 1)) - ($acosh z) + (real-acosh z) (log (+ z (sqrt (- (* z z) 1)))))) (define (atanh z) (if (and (real? z) (> z -1) (< z 1)) - ($atanh z) + (real-atanh z) (/ (log (/ (+ 1 z) (- 1 z))) 2))) (define (sin z) - (if (real? z) ($sin z) + (if (real? z) (real-sin z) (let ((x (real-part z)) (y (imag-part z))) - (make-rectangular (* ($sin x) ($cosh y)) - (* ($cos x) ($sinh y)))))) + (make-rectangular (* (real-sin x) (real-cosh y)) + (* (real-cos x) (real-sinh y)))))) (define (cos z) - (if (real? z) ($cos z) + (if (real? z) (real-cos z) (let ((x (real-part z)) (y (imag-part z))) - (make-rectangular (* ($cos x) ($cosh y)) - (- (* ($sin x) ($sinh y))))))) + (make-rectangular (* (real-cos x) (real-cosh y)) + (- (* (real-sin x) (real-sinh y))))))) (define (tan z) - (if (real? z) ($tan z) + (if (real? z) (real-tan z) (let* ((x (* 2 (real-part z))) (y (* 2 (imag-part z))) - (w (+ ($cos x) ($cosh y)))) - (make-rectangular (/ ($sin x) w) (/ ($sinh y) w))))) + (w (+ (real-cos x) (real-cosh y)))) + (make-rectangular (/ (real-sin x) w) (/ (real-sinh y) w))))) (define (asin z) (if (and (real? z) (>= z -1) (<= z 1)) - ($asin z) + (real-asin z) (* -i (asinh (* +i z))))) (define (acos z) (if (and (real? z) (>= z -1) (<= z 1)) - ($acos z) + (real-acos z) (+ (/ (angle -1) 2) (* +i (asinh (* +i z)))))) (define (atan z . y) (if (null? y) - (if (real? z) ($atan z) + (if (real? z) + (real-atan z) (/ (log (/ (- +i z) (+ +i z))) +2i)) ($atan2 z (car y)))) ;;;; SRFI-70 -(define expt - (let ((integer-expt integer-expt)) - (lambda (z1 z2) - (cond ((and (exact? z2) (not (and (zero? z1) (negative? z2)))) - (integer-expt z1 z2)) - ((zero? z2) (+ 1 (* z1 z2))) - ((and (real? z2) (real? z1) (positive? z1)) - ($expt z1 z2)) - (else - (exp (* (if (zero? z1) (real-part z2) z2) (log z1)))))))) - -(define quo - (let ((integer-quotient quotient)) - (lambda (x1 x2) - (if (and (exact? x1) (exact? x2)) - (integer-quotient x1 x2) - (truncate (/ x1 x2)))))) - -(define rem - (let ((integer-remainder remainder)) - (lambda (x1 x2) - (if (and (exact? x1) (exact? x2)) - (integer-remainder x1 x2) - (- x1 (* x2 (quotient x1 x2))))))) - -(define mod - (let ((integer-modulo modulo)) - (lambda (x1 x2) - (if (and (exact? x1) (exact? x2)) - (integer-modulo x1 x2) - (- x1 (* x2 (floor (/ x1 x2)))))))) +(define (expt z1 z2) + (cond ((and (exact? z2) (not (and (zero? z1) (negative? z2)))) + (integer-expt z1 z2)) + ((zero? z2) (+ 1 (* z1 z2))) + ((and (real? z2) (real? z1) (positive? z1)) + (real-expt z1 z2)) + (else + (exp (* (if (zero? z1) (real-part z2) z2) (log z1)))))) + +(define (quo x1 x2) + (if (and (exact? x1) (exact? x2)) + (quotient x1 x2) + (truncate (/ x1 x2)))) + +(define (rem x1 x2) + (if (and (exact? x1) (exact? x2)) + (remainder x1 x2) + (- x1 (* x2 (quo x1 x2))))) + +(define (mod x1 x2) + (if (and (exact? x1) (exact? x2)) + (modulo x1 x2) + (- x1 (* x2 (floor (/ x1 x2)))))) (define (exact-round x) (inexact->exact (round x))) (define (exact-floor x) (inexact->exact (floor x))) diff --git a/Xlibscm.info b/Xlibscm.info index 7223702..606fe3a 100644 --- a/Xlibscm.info +++ b/Xlibscm.info @@ -1,38 +1,58 @@ -This is Xlibscm.info, produced by makeinfo version 4.7 from +This is Xlibscm.info, produced by makeinfo version 4.8 from Xlibscm.texi. +This manual documents the X Interface for SCM Language (version +5e3, October 2006). + +Copyright (C) 1999 Free Software Foundation, Inc. + + Permission is granted to make and distribute verbatim copies of + this manual provided the copyright notice and this permission + notice are preserved on all copies. + + Permission is granted to copy and distribute modified versions of + this manual under the conditions for verbatim copying, provided + that the entire resulting derived work is distributed under the + terms of a permission notice identical to this one. + + Permission is granted to copy and distribute translations of this + manual into another language, under the above conditions for + modified versions, except that this permission notice may be + stated in a translation approved by the author. + INFO-DIR-SECTION The Algorithmic Language Scheme START-INFO-DIR-ENTRY -* Xlibscm: (Xlibscm). SCM Language X Interface. +* XlibScm: (XlibScm). SCM Language X Interface. END-INFO-DIR-ENTRY -File: Xlibscm.info, Node: Top, Next: Xlibscm, Prev: (dir), Up: (dir) +File: Xlibscm.info, Node: Top, Next: XlibScm, Prev: (dir), Up: (dir) -This manual documents the X - SCM Language X Interface. The most recent -information about SCM can be found on SCM's "WWW" home page: +XlibScm +******* - `http://swiss.csail.mit.edu/~jaffer/SCM' +This manual documents the X Interface for SCM Language (version +5e3, October 2006). -Copyright (C) 1990-1999 Free Software Foundation +Copyright (C) 1999 Free Software Foundation, Inc. -Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. + Permission is granted to make and distribute verbatim copies of + this manual provided the copyright notice and this permission + notice are preserved on all copies. -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. + Permission is granted to copy and distribute modified versions of + this manual under the conditions for verbatim copying, provided + that the entire resulting derived work is distributed under the + terms of a permission notice identical to this one. -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation -approved by the author. + Permission is granted to copy and distribute translations of this + manual into another language, under the above conditions for + modified versions, except that this permission notice may be + stated in a translation approved by the author. * Menu: -* Xlibscm:: +* XlibScm:: * Display and Screens:: * Drawables:: * Graphics Context:: @@ -41,15 +61,15 @@ approved by the author. * Rendering:: * Images:: * Event:: -* Index:: +* Indexes:: -File: Xlibscm.info, Node: Xlibscm, Next: Display and Screens, Prev: Top, Up: Top +File: Xlibscm.info, Node: XlibScm, Next: Display and Screens, Prev: Top, Up: Top -1 Xlibscm +1 XlibScm ********* -"Xlibscm" is a SCM interface to "X". The X Window System is a +"XlibScm" is a SCM interface to "X". The X Window System is a network-transparent window system that was designed at MIT. SCM is a portable Scheme implementation written in C. The interface can be compiled into SCM or, on those platforms supporting dynamic linking, @@ -108,7 +128,7 @@ the suitability of this documentation for any purpose. It is provided "as is" without express or implied warranty. -File: Xlibscm.info, Node: Display and Screens, Next: Drawables, Prev: Xlibscm, Up: Top +File: Xlibscm.info, Node: Display and Screens, Next: Drawables, Prev: XlibScm, Up: Top 2 Display and Screens ********************* @@ -1673,7 +1693,7 @@ File: Xlibscm.info, Node: Images, Next: Event, Prev: Rendering, Up: Top -- Function: x:read-bitmap-file drawable file -File: Xlibscm.info, Node: Event, Next: Index, Prev: Images, Up: Top +File: Xlibscm.info, Node: Event, Next: Indexes, Prev: Images, Up: Top 9 Event ******* @@ -1913,13 +1933,22 @@ Each event object has fields dependent on its sub-type. altered. -File: Xlibscm.info, Node: Index, Prev: Event, Up: Top +File: Xlibscm.info, Node: Indexes, Prev: Event, Up: Top -Procedure and Macro Index -************************* +Indexes +******* + +* Menu: -This is an alphabetical list of all the procedures and macros in -Xlibscm. +* Procedure and Macro Index:: +* Variable Index:: +* Concept Index:: + + +File: Xlibscm.info, Node: Procedure and Macro Index, Next: Variable Index, Prev: Indexes, Up: Indexes + +Procedure and Macro Index +========================= * Menu: @@ -1997,10 +2026,11 @@ Xlibscm. * x:window-ref: Window Attributes. (line 280) * x:window-set!: Window Attributes. (line 7) -Variable Index -************** + +File: Xlibscm.info, Node: Variable Index, Next: Concept Index, Prev: Procedure and Macro Index, Up: Indexes -This is an alphabetical list of all the global variables in Xlibscm. +Variable Index +============== * Menu: @@ -2051,10 +2081,11 @@ This is an alphabetical list of all the global variables in Xlibscm. * x:GC-Tile-Stip-X-Origin: Graphics Context. (line 272) * x:GC-Tile-Stip-Y-Origin: Graphics Context. (line 273) -This is an alphabetical list of concepts introduced in this manual. + +File: Xlibscm.info, Node: Concept Index, Prev: Variable Index, Up: Indexes Concept Index -************* +============= * Menu: @@ -2076,26 +2107,29 @@ Concept Index (line 18) * Visual: Display and Screens. (line 110) * visual: Display and Screens. (line 110) -* X: Xlibscm. (line 6) +* X: XlibScm. (line 6) * x:None: Graphics Context. (line 311) -* Xlib: Xlibscm. (line 10) +* Xlib: XlibScm. (line 10) Tag Table: -Node: Top215 -Node: Xlibscm1330 -Node: Display and Screens4124 -Node: Drawables11166 -Node: Windows and Pixmaps11431 -Node: Window Attributes18533 -Node: Window Properties and Visibility34538 -Node: Graphics Context39010 -Node: Cursor54750 -Node: Colormap57261 -Node: Rendering67157 -Node: Images74737 -Node: Event74883 -Node: Index89368 +Node: Top1053 +Node: XlibScm2136 +Node: Display and Screens4930 +Node: Drawables11972 +Node: Windows and Pixmaps12237 +Node: Window Attributes19339 +Node: Window Properties and Visibility35344 +Node: Graphics Context39816 +Node: Cursor55556 +Node: Colormap58067 +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 index 356877c..a9d82fb 100644 --- a/Xlibscm.texi +++ b/Xlibscm.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @c %**start of header -@setfilename Xlibscm.info -@settitle Xlibscm +@setfilename XlibScm.info +@settitle XlibScm @include version.txi @setchapternewpage on @c Choices for setchapternewpage are {on,off,odd}. @@ -10,28 +10,15 @@ @syncodeindex ft cp @c %**end of header -@dircategory The Algorithmic Language Scheme -@direntry -* Xlibscm: (Xlibscm). SCM Language X Interface. -@end direntry - -@iftex -@finalout -@c DL: lose the egregious vertical whitespace, esp. around examples -@c but paras in @defun-like things don't have parindent -@parskip 4pt plus 1pt -@end iftex - -@titlepage -@title Xlibscm -@subtitle SCM Language X Interface -@subtitle Version @value{SCMVERSION} -@author by Aubrey Jaffer +@copying +@noindent +This manual documents the X Interface for SCM Language (version +@value{SCMVERSION}, @value{SCMDATE}). -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1990-1999 Free Software Foundation +@noindent +Copyright @copyright{} 1999 Free Software Foundation, Inc. +@quotation Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice are preserved on all copies. @@ -45,44 +32,41 @@ Permission is granted to copy and distribute translations of this manual into another language, under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the author. -@end titlepage - -@node Top, Xlibscm, (dir), (dir) - - -@ifinfo -This manual documents the X - SCM Language X Interface. 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} +@end quotation +@end copying +@dircategory The Algorithmic Language Scheme +@direntry +* XlibScm: (XlibScm). SCM Language X Interface. +@end direntry -Copyright (C) 1990-1999 Free Software Foundation +@iftex +@finalout +@c DL: lose the egregious vertical whitespace, esp. around examples +@c but paras in @defun-like things don't have parindent +@parskip 4pt plus 1pt +@end iftex -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. +@titlepage +@title XlibScm +@subtitle SCM Language X Interface +@subtitle Version @value{SCMVERSION} +@author Aubrey Jaffer +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). +@contents -@end ignore -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. +@ifnottex +@node Top, XlibScm, (dir), (dir) +@top XlibScm -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by the author. -@end ifinfo +@insertcopying @menu -* Xlibscm:: +* XlibScm:: * Display and Screens:: * Drawables:: * Graphics Context:: @@ -91,13 +75,14 @@ by the author. * Rendering:: * Images:: * Event:: -* Index:: +* Indexes:: @end menu +@end ifnottex -@node Xlibscm, Display and Screens, Top, Top -@chapter Xlibscm +@node XlibScm, Display and Screens, Top, Top +@chapter XlibScm -@dfn{Xlibscm} is a SCM interface to @dfn{X}. +@dfn{XlibScm} is a SCM interface to @dfn{X}. @cindex X The @ifset html @@ -187,7 +172,7 @@ the suitability of this documentation for any purpose. It is provided ``as is'' without express or implied warranty. -@node Display and Screens, Drawables, Xlibscm, Top +@node Display and Screens, Drawables, XlibScm, Top @chapter Display and Screens @defun x:open-display display-name @@ -1857,7 +1842,7 @@ tile-stipple-x-origin, and tile-stipple-y-origin. @end defun -@node Event, Index, Images, Top +@node Event, Indexes, Images, Top @chapter Event @noindent @@ -2091,25 +2076,28 @@ X-event:count represents the number of keycodes altered. @end multitable @end defun -@node Index, , Event, Top -@c @node Procedure and Macro Index, Variable Index, The Implementation, Top -@unnumbered Procedure and Macro Index +@node Indexes, , Event, Top +@unnumbered Indexes -This is an alphabetical list of all the procedures and macros in Xlibscm. +@menu +* Procedure and Macro Index:: +* Variable Index:: +* Concept Index:: +@end menu -@printindex fn +@node Procedure and Macro Index, Variable Index, Indexes, Indexes +@unnumberedsec Procedure and Macro Index -@c @node Variable Index, Type Index, Procedure and Macro Index, Top -@unnumbered Variable Index +@printindex fn -This is an alphabetical list of all the global variables in Xlibscm. +@node Variable Index, Concept Index, Procedure and Macro Index, Indexes +@unnumberedsec Variable Index @printindex vr -This is an alphabetical list of concepts introduced in this manual. +@node Concept Index, , Variable Index, Indexes +@unnumberedsec Concept Index -@unnumbered Concept Index @printindex cp -@contents @bye @@ -98,7 +98,7 @@ )))))) (define (prng samples modu sta) - (define sra (create-array (A:fixN32b) samples)) + (define sra (make-array (A:fixN32b) samples)) (do ((cnt (+ -1 samples) (+ -1 cnt)) (num (random modu sta) (random modu sta)) (sum 0 (+ sum num))) @@ -89,6 +89,8 @@ ("setjump.mar" Vax-asm platform-specific "provides setjump and longjump which do not use $unwind utility on VMS.") ("ugsetjump.s" gnu-as platform-specific "provides setjump and longjump which work on Ultrix VAX.") ("setjump.s" Cray-asm platform-specific "provides setjump and longjump for the Cray YMP.") + ("continue-ia64.S" gnu-as platform-specific "replaces make_root_continuation(), make_continuation(), and dynthrow() in continue.c") + ("get-contoffset-ia64.c" c-source platform-specific "makes contoffset-ia64.S for inclusion by continue-ia64.S") ("Init.scm" Scheme core "Scheme initialization.") ("Transcen.scm" Scheme core "inexact builtin procedures.") ("Link.scm" Scheme core "Dynamic link/loading.") @@ -197,12 +199,12 @@ 'careful-interrupt-masking '((define "CAREFUL_INTS"))) -#;Turns on the features @samp{cautious}, -#;@samp{careful-interrupt-masking}, and @samp{stack-limit}; uses +#;Turns on the features @samp{cautious} and +#;@samp{careful-interrupt-masking}; uses #;@code{-g} flags for debugging SCM source code. (define-build-feature 'debug - '((c-lib debug) (features cautious careful-interrupt-masking stack-limit))) + '((c-lib debug) (features cautious careful-interrupt-masking))) #;If your scheme code runs without any errors you can disable almost #;all error checking by compiling all files with @samp{reckless}. @@ -210,15 +212,6 @@ 'reckless '((define "RECKLESS"))) -#;Use to enable checking for stack overflow. Define value of the C -#;preprocessor variable @var{STACK_LIMIT} to be the size to which SCM -#;should allow the stack to grow. STACK_LIMIT should be less than the -#;maximum size the hardware can support, as not every routine checks the -#;stack. -(define-build-feature - 'stack-limit - '((define ("STACK_LIMIT" "(HEAP_SEG_SIZE/2)")))) - #;C level support for hygienic and referentially transparent macros #;(syntax-rules macros). (define-build-feature @@ -412,6 +405,13 @@ 'no-heap-shrink '((define "DONT_GC_FREE_SEGMENTS"))) +#;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. +(define-build-feature + 'dont-memoize-locals + '((define "DONT_MEMOIZE_LOCALS"))) + #;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 @emph{need} this. Also, if you incorporate @@ -440,6 +440,7 @@ ((also-runs processor-family)) ((*unknown* #f) (i8086 #f) + (ia64 #f) (acorn #f) (alpha #f) (cray #f) @@ -489,6 +490,7 @@ (irix mips irix gcc ) ;gcc (linux i386 linux gcc ) ;gcc (linux-aout i386 linux gcc ) ;gcc + (linux-ia64 ia64 linux gcc ) ;gcc (darwin powerpc unix cc ) ;gcc (microsoft-c i8086 ms-dos cl ) ;link (microsoft-c-nt i386 ms-dos cl ) ;link @@ -1073,6 +1075,21 @@ (append objects libs))) oname))) +(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")) + (batch:try-command + parms "gcc" "-rdynamic" "-o" oname "continue-ia64.o" + (must-be-first + '("pre-crt0.o" "ecrt0.o" "/usr/lib/crt0.o") + (append objects libs))) + oname))) + (defcommand compile-c-files unicos (lambda (files parms) (and (batch:try-chopped-command @@ -2040,7 +2057,7 @@ (define (logger . args) (define cep (current-error-port)) - (for-each (lambda (x) (display #\ cep) (display x cep)) + (for-each (lambda (x) (display #\space cep) (display x cep)) (cond ((provided? 'bignum) (require 'posix-time) (let ((ct (ctime (current-time)))) @@ -149,8 +149,8 @@ SCM scm_read_byte(port) return MAKINUM(c); } -static char s_sub_rd[] = "substring-read!"; -SCM scm_substring_read(sstr, start, args) +static char s_sub_rd[] = "subbytes-read!"; +SCM scm_subbytes_read(sstr, start, args) SCM sstr, start, args; { SCM end, port; @@ -196,8 +196,8 @@ SCM scm_substring_read(sstr, start, args) } } -static char s_sub_wr[] = "substring-write"; -SCM scm_substring_write(sstr, start, args) +static char s_sub_wr[] = "subbytes-write"; +SCM scm_subbytes_write(sstr, start, args) SCM sstr, start, args; { SCM end, port; @@ -246,8 +246,8 @@ static iproc subr2os[] = { {0, 0}}; static iproc lsubr2s[] = { - {s_sub_rd, scm_substring_read}, - {s_sub_wr, scm_substring_write}, + {s_sub_rd, scm_subbytes_read}, + {s_sub_wr, scm_subbytes_write}, {0, 0}}; @@ -264,14 +264,15 @@ void init_byte() scm_ldstr("\n\ (define bytes-length string-length)\n\ (define bytes-copy string-copy)\n\ +(define subbytes substring)\n\ (define (bytes-reverse bytes)\n\ (bytes-reverse! (bytes-copy bytes)))\n\ (define (read-bytes n . port)\n\ (let* ((len (abs n))\n\ (byts (make-bytes len))\n\ (cnt (if (positive? n)\n\ - (apply substring-read! byts 0 n port)\n\ - (apply substring-read! byts (- n) 0 port))))\n\ + (apply subbytes-read! byts 0 n port)\n\ + (apply subbytes-read! byts (- n) 0 port))))\n\ (if (= cnt len)\n\ byts\n\ (if (positive? n)\n\ @@ -279,7 +280,9 @@ void init_byte() (substring byts (- len cnt) len)))))\n\ (define (write-bytes bytes n . port)\n\ (if (positive? n)\n\ - (apply substring-write bytes 0 n port)\n\ - (apply substring-write bytes (- n) 0 port)))\n\ + (apply subbytes-write bytes 0 n port)\n\ + (apply subbytes-write bytes (- n) 0 port)))\n\ +(define substring-read! subbytes-read!)\n\ +(define substring-write subbytes-write)\n\ "); } diff --git a/continue-ia64.S b/continue-ia64.S new file mode 100644 index 0000000..e9387fb --- /dev/null +++ b/continue-ia64.S @@ -0,0 +1,365 @@ +/* Copyright (C) 2006 Free Software Foundation, Inc. + * Author: Richard E. Harke (continue-ia64.S only) copyright assigned + * to Free Software Foundation, Inc. + * + * By including the following notice, I am agreeing to its terms, + * including the special exception for SCM. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of SCM. + * + * The exception is that, if you link the SCM library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the SCM library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name SCM. If you copy + * code from other Free Software Foundation releases into a copy of + * SCM, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for SCM, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + +/* +struct Continuation {jump_buf jmpbuf; + long thrwval; + long length; + STACKITEM *stkbse; +#ifdef __ia64__ + long *bspbse; + long bsplength; + long rnat; +#endif + CONTINUATION_OTHER other; + struct Continuation *parent; + }; +*/ +/* Define offsets for elements of a Continuation structure */ +#include "contoffset-ia64.S" + + + .global must_malloc + .text + .align 32 + .global make_root_continuation + .proc make_root_continuation +make_root_continuation: + .prologue + .save ar.pfs,r33 + alloc r33 = ar.pfs,1,3,2,0 + .save rp,r34 + mov r34 = b0 + .body + addl r14 = @ltoffx(s_call_cc), r1 + mov out0 = cont_size + mov loc2 = gp + ;; + ld8.mov r14 = [r14], s_call_cc + ;; + adds out1 = 18, r14 + ;; + br.call.sptk.many b0=must_malloc + ;; + mov gp = r35 + cmp.eq p6,p0 = r8,r0 + adds r14 = stkbse_off,r8 + adds r15 = bspbse_off,r8 + (p6) br.cond.dpnt mrcexit + ;; + flushrs + st8 [r14] = r12 + ;; + mov r31 = ar.bsp + ;; + adds r14 = length_off,r8 + st8 [r15] = r31 + adds r16 = bsplength_off,r8 + ;; + st8 [r14] = r0 + st8 [r16] = r0 + adds r15 = parent_off,r8 + ;; + st8 [r15] = r8 +mrcexit: + mov ar.pfs = r33 + mov b0 = r34 + ;; + br.ret.sptk.many b0 + .endp make_root_continuation + + /* + register usage + r32 - r39 used in modulo loop (requires multiple of 8) + r40 save r32 from input + r41 save return - b0 + r42 ar.pfs + r43 save gp (r1) + r44 ar.bsp + r45 out0 + r46 out1 + */ + .global make_continuation + .proc make_continuation +make_continuation: + .prologue + .save ar.pfs, r42 + alloc r42 = ar.pfs, 1,12, 2, 8 + mov r43 = r1 + .save rp, r41 + mov r41 = b0 + mov r40 = r32 + ;; + .body + adds r14 = bspbse_off,r40 + adds r17 = stkbse_off,r40 + ;; + mov r44 = ar.bsp + ld8 r15 = [r14] // bspbse from parent + ld8 r18 = [r17] // stkbse from parent + ;; + sub r16 = r44,r15 // length of bsp to save + sub r19 = r18,r12 // length of stack to save + addl r15 = @ltoffx(s_call_cc), r1 + ;; + add r45 = r16,r19 // bsp len plus stack len + ld8.mov r14 = [r15], s_call_cc + ;; + adds r14 = 18, r14 + adds r45 = cont_size, r45 // add in length of continuation struct + ;; + mov r46 = r14 + br.call.sptk.many b0 = must_malloc + mov r1 = r43 + cmp.eq p6, p7 = 0, r8 + (p6) br.cond.dptk .L5 + ;; +.L1: + flushrs + adds r14 = bspbse_off,r40 + adds r17 = stkbse_off,r40 + ;; + mov r31 = ar.rsc + ld8 r15 = [r14] // bsp in parent + ld8 r18 = [r17] // stack base in parent + ;; + and r30 = ~0x3,r31 + sub r16 = r44,r15 // length of bsp to save + sub r19 = r18,r12 // length of stack to save + ;; + mov ar.rsc = r30 // set enforced idle + shr r16 = r16,3 // number of longs not bytes + adds r21 = length_off,r8 + adds r22 = bsplength_off,r8 + shr r19 = r19,3 // number of longs not bytes + ;; + mov r30 = ar.rnat + add r20 = r16,r19 // total length to save + st8 [r22] = r16 // store the bsp length + adds r14 = bspbse_off,r8 + adds r17 = stkbse_off,r8 + ;; + st8 [r14] = r44 // save current bsp + st8 [r17] = r18 // stkbse same as parent stkbse + adds r22 = parent_off,r8 + st8 [r21] = r20 // store the length + ;; + adds r21 = rnat_off,r8 + st8 [r22] = r40 // store parent continuation + mov r29 = ar.lc // need to preserve ar.lc + mov r28 = pr // need to preserve pr.rot + adds r16 = -1,r16 + ;; + st8 [r21] = r30 // store rnat's + mov ar.lc = r16 + mov ar.ec = 3 + mov pr.rot = 0x10000 + adds r27 = cont_size,r8 + adds r19 = -1,r19 + ;; +.L6: + (p16) ld8 r32 = [r15],8 + (p18) st8 [r27] = r34,8 + br.ctop.sptk.few .L6 + ;; + mov r26 = r12 + clrrrb + ;; + mov ar.ec = 3 + mov pr.rot = 0x10000 + mov ar.lc = r19 + ;; +.L7: + (p16) ld8 r32 = [r26],8 + (p18) st8 [r27] = r34,8 + br.ctop.sptk.few .L7 + ;; + mov ar.lc = r29 // restore ar.lc + mov pr = r28,0x1003e // restore pr + mov ar.rsc = r31 // restore ar.rsc + ;; +.L5: + mov ar.pfs = r42 + mov b0 = r41 + br.ret.sptk.many b0 + .endp make_continuation + + + .global thrown_value + .global longjmp + .global dynthrow + .proc dynthrow +dynthrow: + .prologue + .save ar.pfs, r42 + alloc r42 = ar.pfs, 1,12, 2, 8 + mov r43 = r1 + .save rp, r44 + mov r44 = b0 + ld8 r40 = [r32],8 + mov r31 = ar.rsc + movl r2 = ~0x3fff0003 + ;; +.L3: + flushrs + adds r14 = bspbse_off,r40 + adds r17 = stkbse_off,r40 + and r30 = r2,r31 + ;; + ld8 r41 = [r32] + ld8 r15 = [r14] // bsp + ld8 r18 = [r17] // stack base + mov ar.rsc = r30 // set enforced idle + ;; +.L2: + loadrs + adds r21 = length_off,r40 + adds r22 = bsplength_off,r40 + ;; + mov ar.bspstore = r15 + ld8 r16 = [r21] // get total length (number of longs) + ld8 r17 = [r22] // get bsp length (number of longs) + ;; + sub r20 = r16,r17 // compute stack length + shl r25 = r17,3 + ;; + mov r29 = ar.lc // need to preserve ar.lc + mov r28 = pr // need to preserve pr.rot + sub r15 = r15,r25 // adjust bsp beginning + shl r14 = r20,3 + adds r17 = -1,r17 + adds r21 = rnat_off,r40 + ;; + sub r18 = r18,r14 // adjust stack to lowest + mov ar.lc = r17 + mov ar.ec = 3 + mov pr.rot = 0x10000 + adds r27 = cont_size,r40 + adds r20 = -1,r20 + ;; +.L8: + (p16) ld8 r32 = [r27],8 + (p18) st8 [r15] = r34,8 + br.ctop.sptk.few .L8 + ;; + ld8 r14 = [r21] // get the rnat's + clrrrb + ;; + mov ar.ec = 3 + mov pr.rot = 0x10000 + mov ar.lc = r20 + ;; +.L9: + (p16) ld8 r32 = [r27],8 + (p18) st8 [r18] = r34,8 + br.ctop.sptk.few .L9 + ;; + mov ar.rnat = r14 + mov ar.lc = r29 // restore ar.lc + mov pr = r28,0x1003e // restore pr + addl r26 = @gprel(thrown_value),gp + ;; + mov ar.rsc = r31 // restore ar.rsc + st8 [r26] = r41 + mov r45 = r40 + mov r46 = 1 + ;; + br.call.sptk.many b0 = longjmp +// the following should not be executed + mov r1 = r43 + mov ar.pfs = r42 + mov b0 = r44 + br.ret.sptk.many b0 + .endp dynthrow + + .global mark_locations + .global mark_regs_ia64 + .proc mark_regs_ia64 +mark_regs_ia64: + .prologue + .save ar.pfs, r35 + alloc r35 = ar.pfs, 1, 4, 2, 0 + .save rp, r33 + mov r33 = b0 + mov r36 = r1 + mov r34 = r12 + adds r17 = stkbse_off, r32 + ;; + adds r12 = -32, r12 + ld8 r19 = [r17] + ;; + adds r18 = 16,r12 + ;; + sub r38 = r19, r18 + ;; + st8 [r18] = r4, 8 + shr r38 = r38, 3 + ;; + st8 [r18] = r5, 8 + ;; + st8 [r18] = r6, 8 + ;; + st8 [r18] = r7 + mov r37 = r12 + br.call.sptk.many b0 = mark_locations + flushrs + mov r1 = r36 + adds r17 = bspbse_off, r32 + ;; + mov r20 = ar.bsp + ;; + ld8 r37 = [r17] + ;; + sub r38 = r20, r37 + ;; + shr r38 = r38, 3 + br.call.sptk.many b0 = mark_locations + mov r1 = r36 + mov r12 = r34 + mov ar.pfs = r35 + mov b0 = r33 + br.ret.sptk.many b0 + .endp mark_regs_ia64 @@ -84,6 +84,7 @@ long stack_size(start) to `setjump(new_continuation->jmpbuf)' in order to complete the capture of this continuation. */ +#ifndef __ia64__ CONTINUATION *make_root_continuation(stack_base) STACKITEM *stack_base; { @@ -111,12 +112,12 @@ CONTINUATION *make_continuation(parent_cont) CONTINUATION *parent_cont; { CONTINUATION *cont; -#ifdef CHEAP_CONTINUATIONS +# ifdef CHEAP_CONTINUATIONS cont = (CONTINUATION *)malloc(sizeof(CONTINUATION)); if (!cont) return 0; cont->length = 0; cont->stkbse = parent_cont->stkbse; -#else +# else long j; register STACKITEM *src, *dst; FLUSH_REGISTER_WINDOWS; @@ -126,17 +127,18 @@ CONTINUATION *make_continuation(parent_cont) cont->length = j; cont->stkbse = parent_cont->stkbse; src = cont->stkbse; -# ifdef STACK_GROWS_UP +# ifdef STACK_GROWS_UP src += parent_cont->length; -# else +# else src -= parent_cont->length + cont->length; -# endif/* ndef STACK_GROWS_UP */ +# endif/* ndef STACK_GROWS_UP */ dst = (STACKITEM *)(cont + 1); for (j = cont->length; 0 <= --j; ) *dst++ = *src++; -#endif /* ndef CHEAP_CONTINUATIONS */ +# endif /* ndef CHEAP_CONTINUATIONS */ cont->parent = parent_cont; return cont; } +#endif /* free_continuation() is trivial, but who knows what the future holds. */ @@ -177,40 +179,41 @@ void free_continuation(cont) /* SCM_GROWTH is how many `long's to grow the stack by when we need room. */ #define SCM_GROWTH 100 +#ifndef __ia64__ void dynthrow(a) long *a; { register CONTINUATION *cont = (CONTINUATION *)(a[0]); long val = a[1]; -#ifndef CHEAP_CONTINUATIONS +# ifndef CHEAP_CONTINUATIONS register long j; register STACKITEM *src, *dst = cont->stkbse; -# ifdef STACK_GROWS_UP -# ifndef hpux +# ifdef STACK_GROWS_UP +# ifndef hpux if (a[2] && (a - ((long *)a[3]) < SCM_GROWTH)) puts("grow_throw: check if long growth[]; being optimized out"); -# endif +# endif /* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */ if (PTR_GE(dst + (cont->length), (STACKITEM *)&a)) grow_throw(a); -# else -# ifndef hpux +# else +# ifndef hpux if (a[2] && (((long *)a[3]) - a < SCM_GROWTH)) puts("grow_throw: check if long growth[]; being optimized out"); -# endif +# endif /* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n", a[2], (((long *)a[3]) - a)); */ dst -= cont->length; if (PTR_LE(dst, (STACKITEM *)&a)) grow_throw(a); -# endif/* def STACK_GROWS_UP */ +# endif/* def STACK_GROWS_UP */ FLUSH_REGISTER_WINDOWS; src = (STACKITEM *)(cont + 1); for (j = cont->length;0 <= --j;) *dst++ = *src++; -#endif /* ndef CHEAP_CONTINUATIONS */ -#ifdef SHORT_INT +# endif /* ndef CHEAP_CONTINUATIONS */ +# ifdef SHORT_INT thrown_value = val; longjump(cont->jmpbuf, 1); -#else +# else longjump(cont->jmpbuf, val); -#endif +# endif } /* grow_throw() grows the stack by SCM_GROWTH long words. If the @@ -221,7 +224,7 @@ void dynthrow(a) so the compiler won't be able to guess that the growth array isn't all used. */ -#ifndef CHEAP_CONTINUATIONS +# ifndef CHEAP_CONTINUATIONS void grow_throw(a) /* Grow the stack so that there is room */ long *a; /* to copy in the continuation. Then */ { /* retry the throw. */ @@ -233,7 +236,8 @@ void grow_throw(a) /* Grow the stack so that there is room */ growth[SCM_GROWTH-1] = sizeof growth; dynthrow(growth); } -#endif /* ndef CHEAP_CONTINUATIONS */ +# endif /* ndef CHEAP_CONTINUATIONS */ +#endif /* throw_to_continuation() restores the stack in effect when @var{cont} was made and resumes @var{cont}'s processor state. If @@ -42,12 +42,65 @@ /* "continue.h" Scheme Continuations for C. Author: Aubrey Jaffer. */ +/* If stack is not longword aligned then */ + +/* #define SHORT_ALIGN */ +#ifdef THINK_C +# define SHORT_ALIGN +#endif +#ifdef __MWERKS__ +# ifdef __MC68K__ +# define SHORT_ALIGN +# endif +#endif +#ifdef MSDOS +# ifndef _M_ARM +/* arm processors need DWORD aligned data access */ +# define SHORT_ALIGN +# endif +#endif +#ifdef atarist +# define SHORT_ALIGN +#endif + +#ifdef SHORT_ALIGN +typedef short STACKITEM; +#else +typedef long STACKITEM; +#endif + +/* If stacks grow up then */ + +/* #define STACK_GROWS_UP */ +#ifdef hp9000s800 +# define STACK_GROWS_UP +#endif +#ifdef pyr +# define STACK_GROWS_UP +#endif +#ifdef nosve +# define STACK_GROWS_UP +#endif +#ifdef _UNICOS +# 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 + that all the state of the process is contained in the stack. */ + +#ifdef sparc +# define FLUSH_REGISTER_WINDOWS asm("ta 3") +#else +# define FLUSH_REGISTER_WINDOWS /* empty */ +#endif + #ifdef vax # ifndef CHEAP_CONTINUATIONS - typedef int jump_buf[17]; - extern int setjump(jump_buf env); - extern int longjump(jump_buf env, int ret); +typedef int jump_buf[17]; +extern int setjump(jump_buf env); +extern int longjump(jump_buf env, int ret); # else # include <setjmp.h> @@ -58,9 +111,9 @@ #else /* ndef vax */ # ifdef _CRAY1 - typedef int jump_buf[112]; - extern int setjump(jump_buf env); - extern int longjump(jump_buf env, int ret); +typedef int jump_buf[112]; +extern int setjump(jump_buf env); +extern int longjump(jump_buf env, int ret); # else /* ndef _CRAY1 */ # ifndef PLAN9 @@ -75,7 +128,7 @@ # define jump_buf jmp_buf # define setjump setjmp # define longjump longjmp -# endif /* ndef HAVE_SIGSETJMP */ +# endif /* ndef SIG_UNBLOCK */ # endif /* ndef _CRAY1 */ #endif /* ndef vax */ @@ -86,37 +139,15 @@ # define CONTINUATION_OTHER int #endif -/* If stack is not longword aligned then */ - -/* #define SHORT_ALIGN */ -#ifdef THINK_C -# define SHORT_ALIGN -#endif -#ifdef __MWERKS__ -# ifdef __MC68K__ -# define SHORT_ALIGN -# endif -#endif -#ifdef MSDOS -# ifndef _M_ARM -/* arm processors need DWORD aligned data access */ -# define SHORT_ALIGN -# endif -#endif -#ifdef atarist -# define SHORT_ALIGN -#endif - -#ifdef SHORT_ALIGN -typedef short STACKITEM; -#else -typedef long STACKITEM; -#endif - struct Continuation {jump_buf jmpbuf; long thrwval; long length; STACKITEM *stkbse; +#ifdef __ia64__ + long *bspbse; + long bsplength; + long rnat; +#endif CONTINUATION_OTHER other; struct Continuation *parent; }; @@ -170,29 +201,3 @@ void throw_to_continuation P((CONTINUATION *cont, long val, #define PTR_GT(x, y) PTR_LT(y, x) #define PTR_LE(x, y) (!PTR_GT(x, y)) #define PTR_GE(x, y) (!PTR_LT(x, y)) - -/* James Clark came up with this neat one instruction fix for - continuations on the SPARC. It flushes the register windows so - that all the state of the process is contained in the stack. */ - -#ifdef sparc -# define FLUSH_REGISTER_WINDOWS asm("ta 3") -#else -# define FLUSH_REGISTER_WINDOWS /* empty */ -#endif - -/* If stacks grow up then */ - -/* #define STACK_GROWS_UP */ -#ifdef hp9000s800 -# define STACK_GROWS_UP -#endif -#ifdef pyr -# define STACK_GROWS_UP -#endif -#ifdef nosve -# define STACK_GROWS_UP -#endif -#ifdef _UNICOS -# define STACK_GROWS_UP -#endif @@ -43,7 +43,7 @@ (define (disarm name) (lambda args - ;;(if (memq? name *features*) (set! *features* (remove name *features))) + ;;(if (memq? name slib:features) (set! slib:features (remove name *features))) (error name 'disabled))) (define abort quit) @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997, 1998, 1999, 2002 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997, 1998, 1999, 2002, 2006 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -781,6 +781,12 @@ SCM eval_args(l) return res; } +/* + Evaluate each expression in argument list x, + and return a list allocated in the ecache of the + results. + The result is left in scm_env_tmp. +*/ static void ecache_evalx(x) SCM x; { @@ -798,6 +804,34 @@ static void ecache_evalx(x) ENV_V2LST((long)i, argv); } +/* + Allocate a list of UNDEFINED in the ecache, one + for each element of the argument list x. + The result is left in scm_env_tmp. +*/ +static void ecache_undefs(x) + SCM x; +{ + static SCM argv[10] = {UNDEFINED, UNDEFINED, UNDEFINED, + UNDEFINED, UNDEFINED, UNDEFINED, + UNDEFINED, UNDEFINED, UNDEFINED, + UNDEFINED}; + + int imax = sizeof(argv)/sizeof(SCM); + int i = 0; + + scm_env_tmp = EOL; + while NIMP(x) { + if (imax==i) { + ecache_undefs(x); + break; + } + i++; + x = CDR(x); + } + ENV_V2LST((long)i, argv); +} + /* result is 1 if right number of arguments, 0 otherwise, environment frame is put in scm_env_tmp */ static int ecache_eval_args(proc, arg1, arg2, arg3, x) @@ -1645,11 +1679,7 @@ static SCM m_body(xorig, env, ctxt) break; } } -#ifdef CAUTIOUS - ASSYNT(ilength(x) > 0, xorig, s_body, what); -#else ASSYNT(ilength(x) > 0, xorig, s_body, what); -#endif if (IMP(defs)) return x; return cons(m_letrec1(IM_DEFINE, cons2(i_define, defs, x), env, ctxt), EOL); } @@ -2046,6 +2076,48 @@ SCM scm_eval_values(x, env, valenv) return res; } +SCM scm_apply_cxr(proc, arg1) + SCM proc, arg1; +{ + double y; +#ifdef FLOATS + if (SUBRF(proc)) { + if (INUMP(arg1)) { + y = DSUBRF(proc)((double) INUM(arg1)); + goto ret; + } + ASRTGO(NIMP(arg1), floerr); + if (REALP(arg1)) { + y = DSUBRF(proc)(REALPART(arg1)); + ret: + if (y==y) return makdbl(y, 0.0); + goto floerr; + } +# ifdef BIGDIG + if (BIGP(arg1)) { + y = DSUBRF(proc)(big2dbl(arg1)); + goto ret; + } +# endif + floerr: + wta(arg1, (char *)ARG1, SNAME(proc)); + } +#endif + { + int op = CXR_OP(proc); +#ifndef RECKLESS + SCM x = arg1; +#endif + while (op) { + ASRTER(NIMP(arg1) && CONSP(arg1), + x, ARG1, SNAME(proc)); + arg1 = (1 & op ? CAR(arg1) : CDR(arg1)); + op >>= 2; + } + return arg1; + } +} + #ifdef __GNUC__ # define GCC_VERSION (__GNUC__ * 100 + __GNUC_MINOR__) /* __GNUC_PATCHLEVEL__ */ @@ -2184,12 +2256,30 @@ static SCM ceval_1(x) TRACE(x); x = CDR(x); STATIC_ENV = CAR(x); +#if 0 /* + The block below signals an error if any variable + bound in a LETREC is referenced in any init. + */ scm_env_tmp = undefineds; EXTEND_VALENV; x = CDR(x); ecache_evalx(CAR(x)); EGC_ROOT(scm_env); CAR(scm_env) = scm_env_tmp; + +#else /* The block below implements LETREC* */ + ecache_undefs(CAR(CAR(x))); + EXTEND_VALENV; + x = CDR(x); + proc = CAR(x); + while (NIMP(proc)) { + arg1 = EVALCAR(proc); + proc = CDR(proc); + DEFER_INTS_EGC; + CAR(scm_env_tmp) = arg1; + scm_env_tmp = CDR(scm_env_tmp); + } +#endif scm_env_tmp = EOL; goto cdrxbegin; case (127 & IM_LETSTAR): @@ -2308,7 +2398,13 @@ static SCM ceval_1(x) x = acro_call(x, STATIC_ENV); goto loop; case (ISYMNUM(IM_LINUM)): +#ifndef MEMOIZE_LOCALS + x = CDR(x); /* For non-memoizing case, + just throw away line number. */ + goto loop; +#else goto expand; +#endif case (ISYMNUM(IM_DEFINE)): x = toplevel_define(x, STATIC_ENV); goto retx; @@ -2459,34 +2555,7 @@ evap1: case tc7_subr_1o: return SUBRF(proc)(arg1); case tc7_cxr: -#ifdef FLOATS - if (SUBRF(proc)) { - if (INUMP(arg1)) - return makdbl(DSUBRF(proc)((double) INUM(arg1)), 0.0); - ASRTGO(NIMP(arg1), floerr); - if (REALP(arg1)) - return makdbl(DSUBRF(proc)(REALPART(arg1)), 0.0); -# ifdef BIGDIG - if (BIGP(arg1)) - return makdbl(DSUBRF(proc)(big2dbl(arg1)), 0.0); -# endif - floerr: - wta(arg1, (char *)ARG1, SNAME(proc)); - } -#endif - { - int op = CXR_OP(proc); -#ifndef RECKLESS - x = arg1; -#endif - while (op) { - ASRTER(NIMP(arg1) && CONSP(arg1), - x, ARG1, SNAME(proc)); - arg1 = (1 & op ? CAR(arg1) : CDR(arg1)); - op >>= 2; - } - return arg1; - } + return scm_apply_cxr(proc, arg1); case tc7_rpsubr: return BOOL_T; case tc7_asubr: @@ -2873,34 +2942,7 @@ SCM apply(proc, arg1, args) return SUBRF(proc)(arg1); case tc7_cxr: ASRTGO(NULLP(args), wrongnumargs); -#ifdef FLOATS - if (SUBRF(proc)) { - if (INUMP(arg1)) - return makdbl(DSUBRF(proc)((double) INUM(arg1)), 0.0); - ASRTGO(NIMP(arg1), floerr); - if (REALP(arg1)) - return makdbl(DSUBRF(proc)(REALPART(arg1)), 0.0); -# ifdef BIGDIG - if (BIGP(arg1)) - return makdbl(DSUBRF(proc)(big2dbl(arg1)), 0.0); -# endif - floerr: - wta(arg1, (char *)ARG1, SNAME(proc)); - } -#endif - { - int op = CXR_OP(proc); -#ifndef RECKLESS - args = arg1; -#endif - while (op) { - ASRTER(NIMP(arg1) && CONSP(arg1), - args, ARG1, SNAME(proc)); - arg1 = (1 & op ? CAR(arg1) : CDR(arg1)); - op >>= 2; - } - return arg1; - } + return scm_apply_cxr(proc, arg1); case tc7_subr_3: ASRTGO(NIMP(args) && NIMP(CDR(args)) && NULLP(CDR(CDR(args))), wrongnumargs); @@ -2977,32 +3019,7 @@ SCM scm_cvapply(proc, n, argv) case tc7_subr_1: return SUBRF(proc)(argv[0]); case tc7_cxr: -#ifdef FLOATS - if (SUBRF(proc)) { - if (INUMP(argv[0])) - return makdbl(DSUBRF(proc)((double) INUM(argv[0])), 0.0); - ASRTGO(NIMP(argv[0]), floerr); - if (REALP(argv[0])) - return makdbl(DSUBRF(proc)(REALPART(argv[0])), 0.0); -# ifdef BIGDIG - if (BIGP(argv[0])) - return makdbl(DSUBRF(proc)(big2dbl(argv[0])), 0.0); -# endif - floerr: - wta(argv[0], (char *)ARG1, SNAME(proc)); - } -#endif - { - int op = CXR_OP(proc); - res = argv[0]; - while (op) { - ASRTER(NIMP(res) && CONSP(res), - argv[0], ARG1, SNAME(proc)); - res = (1 & op ? CAR(res) : CDR(res)); - op >>= 2; - } - return res; - } + return scm_apply_cxr(proc, argv[0]); case tc7_subr_3: return SUBRF(proc)(argv[0], argv[1], argv[2]); case tc7_lsubr: diff --git a/features.txi b/features.txi index c7e94fb..1df8107 100644 --- a/features.txi +++ b/features.txi @@ -53,14 +53,20 @@ For the @dfn{curses} screen management package. @item debug @cindex debug -Turns on the features @samp{cautious}, -@samp{careful-interrupt-masking}, and @samp{stack-limit}; uses +Turns on the features @samp{cautious} and +@samp{careful-interrupt-masking}; uses @code{-g} flags for debugging SCM source code. @item differ @cindex differ Sequence comparison +@item dont-memoize-locals +@cindex 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. + @item dump @cindex dump Convert a running scheme program into an executable file. @@ -169,14 +175,6 @@ This does not affect complex numbers. BSD @dfn{socket} interface. Socket addr functions require inexacts or bignums for 32-bit precision. -@item stack-limit -@cindex stack-limit -Use to enable checking for stack overflow. Define value of the C -preprocessor variable @var{STACK_LIMIT} to be the size to which SCM -should allow the stack to grow. STACK_LIMIT should be less than the -maximum size the hardware can support, as not every routine checks the -stack. - @item tick-interrupts @cindex tick-interrupts Use if you want the ticks and ticks-interrupt functions. diff --git a/get-contoffset-ia64.c b/get-contoffset-ia64.c new file mode 100644 index 0000000..4e3612c --- /dev/null +++ b/get-contoffset-ia64.c @@ -0,0 +1,107 @@ +/* Copyright (C) 2006 Free Software Foundation, Inc. + * Author: Richard E. Harke (get-contoffset-ia64.c only) copyright assigned + * to Free Software Foundation, Inc. + * + * By including the following notice, I am agreeing to its terms, + * including the special exception for SCM. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of SCM. + * + * The exception is that, if you link the SCM library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the SCM library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name SCM. If you copy + * code from other Free Software Foundation releases into a copy of + * SCM, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for SCM, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + +/* The .o of this file does not get linked into SCM. + * It is a utility used to create an include file + * for continue-ia64.S to get offsets into struct jump_buf + * and be sure they are correct for the current compiler. + * + * create get-contoffset-ia64 program by: + * gcc -o get-contoffset-ia64 get-contoffset-ia64.c + * create ASM include file by: + * ./get-contoffset-ia64 contoffset-ia64.S + */ +#include <stddef.h> +#include <stdio.h> + +#define IN_CONTINUE_C +#include "setjump.h" + +int +main(int argc, char ** argv) +{ + struct Continuation taco; + long jmpbuf_off = 10L; + long thrwval_off; + long length_off; + long stkbse_off; + long bspbse_off; + long bsplength_off; + long rnat_off; + long other_off; + long parent_off; + long cont_size; + FILE *prt; + + switch (argc) { + case 1: prt = stdout; break; + case 2: prt = fopen(argv[1], "w"); break; + default: return !0; + } + jmpbuf_off = &((struct Continuation *)0)->jmpbuf; + thrwval_off = &((struct Continuation *)0)->thrwval; + length_off = &((struct Continuation *)0)->length; + stkbse_off = &((struct Continuation *)0)->stkbse; + bspbse_off = &((struct Continuation *)0)->bspbse; + bsplength_off = &((struct Continuation *)0)->bsplength; + rnat_off = &((struct Continuation *)0)->rnat; + other_off = &((struct Continuation *)0)->other; + parent_off = &((struct Continuation *)0)->parent; + cont_size = sizeof(struct Continuation); + + fprintf(prt, " jmpbuf_off = %ld\n", jmpbuf_off); + fprintf(prt, " thrwval_off = %ld\n", thrwval_off); + fprintf(prt, " length_off = %ld\n", length_off); + fprintf(prt, " stkbse_off = %ld\n", stkbse_off); + fprintf(prt, " bspbse_off = %ld\n", bspbse_off); + fprintf(prt, " bsplength_off = %ld\n", bsplength_off); + fprintf(prt, " rnat_off = %ld\n", rnat_off); + fprintf(prt, " other_off = %ld\n", other_off); + fprintf(prt, " parent_off = %ld\n", parent_off); + fprintf(prt, " cont_size = %ld\n", cont_size); + fclose(prt); + return 0; +} diff --git a/hobbit.info b/hobbit.info index 9f124f3..7dae5f2 100644 --- a/hobbit.info +++ b/hobbit.info @@ -1,4 +1,23 @@ -This is hobbit.info, produced by makeinfo version 4.7 from hobbit.texi. +This is hobbit.info, produced by makeinfo version 4.8 from hobbit.texi. + +This manual is for the Hobbit compiler for SCM (version 5e3, October +2006), + +Copyright (C) 2002 Free Software Foundation + + Permission is granted to make and distribute verbatim copies of + this manual provided the copyright notice and this permission + notice are preserved on all copies. + + Permission is granted to copy and distribute modified versions of + this manual under the conditions for verbatim copying, provided + that the entire resulting derived work is distributed under the + terms of a permission notice identical to this one. + + Permission is granted to copy and distribute translations of this + manual into another language, under the above conditions for + modified versions, except that this permission notice may be + stated in a translation approved by the author. INFO-DIR-SECTION The Algorithmic Language Scheme START-INFO-DIR-ENTRY @@ -8,8 +27,27 @@ END-INFO-DIR-ENTRY File: hobbit.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) -Hobbit is an optimizing R4RS-Scheme to C compiler written by Tanel -Tammet. +Hobbit +****** + +This manual is for the Hobbit compiler for SCM (version 5e3, October +2006), + +Copyright (C) 2002 Free Software Foundation + + Permission is granted to make and distribute verbatim copies of + this manual provided the copyright notice and this permission + notice are preserved on all copies. + + Permission is granted to copy and distribute modified versions of + this manual under the conditions for verbatim copying, provided + that the entire resulting derived work is distributed under the + terms of a permission notice identical to this one. + + Permission is granted to copy and distribute translations of this + manual into another language, under the above conditions for + modified versions, except that this permission notice may be + stated in a translation approved by the author. * Menu: @@ -21,22 +59,6 @@ Tammet. * About Hobbit:: * Index:: -Copyright (C) 1990-1999, 2002 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation -approved by the author. - File: hobbit.info, Node: Introduction, Next: Compiling with Hobbit, Prev: Top, Up: Top @@ -138,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 \"Init5e2.scm\"" + '("#define IMPLINIT \"Init5e3.scm\"" "#define BIGNUMS" "#define FLOATS" "#define ARRAYS" @@ -190,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 \"Init5e2.scm\"" + '("#define IMPLINIT \"Init5e3.scm\"" "#define COMPILED_INITS init_example();" "#define CCLO" "#define FLOATS")))) @@ -260,8 +282,8 @@ File: hobbit.info, Node: Hobbit Options, Next: CC Optimizations, Prev: Error By default hobbit assumes that only immediate (ie small, up to 30 bits) integers are used. It will automatically assume general arithmetics in case it finds any non-immediate numbers like 1.2 or - 10000000000000 or real-only procedures like $sin anywhere in the - source. + 10000000000000 or real-only procedures like real-sin anywhere in + the source. Another way to make Hobbit assume that generic arithmetic supported by SCM (ie exact and/or inexact reals, bignums) is also used, is to @@ -509,8 +531,9 @@ procedures, but a combination of internal SCM procedures, guaranteeing exact correspondence with the SCM interpreter while hindering the speed): - $sqrt $abs $exp $log $sin $cos $tan $asin $acos - $atan $sinh $cosh $tanh $asinh $acosh $atanh $expt + real-sqrt real-exp real-ln real-expt real-sin real-cos real-tan + real-asin real-acos real-atan real-sinh real-cosh real-tanh real-asinh + real-acosh real-atanh _Note Bene:_ These procedures are compiled to faster code than the corresponding generic versions sqrt, abs, ... expt. @@ -1204,7 +1227,7 @@ File: hobbit.info, Node: Pi, Prev: Cpstak, Up: Benchmark Sources (do ((l (string-length s) (+ 1 l))) ((>= l d) (display s)) (display #\0))) - (if (zero? (modulo j 10)) (newline) (display #\ ))) + (if (zero? (modulo j 10)) (newline) (display #\space))) (newline))) @@ -1929,46 +1952,46 @@ Index Tag Table: -Node: Top199 -Node: Introduction1227 -Node: Compiling with Hobbit2543 -Node: Compiling And Linking2801 -Node: Error Detection7487 -Node: Hobbit Options8793 -Node: CC Optimizations15522 -Node: The Language Compiled16478 -Node: Macros17137 -Node: SCM Primitive Procedures17741 -Node: SLIB Logical Procedures18600 -Node: Fast Integer Calculations19755 -Node: Force and Delay20889 -Node: Suggestions for writing fast code21474 -Node: Performance of Compiled Code31673 -Node: Gain in Speed31933 -Node: Benchmarks33518 -Node: Benchmark Sources36618 -Node: Destruct36964 -Node: Recfib38551 -Node: div-iter and div-rec38806 -Node: Hanoi39892 -Node: Tak40473 -Node: Ctak40828 -Node: Takl41808 -Node: Cpstak42464 -Node: Pi43243 -Node: Principles of Compilation44372 -Node: Macro-Expansion and Analysis44798 -Node: Building Closures48603 -Node: Lambda-lifting51494 -Node: Statement-lifting54225 -Node: Higher-order Arglists55333 -Node: Typing and Constants57139 -Node: About Hobbit58403 -Node: The Aims of Developing Hobbit58663 -Node: Manifest59554 -Node: Author and Contributors60013 -Node: Future Improvements61068 -Node: Release History61833 -Node: Index68622 +Node: Top1023 +Node: Introduction2111 +Node: Compiling with Hobbit3427 +Node: Compiling And Linking3685 +Node: Error Detection8371 +Node: Hobbit Options9677 +Node: CC Optimizations16410 +Node: The Language Compiled17366 +Node: Macros18025 +Node: SCM Primitive Procedures18629 +Node: SLIB Logical Procedures19551 +Node: Fast Integer Calculations20706 +Node: Force and Delay21840 +Node: Suggestions for writing fast code22425 +Node: Performance of Compiled Code32624 +Node: Gain in Speed32884 +Node: Benchmarks34469 +Node: Benchmark Sources37569 +Node: Destruct37915 +Node: Recfib39502 +Node: div-iter and div-rec39757 +Node: Hanoi40843 +Node: Tak41424 +Node: Ctak41779 +Node: Takl42759 +Node: Cpstak43415 +Node: Pi44194 +Node: Principles of Compilation45327 +Node: Macro-Expansion and Analysis45753 +Node: Building Closures49558 +Node: Lambda-lifting52449 +Node: Statement-lifting55180 +Node: Higher-order Arglists56288 +Node: Typing and Constants58094 +Node: About Hobbit59358 +Node: The Aims of Developing Hobbit59618 +Node: Manifest60509 +Node: Author and Contributors60968 +Node: Future Improvements62023 +Node: Release History62788 +Node: Index69577 End Tag Table @@ -209,7 +209,9 @@ tcs-cons-imcar tcs-cons-nimcar tcs-cons-gloc tcs-closures tcs-subrs
tc7-asubr tcs-symbols tc7-ssymbol tcs-bignums tc16-bigpos tc3-cons
tc3-cons-gloc tc3-closure tc7-ssymbol tc7-msymbol tc7-string
- tc7-vector tc7-bvect tc7-ivect tc7-uvect tc7-fvect tc7-dvect tc7-cvect
+ tc7-vector tc7-Vbool
+ tc7-VfixZ32 tc7-VfixN32 tc7-VfixZ16 tc7-VfixN16 tc7-VfixZ8 tc7-VfixN8
+ tc7-VfloR32 tc7-VfloC32 tc7-VfloR64 tc7-VfloC64
tc7-contin tc7-cclo tc7-asubr
;;; tc7-subr-0 tc7-subr-1
tc7-cxr
@@ -2382,7 +2384,7 @@ atanh sqrt expt integer-expt))
(define *interpreter-defined-vars* '())
-;; '(*features*
+;; '(slib:features
;; most-positive-fixnum most-negative-fixnum))
;; defs in *extra-hobbit-primitive-defs* are used when the extra primitive
@@ -2507,6 +2509,13 @@ ($atanh "ATANH_FUN" 1)
($sqrt "SQRT_FUN" 1) ($expt "EXPT_FUN" 2)
($log "LOG_FUN" 1) ($abs "ABS_FUN" 1) ($exp "EXP_FUN" 1)
+ (real-sin "SIN_FUN" 1) (real-cos "COS_FUN" 1) (real-tan "TAN_FUN" 1)
+ (real-asin "ASIN_FUN" 1) (real-acos "ACOS_FUN" 1) (real-atan "ATAN_FUN" 1)
+ (real-sinh "SINH_FUN" 1) (real-cosh "COSH_FUN" 1)
+ (real-tanh "TANH_FUN" 1) (real-asinh "ASINH_FUN" 1) (real-acosh "ACOSH_FUN" 1)
+ (real-atanh "ATANH_FUN" 1)
+ (real-sqrt "SQRT_FUN" 1) (real-expt "EXPT_FUN" 2)
+ (real-ln "LOG_FUN" 1) (real-exp "EXP_FUN" 1)
(inexact->exact "in2ex" 1)
(make-rectangular "makrect" 2) (make-polar "makpolar" 2)
@@ -6028,13 +6037,18 @@ #f))
(else #f)))
-
(define *float-recognize-ops*
- '($sin $cos $tan $asin $acos $atan $sinh $cosh $tanh $asinh $tanh
- $asinh $acosh $atanh $sqrt $expt $log $abs $exp
- sin cos tan asin acos atan sinh cosh tanh asinh tanh
- asinh acosh atanh))
-
+ '(ln sqrt log exp
+ sin cos tan asin acos atan
+ sinh cosh tanh asinh acosh atanh
+ real-sin real-cos real-tan
+ real-asin real-acos real-atan
+ real-sinh real-cosh real-tanh
+ real-asinh real-acosh real-atanh
+ real-sqrt real-expt real-ln real-exp
+ $sin $cos $tan $asin $acos $atan
+ $sinh $cosh $tanh $asinh $acosh $atanh
+ $sqrt $expt $log $abs $exp))
(define *check-redefining-passed* '())
diff --git a/hobbit.texi b/hobbit.texi index 1afa9c4..0e59bf3 100644 --- a/hobbit.texi +++ b/hobbit.texi @@ -8,6 +8,31 @@ @paragraphindent 0 @c %**end of header +@copying +@noindent +This manual is for the Hobbit compiler for SCM (version +@value{SCMVERSION}, @value{SCMDATE}), + +@noindent +Copyright @copyright{} 2002 Free Software Foundation + +@quotation +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided that the entire +resulting derived work is distributed under the terms of a permission +notice identical to this one. + +Permission is granted to copy and distribute translations of this manual +into another language, under the above conditions for modified versions, +except that this permission notice may be stated in a translation approved +by the author. +@end quotation +@end copying + @dircategory The Algorithmic Language Scheme @direntry * hobbit: (hobbit). SCM Compiler. @@ -24,40 +49,22 @@ @title Hobbit @subtitle SCM Compiler @subtitle Version @value{SCMVERSION} -@author by Tanel Tammet +@author Tanel Tammet @author Department of Computing Science @author Chalmers University of Technology @author University of Go"teborg @author S-41296 Go"teborg Sweden - @page -This Hobbit documentation was converted to texinfo format by Aubrey -Jaffer; and released as part of the SCM @value{SCMVERSION} distribution -@value{SCMDATE}. - -@vskip 0pt plus 1filll -Copyright @copyright{} 1990-1999, 2002 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by the author. +@insertcopying @end titlepage +@contents + +@ifnottex @node Top, Introduction, (dir), (dir) +@top Hobbit -@ifinfo -Hobbit is an optimizing R4RS-Scheme to C compiler written by Tanel -Tammet. +@insertcopying @menu * Introduction:: @@ -68,31 +75,7 @@ Tammet. * About Hobbit:: * Index:: @end menu - -Copyright (C) 1990-1999, 2002 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). - -@end ignore -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by the author. -@end ifinfo - +@end ifnottex @node Introduction, Compiling with Hobbit, Top, Top @chapter Introduction @@ -334,7 +317,7 @@ Selecting the type of arithmetics. By default hobbit assumes that only immediate (ie small, up to 30 bits) integers are used. It will automatically assume general arithmetics in case it finds any non-immediate numbers like 1.2 or 10000000000000 or -real-only procedures like @t{$sin} anywhere in the source. +real-only procedures like @t{real-sin} anywhere in the source. Another way to make Hobbit assume that generic arithmetic supported by SCM (ie exact and/or inexact reals, bignums) is also used, is to @@ -636,8 +619,9 @@ correspondence with the SCM interpreter while hindering the speed): @example @group -$sqrt $abs $exp $log $sin $cos $tan $asin $acos -$atan $sinh $cosh $tanh $asinh $acosh $atanh $expt +real-sqrt real-exp real-ln real-expt real-sin real-cos real-tan +real-asin real-acos real-atan real-sinh real-cosh real-tanh real-asinh +real-acosh real-atanh @end group @end example @@ -1429,7 +1413,7 @@ Puzzle | 0.28 0.41 | 0.46(0.22 gc) 0.03 (do ((l (string-length s) (+ 1 l))) ((>= l d) (display s)) (display #\0))) - (if (zero? (modulo j 10)) (newline) (display #\ ))) + (if (zero? (modulo j 10)) (newline) (display #\space))) (newline))) @end group @end example @@ -2281,5 +2265,4 @@ the first release @printindex fn -@contents @bye diff --git a/indexes.texi b/indexes.texi new file mode 100644 index 0000000..0aff554 --- /dev/null +++ b/indexes.texi @@ -0,0 +1,50 @@ + +@ifhtml +@node Index, , The Implementation, Top +@unnumbered Index +@end ifhtml + +@ifnotinfo +@menu +* Procedure and Macro Index:: +* Variable Index:: +* Type Index:: +* Concept Index:: +@end menu +@end ifnotinfo + +@ifnotinfo +@node Procedure and Macro Index, Variable Index, Indexes, Indexes +@end ifnotinfo +@unnumberedsec Procedure and Macro Index + +@c This is an alphabetical list of all the procedures and macros in SCM. + +@printindex fn + +@ifnotinfo +@node Variable Index, Type Index, Procedure and Macro Index, Indexes +@end ifnotinfo +@unnumberedsec Variable Index + +@c This is an alphabetical list of all the global variables in SCM. + +@printindex vr + +@ifnotinfo +@node Type Index, Concept Index, Variable Index, Indexes +@end ifnotinfo +@unnumberedsec Type Index + +@c This is an alphabetical list of data types and feature names in SCM. + +@printindex tp + +@ifnotinfo +@node Concept Index, , Type Index, Indexes +@end ifnotinfo +@unnumberedsec Concept Index + +@c This is an alphabetical list of concepts introduced in this manual. + +@printindex cp diff --git a/mkimpcat.scm b/mkimpcat.scm index c745cfc..02d1323 100644 --- a/mkimpcat.scm +++ b/mkimpcat.scm @@ -1,4 +1,4 @@ -;; Copyright (C) 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1997, 1998, 1999, 2001, 2003, 2004, 2006 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -73,7 +73,13 @@ (display " " op) (write (cons from to) op) (newline op)) - (define (add-source feature filename) (add-alias feature filename)) + (define (add-source feature filename) + (cond ((file-exists? filename) + (display " " op) + (write (list feature 'source filename) op) + (newline op) + #t) + (else #f))) (define (add-links feature usr:lib x:lib link:able-suffix) (display* "#+" feature) (display* "(") @@ -120,14 +126,7 @@ (in-wb-vicinity "blkio" link:able-suffix) (in-wb-vicinity "scan" link:able-suffix) (usr:lib "c"))) - (add-source 'wb-table - (in-implementation-vicinity "wbtab")) - (add-source 'wb-table - (in-wb-vicinity "wbtab")) - (add-source 'rwb-isam - (in-implementation-vicinity "rwb-isam")) - (add-source 'rwb-isam - (in-wb-vicinity "rwb-isam")) + ;; wbtab and rwb-isam moved to "Simple associations" (add-alias 'wb 'db))) (cond ((add-link 'mysql (in-implementation-vicinity "database" @@ -217,12 +216,27 @@ (add-source 'build (in-implementation-vicinity "build")) (add-source 'compile (in-implementation-vicinity (string-append "compile" (scheme-file-suffix)))) + (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))))) + (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))))) (display* ")") ) (display* "#+" 'primitive-hygiene) (display* "(") - (add-source 'macro (in-implementation-vicinity "Macro")) + (add-source 'macro (in-implementation-vicinity + (string-append "Macro" (scheme-file-suffix)))) (display* ")") (add-links 'dld @@ -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=5e2 +VERSION=5e3 #endif #ifndef SCMVERSION -# define SCMVERSION "5e2" +# define SCMVERSION "5e3" #endif #ifdef nosve # define INIT_FILE_NAME "Init"SCMVERSION"_scm"; diff --git a/platform.txi b/platform.txi index d7b3d13..ef3d033 100644 --- a/platform.txi +++ b/platform.txi @@ -26,6 +26,7 @@ hp-ux hp-risc hp-ux cc irix mips irix gcc linux i386 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 @@ -154,7 +154,7 @@ SCM scm_getgroups() The length needs not be exactly right */ grps = must_malloc_cell((0L + ngroups) * sizeof(gid_t), MAKE_LENGTH(((0L + ngroups) * sizeof(gid_t))/sizeof(long), - tc7_uvect), + tc7_VfixN32), scm_s_getgroups); ALLOW_INTS; { diff --git a/r4rstest.scm b/r4rstest.scm index d0842c5..5025733 100644 --- a/r4rstest.scm +++ b/r4rstest.scm @@ -88,7 +88,7 @@ (list #t #f #\a '() 9739 '(test) record-error "test" "" 'test '#() '#(a b c) )) (define i 1) -(for-each (lambda (x) (display (make-string i #\ )) +(for-each (lambda (x) (display (make-string i #\space)) (set! i (+ 3 i)) (write x) (newline)) @@ -242,6 +242,8 @@ (test '(list 3 4) 'quasiquote (quasiquote (list (unquote (+ 1 2)) 4))) (test '`(list ,(+ 1 2) 4) 'quasiquote '(quasiquote (list (unquote (+ 1 2)) 4))) (SECTION 5 2 1) +(define (tprint x) #t) +(test #t 'tprint (tprint 56)) (define add3 (lambda (x) (+ x 3))) (test 6 'define (add3 3)) (define first car) @@ -341,7 +343,7 @@ (record-error (list #f #t (list 'test-eq?-eqv?-agreement obj1 obj2))) (display "eqv? and eq? disagree about ") (write obj1) - (display #\ ) + (display #\space) (write obj2) (newline))))) @@ -605,6 +607,8 @@ (define f0.0 (string->number "0.0")) (define f0.8 (string->number "0.8")) (define f1.0 (string->number "1.0")) + (define f1e300 (and (string->number "1+3i") (string->number "1e300"))) + (define f1e-300 (and (string->number "1+3i") (string->number "1e-300"))) (define wto write-test-obj) (define lto load-test-obj) (newline) @@ -613,7 +617,27 @@ (SECTION 6 2) (test #f eqv? 1 f1.0) (test #f eqv? 0 f0.0) + (test #t eqv? f0.0 f0.0) + (cond ((= f0.0 (- f0.0)) + (test #t eqv? f0.0 (- f0.0)) + (test #t equal? f0.0 (- f0.0)))) + (cond ((= f0.0 (* -5 f0.0)) + (test #t eqv? f0.0 (* -5 f0.0)) + (test #t equal? f0.0 (* -5 f0.0)))) (SECTION 6 5 5) + (and f1e300 + (let ((f1e300+1e300i (make-rectangular f1e300 f1e300))) + (test f1.0 'magnitude (/ (magnitude f1e300+1e300i) + (* f1e300 (sqrt 2)))) + (test f.25 / f1e300+1e300i (* 4 f1e300+1e300i)))) + (and f1e-300 + (let ((f1e-300+1e-300i (make-rectangular f1e-300 f1e-300))) + (test f1.0 'magnitude (round (/ (magnitude f1e-300+1e-300i) + (* f1e-300 (sqrt 2))))) + (test f.25 / f1e-300+1e-300i (* 4 f1e-300+1e-300i)))) + (test #t = f0.0 f0.0) + (test #t = f0.0 (- f0.0)) + (test #t = f0.0 (* -5 f0.0)) (test #t inexact? f3.9) (test #t 'max (inexact? (max f3.9 4))) (test f4.0 max f3.9 4) @@ -642,18 +666,18 @@ ;;(test f0.0 expt f0.0 f-3.25) (test (atan 1) atan 1 1) - (set! write-test-obj (list f.25 f-3.25));.25 inexact errors less likely. + (set! write-test-obj (list f.25 f-3.25)) ;.25 inexact errors less likely. (set! load-test-obj (list 'define 'foo (list 'quote write-test-obj))) (test #t call-with-output-file - "tmp3" - (lambda (test-file) - (write-char #\; test-file) - (display #\; test-file) - (display ";" test-file) - (write write-test-obj test-file) - (newline test-file) - (write load-test-obj test-file) - (output-port? test-file))) + "tmp3" + (lambda (test-file) + (write-char #\; test-file) + (display #\; test-file) + (display ";" test-file) + (write write-test-obj test-file) + (newline test-file) + (write load-test-obj test-file) + (output-port? test-file))) (check-test-file "tmp3") (set! write-test-obj wto) (set! load-test-obj lto) @@ -748,43 +772,55 @@ (lambda (n1 n2) (= n1 (+ (* n2 (quotient n1 n2)) (remainder n1 n2))))) + (define b3-3 (string->number "33333333333333333333")) + (define b3-2 (string->number "33333333333333333332")) + (define b3-0 (string->number "33333333333333333330")) + (define b2-0 (string->number "2177452800")) (newline) (display ";testing bignums; ") (newline) (SECTION 6 5 7) - (test 0 modulo 33333333333333333333 3) - (test 0 modulo 33333333333333333333 -3) - (test 0 remainder 33333333333333333333 3) - (test 0 remainder 33333333333333333333 -3) - (test 2 modulo 33333333333333333332 3) - (test -1 modulo 33333333333333333332 -3) - (test 2 remainder 33333333333333333332 3) - (test 2 remainder 33333333333333333332 -3) - (test 1 modulo -33333333333333333332 3) - (test -2 modulo -33333333333333333332 -3) - (test -2 remainder -33333333333333333332 3) - (test -2 remainder -33333333333333333332 -3) - - (test 3 modulo 3 33333333333333333333) - (test 33333333333333333330 modulo -3 33333333333333333333) - (test 3 remainder 3 33333333333333333333) - (test -3 remainder -3 33333333333333333333) - (test -33333333333333333330 modulo 3 -33333333333333333333) - (test -3 modulo -3 -33333333333333333333) - (test 3 remainder 3 -33333333333333333333) - (test -3 remainder -3 -33333333333333333333) - - (test 0 modulo -2177452800 86400) - (test 0 modulo 2177452800 -86400) - (test 0 modulo 2177452800 86400) - (test 0 modulo -2177452800 -86400) - (test 0 modulo 0 -2177452800) - (test #t 'remainder (tb 281474976710655325431 65535)) - (test #t 'remainder (tb 281474976710655325430 65535)) + (test 0 modulo b3-3 3) + (test 0 modulo b3-3 -3) + (test 0 remainder b3-3 3) + (test 0 remainder b3-3 -3) + (test 2 modulo b3-2 3) + (test -1 modulo b3-2 -3) + (test 2 remainder b3-2 3) + (test 2 remainder b3-2 -3) + (test 1 modulo (- b3-2) 3) + (test -2 modulo (- b3-2) -3) + (test -2 remainder (- b3-2) 3) + (test -2 remainder (- b3-2) -3) + + (test 3 modulo 3 b3-3) + (test b3-0 modulo -3 b3-3) + (test 3 remainder 3 b3-3) + (test -3 remainder -3 b3-3) + (test (- b3-0) modulo 3 (- b3-3)) + (test -3 modulo -3 (- b3-3)) + (test 3 remainder 3 (- b3-3)) + (test -3 remainder -3 (- b3-3)) + + (test 0 modulo (- b2-0) 86400) + (test 0 modulo b2-0 -86400) + (test 0 modulo b2-0 86400) + (test 0 modulo (- b2-0) -86400) + (test 0 modulo 0 (- b2-0)) + (test #t 'remainder (tb (string->number "281474976710655325431") 65535)) + (test #t 'remainder (tb (string->number "281474976710655325430") 65535)) + + (let ((n (string->number + "30414093201713378043612608166064768844377641568960512"))) + (and n (exact? n) + (do ((pow3 1 (* 3 pow3)) + (cnt 21 (+ -1 cnt))) + ((negative? cnt) + (zero? (modulo n pow3)))))) (SECTION 6 5 8) - (test 281474976710655325431 string->number "281474976710655325431") - (test "281474976710655325431" number->string 281474976710655325431) + (test "281474976710655325431" number->string + (string->number "281474976710655325431")) (report-errs)) (define (test-numeric-predicates) @@ -831,7 +867,7 @@ (test #t eqv? #\space '#\Space) (test #t char? #\a) (test #t char? #\() -(test #t char? #\ ) +(test #t char? #\space) (test #t char? '#\newline) (test #f char=? #\A #\B) @@ -132,11 +132,12 @@ int ra_matchp(ra0, ras) break; case tc7_smob: if (!ARRAYP(ra1)) goto scalar; - if (ndim != ARRAY_NDIM(ra1)) + if (ndim != ARRAY_NDIM(ra1)) { if (0==ARRAY_NDIM(ra1)) goto scalar; else return 0; + } s1 = ARRAY_DIMS(ra1); if (bas0 != ARRAY_BASE(ra1)) exact = 3; for (i = 0; i < ndim; i++) @@ -309,7 +310,7 @@ static int racp(src, dst) for (; n-- > 0; i_s += inc_s, i_d += inc_d) CHARS(dst)[i_d] = CHARS(src)[i_s]; break; - case tc7_bvect: if (tc7_bvect != TYP7(src)) goto gencase; + case tc7_Vbool: if (tc7_Vbool != TYP7(src)) goto gencase; if (1==inc_d && 1==inc_s && i_s%LONG_BIT==i_d%LONG_BIT && n>=LONG_BIT) { long *sv = (long *)VELTS(src); long *dv = (long *)VELTS(dst); @@ -324,8 +325,8 @@ static int racp(src, dst) IVDEP(src != dst, for (; n >= LONG_BIT; n -= LONG_BIT, sv++, dv++) *dv = *sv;) - if (n) /* trailing partial word */ - *dv = (*dv & (~0L<<n)) | (*sv & ~(~0L<<n)); + if (n) /* trailing partial word */ + *dv = (*dv & (~0L<<n)) | (*sv & ~(~0L<<n)); } else { for (; n-- > 0; i_s += inc_s, i_d += inc_d) @@ -335,15 +336,15 @@ static int racp(src, dst) VELTS(dst)[i_d/LONG_BIT] &= ~(1L << (i_d%LONG_BIT)); } break; - case tc7_uvect: - case tc7_ivect: { + case tc7_VfixN32: + case tc7_VfixZ32: { long *d = (long *)VELTS(dst), *s = (long *)VELTS(src); if (TYP7(src)==TYP7(dst)) { IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) d[i_d] = s[i_s];) - } - else if (tc7_ivect==TYP7(dst)) + } + else if (tc7_VfixZ32==TYP7(dst)) for (; n-- > 0; i_s += inc_s, i_d += inc_d) d[i_d] = num2long(cvref(src, i_s, UNDEFINED), (char *)ARG2, s_array_copy); @@ -354,86 +355,135 @@ static int racp(src, dst) break; } # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *d = (float *)VELTS(dst); float *s = (float *)VELTS(src); switch TYP7(src) { default: goto gencase; - case tc7_ivect: case tc7_uvect: + case tc7_VfixZ32: case tc7_VfixN32: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) d[i_d] = ((long *)s)[i_s]; ) - break; - case tc7_fvect: + break; + case tc7_VfloR32: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) d[i_d] = s[i_s]; ) - break; - case tc7_dvect: + break; + case tc7_VfloR64: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) d[i_d] = ((double *)s)[i_s]; ) - break; + break; } break; } - case tc7_dvect: { + case tc7_VfloR64: { double *d = (double *)VELTS(dst); double *s = (double *)VELTS(src); switch TYP7(src) { default: goto gencase; - case tc7_ivect: case tc7_uvect: + case tc7_VfixZ32: case tc7_VfixN32: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) d[i_d] = ((long *)s)[i_s]; ) - break; - case tc7_fvect: + break; + case tc7_VfloR32: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) d[i_d] = ((float *)s)[i_s];) - break; - case tc7_dvect: + break; + case tc7_VfloR64: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) d[i_d] = s[i_s];) - break; + break; } break; } - case tc7_cvect: { + case tc7_VfloC32: { + float (*d)[2] = (float (*)[2])VELTS(dst); + float (*s)[2] = (float (*)[2])VELTS(src); + switch TYP7(src) { + default: goto gencase; + case tc7_VfixZ32: case tc7_VfixN32: + IVDEP(src != dst, + for (; n-- > 0; i_s += inc_s, i_d += inc_d) { + d[i_d][0] = ((long *)s)[i_s]; + d[i_d][1] = 0.0; + }) + break; + case tc7_VfloR32: + IVDEP(src != dst, + for (; n-- > 0; i_s += inc_s, i_d += inc_d) { + d[i_d][0] = ((float *)s)[i_s]; + d[i_d][1] = 0.0; + }) + break; + case tc7_VfloR64: + IVDEP(src != dst, + for (; n-- > 0; i_s += inc_s, i_d += inc_d) { + d[i_d][0] = ((double *)s)[i_s]; + d[i_d][1] = 0.0; + }) + break; + case tc7_VfloC32: + IVDEP(src != dst, + for (; n-- > 0; i_s += inc_s, i_d += inc_d) { + d[i_d][0] = s[i_s][0]; + d[i_d][1] = s[i_s][1]; + }) + break; + case tc7_VfloC64: + IVDEP(src != dst, + for (; n-- > 0; i_s += inc_s, i_d += inc_d) { + d[i_d][0] = ((double (*)[2])s)[i_s][0]; + d[i_d][1] = ((double (*)[2])s)[i_s][1]; + }) + break; + } + } + case tc7_VfloC64: { double (*d)[2] = (double (*)[2])VELTS(dst); double (*s)[2] = (double (*)[2])VELTS(src); switch TYP7(src) { default: goto gencase; - case tc7_ivect: case tc7_uvect: + case tc7_VfixZ32: case tc7_VfixN32: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) { d[i_d][0] = ((long *)s)[i_s]; d[i_d][1] = 0.0; }) - break; - case tc7_fvect: + break; + case tc7_VfloR32: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) { d[i_d][0] = ((float *)s)[i_s]; d[i_d][1] = 0.0; }) - break; - case tc7_dvect: + break; + case tc7_VfloR64: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) { d[i_d][0] = ((double *)s)[i_s]; d[i_d][1] = 0.0; }) - break; - case tc7_cvect: + break; + case tc7_VfloC32: + IVDEP(src != dst, + for (; n-- > 0; i_s += inc_s, i_d += inc_d) { + d[i_d][0] = ((float (*)[2])s)[i_s][0]; + d[i_d][1] = ((float (*)[2])s)[i_s][1]; + }) + break; + case tc7_VfloC64: IVDEP(src != dst, for (; n-- > 0; i_s += inc_s, i_d += inc_d) { d[i_d][0] = s[i_s][0]; d[i_d][1] = s[i_s][1]; }) + break; } - break; } # endif /* FLOATS */ } @@ -463,7 +513,7 @@ SCM ra2contig(ra, copy) len *= ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1; k = ARRAY_NDIM(ra); if (ARRAY_CONTP(ra) && ((0==k) || (1==ARRAY_DIMS(ra)[k-1].inc))) { - if (tc7_bvect != TYP7(ARRAY_V(ra))) + if (tc7_Vbool != TYP7(ARRAY_V(ra))) return ra; if ((len==LENGTH(ARRAY_V(ra)) && 0==ARRAY_BASE(ra) % LONG_BIT && @@ -541,30 +591,31 @@ SCM sc2array(s, ra, prot) switch TYP7(ARRAY_V(res)) { case tc7_vector: break; - case tc7_bvect: + case tc7_Vbool: if (BOOL_T==s || BOOL_F==s) break; goto mismatch; case tc7_string: if (ICHRP(s)) break; goto mismatch; - case tc7_uvect: + case tc7_VfixN32: if (INUMP(s) && INUM(s)>=0) break; #ifdef BIGDIG if (NIMP(s) && tc16_bigpos==TYP16(s) && NUMDIGS(s)<=DIGSPERLONG) break; #endif goto mismatch; - case tc7_ivect: + case tc7_VfixZ32: if (INUMP(s)) break; #ifdef BIGDIG if (NIMP(s) && BIGP(s) && NUMDIGS(s)<=DIGSPERLONG) break; #endif goto mismatch; #ifdef FLOATS - case tc7_fvect: - case tc7_dvect: + case tc7_VfloR32: + case tc7_VfloR64: if (NUMBERP(s) && !(NIMP(s) && CPLXP(s))) break; goto mismatch; - case tc7_cvect: + case tc7_VfloC32: + case tc7_VfloC64: if (NUMBERP(s)) break; goto mismatch; #endif @@ -597,26 +648,33 @@ int ra_eqp(ra0, ras) BVE_CLR(ra0, i0); break; } - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (BVE_REF(ra0, i0)) if (VELTS(ra1)[i1] != VELTS(ra2)[i2]) BVE_CLR(ra0, i0); break; # ifdef FLOATS - case tc7_fvect: + case tc7_VfloR32: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (BVE_REF(ra0, i0)) if (((float *)VELTS(ra1))[i1] != ((float *)VELTS(ra2))[i2]) BVE_CLR(ra0, i0); break; - case tc7_dvect: + case tc7_VfloR64: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (BVE_REF(ra0, i0)) if (((double *)VELTS(ra1))[i1] != ((double *)VELTS(ra2))[i2]) BVE_CLR(ra0, i0); break; - case tc7_cvect: + case tc7_VfloC32: + for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) + if (BVE_REF(ra0, i0)) + if (((float *)VELTS(ra1))[2*i1] != ((float *)VELTS(ra2))[2*i2] || + ((float *)VELTS(ra1))[2*i1+1] != ((float *)VELTS(ra2))[2*i2+1]) + BVE_CLR(ra0, i0); + break; + case tc7_VfloC64: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (BVE_REF(ra0, i0)) if (((double *)VELTS(ra1))[2*i1] != ((double *)VELTS(ra2))[2*i2] || @@ -651,7 +709,7 @@ static int ra_compare(ra0, ra1, ra2, opt) BVE_CLR(ra0, i0); break; } - case tc7_uvect: + case tc7_VfixN32: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) { if (BVE_REF(ra0, i0)) if (opt ? @@ -660,7 +718,7 @@ static int ra_compare(ra0, ra1, ra2, opt) BVE_CLR(ra0, i0); } break; - case tc7_ivect: + case tc7_VfixZ32: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) { if (BVE_REF(ra0, i0)) if (opt ? @@ -670,7 +728,7 @@ static int ra_compare(ra0, ra1, ra2, opt) } break; # ifdef FLOATS - case tc7_fvect: + case tc7_VfloR32: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (BVE_REF(ra0, i0)) if (opt ? @@ -678,7 +736,7 @@ static int ra_compare(ra0, ra1, ra2, opt) ((float *)VELTS(ra1))[i1] >= ((float *)VELTS(ra2))[i2]) BVE_CLR(ra0, i0); break; - case tc7_dvect: + case tc7_VfloR64: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) if (BVE_REF(ra0, i0)) if (opt ? @@ -732,7 +790,7 @@ int ra_sum(ra0, ras) MAKINUM(i0)); break; } - case tc7_uvect: { + case tc7_VfixN32: { unsigned long r; unsigned long *v0 = (unsigned long *)VELTS(ra0); unsigned long *v1 = (unsigned long *)VELTS(ra1); @@ -744,7 +802,7 @@ int ra_sum(ra0, ras) } ); break; } - case tc7_ivect: { + case tc7_VfixZ32: { long r, *v0 = (long *)VELTS(ra0), *v1 = (long *)VELTS(ra1); IVDEP(ra0 != ra1, for (; n-- > 0; i0 += inc0, i1 += inc1) { @@ -755,7 +813,7 @@ int ra_sum(ra0, ras) break; } # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *v0 = (float *)VELTS(ra0); float *v1 = (float *)VELTS(ra1); IVDEP(ra0 != ra1, @@ -763,7 +821,7 @@ int ra_sum(ra0, ras) v0[i0] += v1[i1]); break; } - case tc7_dvect: { + case tc7_VfloR64: { double *v0 = (double *)VELTS(ra0); double *v1 = (double *)VELTS(ra1); IVDEP(ra0 != ra1, @@ -771,7 +829,17 @@ int ra_sum(ra0, ras) v0[i0] += v1[i1]); break; } - case tc7_cvect: { + case tc7_VfloC32: { + float (*v0)[2] = (float (*)[2])VELTS(ra0); + float (*v1)[2] = (float (*)[2])VELTS(ra1); + IVDEP(ra0 != ra1, + for (; n-- > 0; i0 += inc0, i1 += inc1) { + v0[i0][0] += v1[i1][0]; + v0[i0][1] += v1[i1][1]; + }); + break; + } + case tc7_VfloC64: { double (*v0)[2] = (double (*)[2])VELTS(ra0); double (*v1)[2] = (double (*)[2])VELTS(ra1); IVDEP(ra0 != ra1, @@ -802,26 +870,34 @@ int ra_difference(ra0, ras) aset(ra0, difference(RVREF(ra0, i0, e0), UNDEFINED), MAKINUM(i0)); break; } - case tc7_ivect: { + case tc7_VfixZ32: { long *v0 = VELTS(ra0); for (; n-- > 0; i0 += inc0) v0[i0] = -v0[i0]; break; } # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *v0 = (float *)VELTS(ra0); for (; n-- > 0; i0 += inc0) v0[i0] = -v0[i0]; break; } - case tc7_dvect: { + case tc7_VfloR64: { double *v0 = (double *)VELTS(ra0); for (; n-- > 0; i0 += inc0) v0[i0] = -v0[i0]; break; } - case tc7_cvect: { + case tc7_VfloC32: { + float (*v0)[2] = (float (*)[2])VELTS(ra0); + for (; n-- > 0; i0 += inc0) { + v0[i0][0] = -v0[i0][0]; + v0[i0][1] = -v0[i0][1]; + } + break; + } + case tc7_VfloC64: { double (*v0)[2] = (double (*)[2])VELTS(ra0); for (; n-- > 0; i0 += inc0) { v0[i0][0] = -v0[i0][0]; @@ -845,7 +921,7 @@ int ra_difference(ra0, ras) aset(ra0, difference(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)), MAKINUM(i0)); break; } - case tc7_uvect: { + case tc7_VfixN32: { unsigned long r; unsigned long *v0 = (unsigned long *)VELTS(ra0); unsigned long *v1 = (unsigned long*)VELTS(ra1); @@ -857,7 +933,7 @@ int ra_difference(ra0, ras) } ); break; } - case tc7_ivect: { + case tc7_VfixZ32: { long r, *v0 = VELTS(ra0), *v1 = VELTS(ra1); IVDEP(ra0 != ra1, for (; n-- > 0; i0 += inc0, i1 += inc1) { @@ -868,7 +944,7 @@ int ra_difference(ra0, ras) break; } # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *v0 = (float *)VELTS(ra0); float *v1 = (float *)VELTS(ra1); IVDEP(ra0 != ra1, @@ -876,7 +952,7 @@ int ra_difference(ra0, ras) v0[i0] -= v1[i1]); break; } - case tc7_dvect: { + case tc7_VfloR64: { double *v0 = (double *)VELTS(ra0); double *v1 = (double *)VELTS(ra1); IVDEP(ra0 != ra1, @@ -884,7 +960,17 @@ int ra_difference(ra0, ras) v0[i0] -= v1[i1]); break; } - case tc7_cvect: { + case tc7_VfloC32: { + float (*v0)[2] = (float (*)[2])VELTS(ra0); + float (*v1)[2] = (float (*)[2])VELTS(ra1); + IVDEP(ra0 != ra1, + for (; n-- > 0; i0 += inc0, i1 += inc1) { + v0[i0][0] -= v1[i1][0]; + v0[i0][1] -= v1[i1][1]; + }) + break; + } + case tc7_VfloC64: { double (*v0)[2] = (double (*)[2])VELTS(ra0); double (*v1)[2] = (double (*)[2])VELTS(ra1); IVDEP(ra0 != ra1, @@ -921,7 +1007,7 @@ int ra_product(ra0, ras) MAKINUM(i0)); break; } - case tc7_uvect: { + case tc7_VfixN32: { unsigned long r; unsigned long *v0 = (unsigned long *)VELTS(ra0); unsigned long *v1 = (unsigned long *)VELTS(ra1); @@ -933,7 +1019,7 @@ int ra_product(ra0, ras) } ); break; } - case tc7_ivect: { + case tc7_VfixZ32: { long r, *v0 = VELTS(ra0), *v1 =VELTS(ra1); IVDEP(ra0 != ra1, for (; n-- > 0; i0 += inc0, i1 += inc1) { @@ -944,7 +1030,7 @@ int ra_product(ra0, ras) break; } # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *v0 = (float *)VELTS(ra0); float *v1 = (float *)VELTS(ra1); IVDEP(ra0 != ra1, @@ -952,7 +1038,7 @@ int ra_product(ra0, ras) v0[i0] *= v1[i1]); break; } - case tc7_dvect: { + case tc7_VfloR64: { double *v0 = (double *)VELTS(ra0); double *v1 = (double *)VELTS(ra1); IVDEP(ra0 != ra1, @@ -960,7 +1046,19 @@ int ra_product(ra0, ras) v0[i0] *= v1[i1]); break; } - case tc7_cvect: { + case tc7_VfloC32: { + float (*v0)[2] = (float (*)[2])VELTS(ra0); + register double r; + float (*v1)[2] = (float (*)[2])VELTS(ra1); + IVDEP(ra0 != ra1, + for (; n-- > 0; i0 += inc0, i1 += inc1) { + r = v0[i0][0]*v1[i1][0] - v0[i0][1]*v1[i1][1]; + v0[i0][1] = v0[i0][0]*v1[i1][1] + v0[i0][1]*v1[i1][0]; + v0[i0][0] = r; + }); + break; + } + case tc7_VfloC64: { double (*v0)[2] = (double (*)[2])VELTS(ra0); register double r; double (*v1)[2] = (double (*)[2])VELTS(ra1); @@ -993,19 +1091,29 @@ int ra_divide(ra0, ras) break; } # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *v0 = (float *)VELTS(ra0); for (; n-- > 0; i0 += inc0) v0[i0] = 1.0/v0[i0]; break; } - case tc7_dvect: { + case tc7_VfloR64: { double *v0 = (double *)VELTS(ra0); for (; n-- > 0; i0 += inc0) v0[i0] = 1.0/v0[i0]; break; } - case tc7_cvect: { + case tc7_VfloC32: { + register double d; + float (*v0)[2] = (float (*)[2])VELTS(ra0); + for (; n-- > 0; i0 += inc0) { + d = v0[i0][0]*v0[i0][0] + v0[i0][1]*v0[i0][1]; + v0[i0][0] /= d; + v0[i0][1] /= -d; + } + break; + } + case tc7_VfloC64: { register double d; double (*v0)[2] = (double (*)[2])VELTS(ra0); for (; n-- > 0; i0 += inc0) { @@ -1031,7 +1139,7 @@ int ra_divide(ra0, ras) break; } # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *v0 = (float *)VELTS(ra0); float *v1 = (float *)VELTS(ra1); IVDEP(ra0 != ra1, @@ -1039,7 +1147,7 @@ int ra_divide(ra0, ras) v0[i0] /= v1[i1]); break; } - case tc7_dvect: { + case tc7_VfloR64: { double *v0 = (double *)VELTS(ra0); double *v1 = (double *)VELTS(ra1); IVDEP(ra0 != ra1, @@ -1047,7 +1155,20 @@ int ra_divide(ra0, ras) v0[i0] /= v1[i1]); break; } - case tc7_cvect: { + case tc7_VfloC32: { + register double d, r; + float (*v0)[2] = (float (*)[2])VELTS(ra0); + float (*v1)[2] = (float (*)[2])VELTS(ra1); + IVDEP(ra0 != ra1, + for (; n-- > 0; i0 += inc0, i1 += inc1) { + d = v1[i1][0]*v1[i1][0] + v1[i1][1]*v1[i1][1]; + r = (v0[i0][0]*v1[i1][0] + v0[i0][1]*v1[i1][1])/d; + v0[i0][1] = (v0[i0][1]*v1[i1][0] - v0[i0][0]*v1[i1][1])/d; + v0[i0][0] = r; + }) + break; + } + case tc7_VfloC64: { register double d, r; double (*v0)[2] = (double (*)[2])VELTS(ra0); double (*v1)[2] = (double (*)[2])VELTS(ra1); @@ -1118,32 +1239,32 @@ static int ramap_cxr(ra0, proc, ras) } break; # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *dst = (float *)VELTS(ra0); switch TYP7(ra1) { default: goto gencase; - case tc7_fvect: + case tc7_VfloR32: for (; n-- > 0; i0 += inc0, i1 += inc1) dst[i0] = DSUBRF(proc)((double)((float *)VELTS(ra1))[i1]); break; - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: for (; n-- > 0; i0 += inc0, i1 += inc1) dst[i0] = DSUBRF(proc)((double)VELTS(ra1)[i1]); break; } break; } - case tc7_dvect: { + case tc7_VfloR64: { double *dst = (double *)VELTS(ra0); switch TYP7(ra1) { default: goto gencase; - case tc7_dvect: + case tc7_VfloR64: for (; n-- > 0; i0 += inc0, i1 += inc1) dst[i0] = DSUBRF(proc)(((double *)VELTS(ra1))[i1]); break; - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: for (; n-- > 0; i0 += inc0, i1 += inc1) dst[i0] = DSUBRF(proc)((double)VELTS(ra1)[i1]); break; @@ -1536,11 +1657,11 @@ static int raeql_1(ra0, as_equal, ra1) if (*v0 != *v1) return 0; return 1; } - case tc7_bvect: + case tc7_Vbool: for (; n--; i0 += inc0, i1 += inc1) if (BVE_REF(ra0, i0) != BVE_REF(ra1, i1)) return 0; return 1; - case tc7_uvect: case tc7_ivect: { + case tc7_VfixN32: case tc7_VfixZ32: { long *v0 = (long *)VELTS(ra0) + i0; long *v1 = (long *)VELTS(ra1) + i1; for (; n--; v0 += inc0, v1 += inc1) @@ -1548,21 +1669,30 @@ static int raeql_1(ra0, as_equal, ra1) return 1; } # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *v0 = (float *)VELTS(ra0) + i0; float *v1 = (float *)VELTS(ra1) + i1; for (; n--; v0 += inc0, v1 += inc1) if (*v0 != *v1) return 0; return 1; } - case tc7_dvect: { + case tc7_VfloR64: { double *v0 = (double *)VELTS(ra0) + i0; double *v1 = (double *)VELTS(ra1) + i1; for (; n--; v0 += inc0, v1 += inc1) if (*v0 != *v1) return 0; return 1; } - case tc7_cvect: { + case tc7_VfloC32: { + float (*v0)[2]= (float (*)[2])VELTS(ra0) + i0; + float (*v1)[2] = (float (*)[2])VELTS(ra1) + i1; + for (; n--; v0 += inc0, v1 += inc1) { + if ((*v0)[0] != (*v1)[0]) return 0; + if ((*v0)[1] != (*v1)[1]) return 0; + } + return 1; + } + case tc7_VfloC64: { double (*v0)[2]= (double (*)[2])VELTS(ra0) + i0; double (*v1)[2] = (double (*)[2])VELTS(ra1) + i1; for (; n--; v0 += inc0, v1 += inc1) { @@ -44,7 +44,7 @@ #include "scm.h" #include "setjump.h" -void igc P((const char *what, STACKITEM *stackbase)); +void igc P((const char *what, SCM rootcont)); void unexec P((char *new_name, char *a_name, unsigned data_start, unsigned bss_start, unsigned entry_address)); void scm_fill_freelist P((void)); @@ -346,9 +346,9 @@ taloop: } lputc(')', port); break; - case tc7_bvect: - case tc7_ivect: case tc7_uvect: case tc7_svect: - case tc7_fvect: case tc7_dvect: case tc7_cvect: + 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: raprin1(exp, port, writing); break; case tcs_subrs: @@ -863,10 +863,13 @@ static int flush_ws(port) } /* Top-level readers */ -static SCM p_read_numbered, p_read_for_load, p_read; +static SCM p_read_for_load, p_read; static char s_read[] = "read"; static char s_read_for_load[] = "read-for-load"; +#ifndef MEMOIZE_LOCALS +static SCM p_read_numbered; static char s_read_numbered[] = "read-numbered"; +#endif SCM scm_read(port) SCM port; { @@ -879,11 +882,13 @@ SCM scm_read_for_load(port) return lread1(port, 4, s_read_for_load); } +#ifndef MEMOIZE_LOCALS SCM scm_read_numbered(port) SCM port; { return lread1(port, 6, s_read_numbered); } +#endif static SCM lread1(port, flgs, what) SCM port; @@ -995,7 +1000,10 @@ static SCM lreadpr(tok_buf, port, flgs) goto tryagain; default: callshrp: { - SCM reader = (3&flgs) ? p_read_numbered : + SCM reader = +#ifndef MEMOIZE_LOCALS + (3&flgs) ? p_read_numbered : +#endif ((4&flgs) ? p_read_for_load : p_read); SCM args = cons2(MAKICHR(c), port, cons(reader, EOL)); if ((4&flgs) && loc_loadsharp && NIMP(*loc_loadsharp)) { @@ -1440,7 +1448,7 @@ SCM scm_top_level(initpath, toplvl_fun) DEFER_INTS; scm_estk_reset(0); scm_egc(); - igc(s_unexec, (STACKITEM *)0); + igc(s_unexec, BOOL_F); ALLOW_INTS; dumped = 1; # ifdef linux @@ -2256,8 +2264,10 @@ void init_repl( iverbose ) add_feature(s_char_readyp); make_subr(s_swapcar, tc7_subr_2, swapcar); make_subr(s_wfi, tc7_lsubr, wait_for_input); +#ifndef MEMOIZE_LOCALS p_read_numbered = make_subr(s_read_numbered, tc7_subr_1, scm_read_numbered); +#endif p_read_for_load = make_subr(s_read_for_load, tc7_subr_1, scm_read_for_load); p_read = @@ -168,6 +168,15 @@ short num2short(num, pos, s_caller) if (INUMP(num) && lres==res) return res; wta(num, pos, s_caller); } +signed char num2char(num, pos, s_caller) + SCM num; + char *pos, *s_caller; +{ + long lres = INUM((long)num); + char res = lres; + if (INUMP(num) && lres==res) return res; + wta(num, pos, s_caller); +} #ifdef FLOATS double num2dbl(num, pos, s_caller) SCM num; @@ -318,21 +327,25 @@ unsigned long scm_addr(args, s_name) break; # ifdef FLOATS # ifdef SINGLES - case tc7_fvect: - ptr = (unsigned long)&(((float *)CDR(v))[pos]); + case tc7_VfloC32: pos = 2 * pos; + case tc7_VfloR32: ptr = (unsigned long)&(((float *)CDR(v))[pos]); break; # endif - case tc7_cvect: pos = 2 * pos; - case tc7_dvect: ptr = (unsigned long)&(((double *)CDR(v))[pos]); + case tc7_VfloC64: pos = 2 * pos; + case tc7_VfloR64: ptr = (unsigned long)&(((double *)CDR(v))[pos]); break; # endif - case tc7_bvect: ASRTGO(0==(pos%LONG_BIT), outrng); + case tc7_Vbool: ASRTGO(0==(pos%LONG_BIT), outrng); pos = pos/LONG_BIT; - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: case tc7_vector: ptr = (unsigned long)&(VELTS(v)[pos]); break; - case tc7_svect: ptr = (unsigned long)&(((short *)CDR(v))[pos]); + case tc7_VfixN16: + case tc7_VfixZ16: ptr = (unsigned long)&(((short *)CDR(v))[pos]); + break; + case tc7_VfixN8: + case tc7_VfixZ8: ptr = (unsigned long)&(((char *)CDR(v))[pos]); break; outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_name); default: @@ -358,21 +371,26 @@ unsigned long scm_base_addr(v, s_name) break; # ifdef FLOATS # ifdef SINGLES - case tc7_fvect: + case tc7_VfloC32: pos = 2 * pos; + case tc7_VfloR32: ptr = (unsigned long)&(((float *)CDR(v))[pos]); break; # endif - case tc7_cvect: pos = 2 * pos; - case tc7_dvect: ptr = (unsigned long)&(((double *)CDR(v))[pos]); + case tc7_VfloC64: pos = 2 * pos; + case tc7_VfloR64: ptr = (unsigned long)&(((double *)CDR(v))[pos]); break; # endif - case tc7_bvect: ASRTGO(0==(pos%LONG_BIT), outrng); + case tc7_Vbool: ASRTGO(0==(pos%LONG_BIT), outrng); pos = pos/LONG_BIT; - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: case tc7_vector: ptr = (unsigned long)&(VELTS(v)[pos]); break; - case tc7_svect: ptr = (unsigned long)&(((short *)CDR(v))[pos]); + case tc7_VfixN16: + case tc7_VfixZ16: ptr = (unsigned long)&(((short *)CDR(v))[pos]); + break; + case tc7_VfixN8: + case tc7_VfixZ8: ptr = (unsigned long)&(((char *)CDR(v))[pos]); break; outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_name); default: @@ -64,7 +64,7 @@ static char s_makrect[] = "make-rectangular", s_makpolar[] = "make-polar", s_real_part[] = "real-part", s_imag_part[] = "imag-part", s_in2ex[] = "inexact->exact",s_ex2in[] = "exact->inexact"; -static char s_expt[] = "$expt", s_atan2[] = "$atan2"; +static char s_expt[] = "real-expt", s_atan2[] = "$atan2"; #endif static char s_memv[] = "memv", s_assv[] = "assv"; @@ -585,11 +585,9 @@ SCM istr2flo(str, len, radix) } if (i==len) return BOOL_F; /* bad if lone `+' or `-' */ -# ifdef FLOATS if (6==len && ('+'==str[0] || '-'==str[0])) if (0==strcmp(str_inf0, &str[1])) return makdbl(1./0. * ('+'==str[0] ? 1 : -1), 0.0); -# endif if (str[i]=='i' || str[i]=='I') { /* handle `+i' and `-i' */ if (lead_sgn==0.0) return BOOL_F; /* must have leading sign */ @@ -1029,9 +1027,9 @@ SCM equal(x, y) if (smobs[i].equalp) return (smobs[i].equalp)(x, y); else return BOOL_F; } - case tc7_bvect: - case tc7_uvect: case tc7_ivect: case tc7_svect: - case tc7_fvect: case tc7_cvect: case tc7_dvect: { + 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: { SCM (*pred)() = smobs[0x0ff & (tc16_array>>8)].equalp; if (pred) return (*pred)(x, y); else return BOOL_F; @@ -1942,11 +1940,15 @@ SCM product(x, y) return y; } } + /* Use "Smith's formula" to extend dynamic range */ + /* David Goldberg + What Every Computer Scientist Should Know About Floating-Point Arithmetic + http://cch.loria.fr/documentation/IEEE754/ACM/goldberg.pdf */ SCM divide(x, y) SCM x, y; { #ifdef FLOATS - double d, r, i, a; + double den, a = 1.0; if (NINUMP(x)) { # ifndef RECKLESS if (!(NIMP(x))) @@ -1956,10 +1958,14 @@ SCM divide(x, y) # ifdef BIGDIG if (BIGP(x)) return makdbl(1.0/big2dbl(x), 0.0); # endif + /* reciprocal */ ASRTGO(INEXP(x), badx); if (REALP(x)) return makdbl(1.0/REALPART(x), 0.0); - r = REAL(x); i = IMAG(x); d = r*r+i*i; - return makdbl(r/d, -i/d); + { + y = x; + a = 1.0; + goto real_over_complex; + } } # ifdef BIGDIG if (BIGP(x)) { @@ -1999,7 +2005,7 @@ SCM divide(x, y) } # endif ASRTGO(INEXP(x), badx); - if (INUMP(y)) {d = INUM(y); goto basic_div;} + if (INUMP(y)) {den = INUM(y); goto basic_div;} # ifdef BIGDIG ASRTGO(NIMP(y), bady); if (BIGP(y)) return bigdblop('\\', y, REALPART(x), CPLXP(x) ? IMAG(x) : 0.0); @@ -2008,13 +2014,28 @@ SCM divide(x, y) ASRTGO(NIMP(y) && INEXP(y), bady); # endif if (REALP(y)) { - d = REALPART(y); - basic_div: return makdbl(REALPART(x)/d, CPLXP(x)?IMAG(x)/d:0.0); + den = REALPART(y); + basic_div: return makdbl(REALPART(x)/den, CPLXP(x)?IMAG(x)/den:0.0); } a = REALPART(x); - if (REALP(x)) goto complex_div; - r = REAL(y); i = IMAG(y); d = r*r+i*i; - return makdbl((a*r+IMAG(x)*i)/d, (IMAG(x)*r-a*i)/d); + if (REALP(x)) goto real_over_complex; + /* Both x and y are complex */ + /* Use "Smith's formula" to extend dynamic range */ + { + double b = IMAG(x); + double c = REALPART(y); + double d = IMAG(y); + if ((d > 0 ? d : -d) < (c > 0 ? c : -c)) { + double r = d/c; + double i = c + d*r; + return makdbl((a + b*r)/i, (b - a*r)/i); + } + { + double r = c/d; + double i = d + c*r; + return makdbl((b + a*r)/i, (-a + b*r)/i); + } + } } if (UNBNDP(y)) { if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x; @@ -2036,9 +2057,23 @@ SCM divide(x, y) # endif if (REALP(y)) return makdbl(INUM(x)/REALPART(y), 0.0); a = INUM(x); - complex_div: - r = REAL(y); i = IMAG(y); d = r*r+i*i; - return makdbl((a*r)/d, (-a*i)/d); + real_over_complex: + /* Both x and y are complex */ + /* Use "Smith's formula" to extend dynamic range */ + { + double c = REALPART(y); + double d = IMAG(y); + if ((d > 0 ? d : -d) < (c > 0 ? c : -c)) { + double r = d/c; + double i = c + d*r; + return makdbl((a)/i, (- a*r)/i); + } + { + double r = c/d; + double i = d + c*r; + return makdbl((a*r)/i, (-a)/i); + } + } } #else # ifdef BIGDIG @@ -2370,7 +2405,17 @@ SCM scm_magnitude(z) if (CPLXP(z)) { double i = IMAG(z), r = REAL(z); - return makdbl(sqrt(i*i+r*r), 0.0); + if (i < 0) i = -i; + if (r < 0) r = -r; + if (i < r) { + double q = i / r; + return makdbl(r * sqrt(1 + q * q), 0.0); + } + if (0.0==i) return i; + { + double q = r / i; + return makdbl(i * sqrt(1 + q * q), 0.0); + } } return makdbl(fabs(REALPART(z)), 0.0); } @@ -2848,23 +2893,23 @@ static dblproc cxrs[] = { {"ceiling", ceil}, {"truncate", scm_truncate}, {"round", scm_round}, - {"$sqrt", sqrt}, {"$abs", fabs}, - {"$exp", exp}, - {"$log", log}, - {"$log10", log10}, - {"$sin", sin}, - {"$cos", cos}, - {"$tan", tan}, - {"$asin", asin}, - {"$acos", acos}, - {"$atan", atan}, - {"$sinh", sinh}, - {"$cosh", cosh}, - {"$tanh", tanh}, - {"$asinh", asinh}, - {"$acosh", acosh}, - {"$atanh", atanh}, + {"real-sqrt", sqrt}, + {"real-exp", exp}, + {"real-ln", log}, + {"real-log10", log10}, + {"real-sin", sin}, + {"real-cos", cos}, + {"real-tan", tan}, + {"real-asin", asin}, + {"real-acos", acos}, + {"real-atan", atan}, + {"real-sinh", sinh}, + {"real-cosh", cosh}, + {"real-tanh", tanh}, + {"real-asinh", asinh}, + {"real-acosh", acosh}, + {"real-atanh", atanh}, {0, 0}}; #endif @@ -1,5 +1,5 @@ .\" dummy line -.TH SCM "Jan 4 2000" +.TH SCM "April 2006" .UC 4 .SH NAME scm \- a Scheme Language Interpreter @@ -59,10 +59,12 @@ Unless the option .I -no-init-file or .I --no-init-file -occurs in the command line, "Init.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 it is loaded. +occurs in the command line or if +.I scm +is being invoked as a script, "Init.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. "Init.scm" then looks for command input from one of three sources: From an option on the command line, from a file named on the command @@ -1018,7 +1018,7 @@ void add_feature(str) } void init_features() { - loc_features = &CDR(sysintern("*features*", EOL)); + loc_features = &CDR(sysintern("slib:features", EOL)); init_iprocs(subr0s, tc7_subr_0); init_iprocs(subr1s, tc7_subr_1); make_subr(s_execpath, tc7_subr_1o, scm_execpath); @@ -1,4 +1,4 @@ -SCM(Jan 4 2000) SCM(Jan 4 2000) +SCM(April 2006) SCM(April 2006) @@ -21,9 +21,10 @@ DESCRIPTION set IMPLINIT to "Init.scm" in the source directory. Unless the option -no-init-file or --no-init-file occurs in the command - line, "Init.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 it is loaded. + line or if scm is being invoked as a script, "Init.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. "Init.scm" then looks for command input from one of three sources: From an option on the command line, from a file named on the command line, @@ -197,8 +198,8 @@ FEATURES 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 - compiled modules. + 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. @@ -238,4 +239,4 @@ SEE ALSO -4th Berkeley Distribution SCM(Jan 4 2000) +4th Berkeley Distribution SCM(April 2006) @@ -443,6 +443,7 @@ SCM_EXPORT long tc16_env, tc16_ident; #define SYMBOLP(x) (TYP7S(x)==tc7_ssymbol) #define STRINGP(x) (TYP7(x)==tc7_string) #define NSTRINGP(x) (!STRINGP(x)) +#define BYTESP(x) (TYP7(x)==tc7_VfixN8) #define VECTORP(x) (TYP7(x)==tc7_vector) #define NVECTORP(x) (!VECTORP(x)) #define LENGTH(x) (((unsigned long)CAR(x))>>8) @@ -520,9 +521,9 @@ 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_bvect:\ - case tc7_uvect:case tc7_ivect:case tc7_svect:\ - case tc7_fvect:case tc7_dvect:case tc7_cvect +#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 tc3_cons_nimcar 0 #define tc3_cons_imcar 2:case 4:case 6 @@ -534,20 +535,28 @@ SCM_EXPORT long tc16_array; #define tc7_msymbol 7 #define tc7_string 13 #define tc7_vector 15 -#define tc7_bvect 21 -/* spare 23 */ -#define tc7_ivect 29 -#define tc7_uvect 31 -#define tc7_svect 37 -/* spare 39 */ -#define tc7_fvect 45 -#define tc7_dvect 47 -#define tc7_cvect 53 -#define tc7_port 55 -#define tc7_contin 61 -#define tc7_specfun 63 - -/* spare 69 71 77 79 */ +#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_VfloR32 53 +#define tc7_VfloC32 55 +#define tc7_VfloR64 61 +#define tc7_VfloC64 63 + +/* 69 */ + +#define tc7_port 71 +#define tc7_contin 77 +#define tc7_specfun 79 + #define tc7_subr_0 85 #define tc7_subr_1 87 #define tc7_cxr 93 @@ -1,5 +1,24 @@ -This is scm.info, produced by makeinfo version 4.7 from scm.texi. - +This is scm.info, produced by makeinfo version 4.8 from scm.texi. + +This manual is for SCM (version 5e3, October 2006), and algorithmic | +language Scheme implementation. | + | +Copyright (C) 1990-2006 Free Software Foundation, Inc. | + | + Permission is granted to make and distribute verbatim copies of | + this manual provided the copyright notice and this permission | + notice are preserved on all copies. | + | + Permission is granted to copy and distribute modified versions of | + this manual under the conditions for verbatim copying, provided | + that the entire resulting derived work is distributed under the | + terms of a permission notice identical to this one. | + | + Permission is granted to copy and distribute translations of this | + manual into another language, under the above conditions for | + modified versions, except that this permission notice may be | + stated in a translation approved by the author. | + | INFO-DIR-SECTION The Algorithmic Language Scheme START-INFO-DIR-ENTRY * SCM: (scm). A Scheme interpreter. @@ -8,27 +27,27 @@ END-INFO-DIR-ENTRY File: scm.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir) -This manual documents the SCM Scheme implementation. SCM version -5e2 was released February 2006. The most recent information about SCM | -can be found on SCM's "WWW" home page: | +SCM | +*** | - `http://swiss.csail.mit.edu/~jaffer/SCM' +This manual is for SCM (version 5e3, October 2006), and algorithmic | +language Scheme implementation. | -Copyright (C) 1990-1999 Free Software Foundation +Copyright (C) 1990-2006 Free Software Foundation, Inc. | -Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. + Permission is granted to make and distribute verbatim copies of | + this manual provided the copyright notice and this permission | + notice are preserved on all copies. | -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. + Permission is granted to copy and distribute modified versions of | + this manual under the conditions for verbatim copying, provided | + that the entire resulting derived work is distributed under the | + terms of a permission notice identical to this one. | -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation -approved by the author. + Permission is granted to copy and distribute translations of this | + manual into another language, under the above conditions for | + modified versions, except that this permission notice may be | + stated in a translation approved by the author. | * Menu: @@ -85,8 +104,8 @@ File: scm.info, Node: SCM Features, Next: SCM Authors, Prev: Overview, Up: O `copy-tree', `acons', and `eval'. * `Char-code-limit', `most-positive-fixnum', `most-negative-fixnum', - `and internal-time-units-per-second' constants. `*Features*' and - `*load-pathname*' variables. + `and internal-time-units-per-second' constants. `slib:features' | + and `*load-pathname*' variables. | * Arrays and bit-vectors. String ports and software emulation ports. I/O extensions providing ANSI C and POSIX.1 facilities. @@ -237,7 +256,7 @@ File: scm.info, Node: SIOD copyright, Prev: The SCM License, Up: Copying -------------------- - COPYRIGHT (c) 1989 BY + COPYRIGHT (C) 1989 BY | PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. ALL RIGHTS RESERVED @@ -387,18 +406,18 @@ 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: - * swiss.csail.mit.edu:/pub/scm/slib3a3.tar.gz | + * swiss.csail.mit.edu:/pub/scm/slib3a4.tar.gz | - * ftp.gnu.org:/pub/gnu/jacal/slib3a3.tar.gz | + * ftp.gnu.org:/pub/gnu/jacal/slib3a4.tar.gz | - * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a3.tar.gz | + * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a4.tar.gz | -Unpack SLIB (`tar xzf slib3a3.tar.gz' or `unzip -ao slib3a3.zip') in an | +Unpack SLIB (`tar xzf slib3a4.tar.gz' or `unzip -ao slib3a4.zip') in an | appropriate directory for your system; both `tar' and `unzip' will create the directory `slib'. Then create a file `require.scm' in the SCM "implementation-vicinity" -(this is the same directory as where the file `Init5e2.scm' is | +(this is the same directory as where the file `Init5e3.scm' is | installed). `require.scm' should have the contents: (define (library-vicinity) "/usr/local/lib/slib/") @@ -470,7 +489,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 "Init5e2.scm"'>>scmflags.h | + echo '#define IMPLINIT "Init5e3.scm"'>>scmflags.h | echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h echo '#define ARRAYS'>>scmflags.h @@ -489,7 +508,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 "Init5e2.scm"'>>scmflags.h | + echo '#define IMPLINIT "Init5e3.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 @@ -543,6 +562,7 @@ the SCM command line options. irix mips irix gcc linux i386 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 @@ -622,7 +642,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 `Init5e2.scm'. SCM tries several likely | + initialization file `Init5e3.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. @@ -736,13 +756,18 @@ the SCM command line options. For the "curses" screen management package. "debug" - Turns on the features `cautious', - `careful-interrupt-masking', and `stack-limit'; uses `-g' - flags for debugging SCM source code. + 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. @@ -829,14 +854,7 @@ the SCM command line options. "socket" BSD "socket" interface. Socket addr functions require inexacts or bignums for 32-bit precision. - - "stack-limit" - Use to enable checking for stack overflow. Define value of - the C preprocessor variable STACK_LIMIT to be the size to - which SCM should allow the stack to grow. STACK_LIMIT should - be less than the maximum size the hardware can support, as - not every routine checks the stack. - + | "tick-interrupts" Use if you want the ticks and ticks-interrupt functions. @@ -882,7 +900,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/Init5e2.scm"'>>scmflags.h | + echo '#define IMPLINIT "/home/jaffer/scm/Init5e3.scm"'>>scmflags.h | echo '#define COMPILED_INITS init_foo();'>>scmflags.h echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h @@ -898,7 +916,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/Init5e2.scm"'>>scmflags.h | + echo '#define IMPLINIT "/home/jaffer/scm/Init5e3.scm"'>>scmflags.h | echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h echo '#define ARRAYS'>>scmflags.h @@ -1018,6 +1036,36 @@ No modifications to the emacs source code were required to use 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. | + | +Recent Linux innovations interfere with `dump'. For: | + | +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... | + | + 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' | + 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. | + | + | File: scm.info, Node: Automatic C Preprocessor Definitions, Next: Problems Compiling, Prev: Saving Images, Up: Installing SCM @@ -1037,7 +1085,7 @@ lines or add a `#define FLAG' line to `scmfig.h' or the beginning of ARM_ULIB Huw Rogers free unix library for acorn archimedes AZTEC_C Aztec_C 5.2a __CYGWIN__ Cygwin - __CYGWIN32__ 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 @@ -1067,7 +1115,7 @@ lines or add a `#define FLAG' line to `scmfig.h' or the beginning of macintosh Macintosh (THINK_C and __MWERKS__ define) MCH_AMIGA Aztec_c 5.2a on AMIGA __MACH__ Apple Darwin - __MINGW32__ MinGW - Minimalist GNU for Windows | + __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 @@ -1109,7 +1157,7 @@ lines or add a `#define FLAG' line to `scmfig.h' or the beginning of sequent Sequent computer tahoe CCI Tahoe processor vax VAX processor - __x86_64 AMD Opteron | + __x86_64 AMD Opteron File: scm.info, Node: Problems Compiling, Next: Problems Linking, Prev: Automatic C Preprocessor Definitions, Up: Installing SCM @@ -1176,17 +1224,17 @@ remove <FLAG> in scmfig.h and Do so and recompile files. recompile scm. add <FLAG> in scmfig.h and recompile scm. -ERROR: Init5e2.scm not found. Assign correct IMPLINIT in makefile | +ERROR: Init5e3.scm not found. Assign correct IMPLINIT in makefile | or scmfig.h. Define environment variable SCM_INIT_PATH to be the full - pathname of Init5e2.scm. | + pathname of Init5e3.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 - Init5e2.scm to point to library or | + Init5e3.scm to point to library or | remove. Make sure the value of (library-vicinity) has a trailing @@ -1246,11 +1294,13 @@ 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. `Init5e2.scm'). | +output files. `Init5e3.scm'). | Spaces or control characters appear Check character defines in in symbol names. `scmfig.h'. Negative numbers turn positive. Check SRS in `scmfig.h'. -VMS: Couldn't unwind stack. #define CHEAP_CONTIUATIONS in +;ERROR: bignum: numerical overflow Increase NUMDIGS_MAX in `scmfig.h' | + and recompile. | +VMS: Couldn't unwind stack. #define CHEAP_CONTINUATIONS in | `scmfig.h'. VAX: botched longjmp. @@ -1329,7 +1379,7 @@ 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 `Init5e2.scm') in platform-dependent directories relative | +file (usually `Init5e3.scm') in platform-dependent directories relative | to this directory. See *Note File-System Habitat:: for a blow-by-blow description. @@ -1338,12 +1388,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, `Init5e2.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 it is loaded. +command line, or if `scm' is being invoked as a script, `Init5e3.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. | -`Init5e2.scm' then looks for command input from one of three sources: | +`Init5e3.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. @@ -1504,13 +1554,13 @@ File: scm.info, Node: SCM Variables, Next: SCM Session, Prev: Invocation Exam -- Environment Variable: SCM_INIT_PATH is the pathname where `scm' will look for its initialization code. - The default is the file `Init5e2.scm' in the source directory. | + The default is the file `Init5e3.scm' in the source directory. | -- Environment Variable: SCHEME_LIBRARY_PATH is the [SLIB] Scheme library directory. -- Environment Variable: HOME - is the directory where `Init5e2.scm' will look for the user | + is the directory where `Init5e3.scm' will look for the user | initialization file `ScmInit.scm'. -- Environment Variable: EDITOR @@ -1634,8 +1684,8 @@ File: scm.info, Node: Debugging Scheme Code, Next: Debugging Continuations, P 3.8 Debugging Scheme Code ========================= -The `cautious' and `stack-limit' options of `build' (*note Build -Options::) support debugging in Scheme. +The `cautious' option of `build' (*note Build Options::) supports | +debugging in Scheme. | "CAUTIOUS" If SCM is built with the `CAUTIOUS' flag, then when an error @@ -1655,15 +1705,11 @@ Options::) support debugging in Scheme. with <C-c>, inspect or modify top-level values, trace or untrace procedures, and continue execution with `(continue)'. -"STACK_LIMIT" - If SCM is built with the `STACK_LIMIT' flag, the interpreter will - check stack size periodically. If the size of stack exceeds a - certain amount (default is `HEAP_SEG_SIZE/2'), SCM generates a - `segment violation' interrupt. - - The usefulness of `STACK_LIMIT' depends on the user. I don't use - it; but the user I added this feature for got primarily this type - of error. +If `verbose' (*note verbose: Internal State.) is called with an | +argument greater than 2, then the interpreter will check stack size | +periodically. If the size of stack in use exceeds the C #define | +`STACK_LIMIT' (default is `HEAP_SEG_SIZE'), SCM generates a `stack' | +`segment violation'. | There are several SLIB macros which so useful that SCM automatically loads the appropriate module from SLIB if they are invoked. @@ -1933,13 +1979,13 @@ 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 `Init5e2.scm'. | + containing the arguments. `warn' is defined in `Init5e3.scm'. | -- Function: error arg1 arg2 arg3 ... 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 `Init5e2.scm'. | + defined in `Init5e3.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 @@ -1957,7 +2003,7 @@ 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 `Init5e2.scm' for an example of the use | + and `#f' otherwise. See `Init5e3.scm' for an example of the use | of `stack-trace'. @@ -1982,7 +2028,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 `Init5e2.scm': | +For instance, `open-input-file' is defined as follows in `Init5e3.scm': | (define (open-input-file str) (or (open-file str OPEN_READ) @@ -2031,7 +2077,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 `Init5e2.scm' for details. | + more complicated; see `Init5e3.scm' for details. | -- Function: abort Resumes the top level Read-Eval-Print loop. @@ -2065,7 +2111,8 @@ File: scm.info, Node: Internal State, Next: Scripting, Prev: Memoized Express >= 3 the CPU time is printed after each top level form evaluated; - notifications of heap growth printed. + notifications of heap growth printed; the interpreter checks | + stack depth periodically. | >= 4 a garbage collection summary is printed after each top level @@ -2085,7 +2132,7 @@ File: scm.info, Node: Internal State, Next: Scripting, Prev: Memoized Express #t)' also gives the hexadecimal heap segment and stack bounds. -- Constant: *scm-version* - Contains the version string (e.g. `5e2') of SCM. | + Contains the version string (e.g. `5e3') of SCM. | 3.12.1 Executable path ---------------------- @@ -3003,14 +3050,13 @@ File: scm.info, Node: Common-Lisp Read Syntax, Next: Load Syntax, Prev: Lexic `m-' prefixes may be combined. -- Read syntax: #+ feature form - If feature is `provided?' (by `*features*') then FORM is read as a - scheme expression. If not, then FORM is treated as whitespace. + If feature is `provided?' then FORM is read as a scheme | + expression. If not, then FORM is treated as whitespace. | Feature is a boolean expression composed of symbols and `and', `or', and `not' of boolean expressions. - For more information on `provided?' and `*features*', *Note - Require: (slib)Require. + For more information on `provided?', *Note Require: (slib)Require. | -- Read syntax: #- feature form is equivalent to `#+(not feature) expression'. @@ -3710,7 +3756,7 @@ an example of their use. -- Function: dyn:main-call name link-token arg1 ... LINK-TOKEN should be the value returned by a call to `dyn:link'. NAME should be the name of C function of 2 arguments, `(int argc, - const char **argv)', defined in the file named FILENAME which was | + const char **argv)', defined in the file named FILENAME which was succesfully `dyn:link'ed in the current SCM session. The `dyn:main-call' procedure calls the C function corresponding to NAME with `argv' style arguments, such as are given to C `main' @@ -3862,36 +3908,35 @@ operations: (r5rs)Numerical operations. -- Function: atanh z Return the inverse hyperbolic sine, cosine, and tangent of Z - -- Function: $sqrt x - -- Function: $abs x - -- Function: $exp x - -- Function: $log x - -- Function: $sin x - -- Function: $cos x - -- Function: $tan x - -- Function: $asin x - -- Function: $acos x - -- Function: $atan x - -- Function: $sinh x - -- Function: $cosh x - -- Function: $tanh x - -- Function: $asinh x - -- Function: $acosh x - -- Function: $atanh x + -- Function: real-sqrt x | + -- Function: real-exp x | + -- Function: real-ln x | + -- Function: real-sin x | + -- Function: real-cos x | + -- Function: real-tan x | + -- Function: real-asin x | + -- Function: real-acos x | + -- Function: real-atan x | + -- Function: real-sinh x | + -- Function: real-cosh x | + -- Function: real-tanh x | + -- Function: real-asinh x | + -- Function: real-acosh x | + -- Function: real-atanh x | Real-only versions of these popular functions. The argument X must be a real number. It is an error if the value which should be returned by a call to these procedures is _not_ real. - -- Function: $log10 x + -- Function: real-log10 x | Real-only base 10 logarithm. -- Function: $atan2 y x Computes `(angle (make-rectangular x y))' for real numbers Y and X. - -- Function: $expt x1 x2 + -- Function: real-expt x1 x2 | Returns real number X1 raised to the real power X2. It is an - error if the value which should be returned by a call to `$expt' - is not real. + error if the value which should be returned by a call to | + `real-expt' is not real. | File: scm.info, Node: Arrays, Next: Records, Prev: Numeric, Up: Packages @@ -4338,7 +4383,7 @@ I/O: (slib)Line I/O, and the following functions are defined: "Link.scm" "Macro.scm" "Transcen.scm" - "Init5e2.scm" | + "Init5e3.scm" | -- Function: mkdir path mode The `mkdir' function creates a new, empty directory whose name is @@ -5923,25 +5968,34 @@ memory allocated by `malloc'. Returns the C array of `char's or as `unsigned char's holding the elements of string X or its length, respectively. - -- Header: tc7_bvect + -- Header: tc7_Vbool | uniform vector of booleans (bit-vector) - -- Header: tc7_ivect + -- Header: tc7_VfixZ32 | uniform vector of integers - -- Header: tc7_uvect + -- Header: tc7_VfixN32 | uniform vector of non-negative integers - -- Header: tc7_svect + -- Header: tc7_VfixN16 | + uniform vector of non-negative short integers | + | + -- Header: tc7_VfixZ16 | uniform vector of short integers - -- Header: tc7_fvect + -- Header: tc7_VfixN8 | + uniform vector of non-negative bytes | + | + -- Header: tc7_VfixZ8 | + uniform vector of signed bytes | + | + -- Header: tc7_VfloR32 | uniform vector of short inexact real numbers - -- Header: tc7_dvect + -- Header: tc7_VfloR64 | uniform vector of double precision inexact real numbers - -- Header: tc7_cvect + -- Header: tc7_VfloC64 | uniform vector of double precision inexact complex numbers -- Header: tc7_contin @@ -5998,10 +6052,11 @@ type `SCM'. enabled, the `CDR' should be a function which takes and returns type `double'. Conversions are handled in the interpreter. - `floor', `ceiling', `truncate', `round', `$sqrt', `$abs', `$exp', - `$log', `$sin', `$cos', `$tan', `$asin', `$acos', `$atan', - `$sinh', `$cosh', `$tanh', `$asinh', `$acosh', `$atanh', and - `exact->inexact' are defined this way. + `floor', `ceiling', `truncate', `round', `real-sqrt', `real-exp', | + `real-ln', `real-sin', `real-cos', `real-tan', `real-asin', | + `real-acos', `real-atan', `real-sinh', `real-cosh', `real-tanh', | + `real-asinh', `real-acosh', `real-atanh', and `exact->inexact' are | + defined this way. | If the `CDR' is `0' (`NULL'), the name string of the procedure is used to control traversal of its list structure argument. @@ -6182,7 +6237,8 @@ Defining Smobs::). These are the initial smobs: Conventional Arrays have a pointer to a vector for their `CDR'. Uniform Arrays have a pointer to a Uniform Vector type (string, - bvect, ivect, uvect, fvect, dvect, or cvect) in their `CDR'. + Vbool, VfixZ32, VfixN32, VfloR32, VfloR64, or VfloC64) in their | + `CDR'. | File: scm.info, Node: Data Type Representations, Prev: Smob Cells, Up: Data Types @@ -6212,32 +6268,34 @@ ssymbol .........long length....G0000101 ..........char *chars........... msymbol .........long length....G0000111 ..........char *chars........... string .........long length....G0001101 ..........char *chars........... vector .........long length....G0001111 ...........SCM **elts........... -bvect .........long length....G0010101 ..........long *words........... - spare G0010111 -ivect .........long length....G0011101 ..........long *words........... -uvect .........long length....G0011111 ......unsigned long *words...... - spare G0100101 -svect .........long length....G0100111 ........ short *words........... -fvect .........long length....G0101101 .........float *words........... -dvect .........long length....G0101111 ........double *words........... -cvect .........long length....G0110101 ........double *words........... - -contin .........long length....G0111101 .............*regs.............. -specfun ................xxxxxxxxG1111111 ...........SCM name............. -cclo ..short length..xxxxxx10G1111111 ...........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........... | +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 | +contin .........long length....G1001101 .............*regs.............. | +specfun ................xxxxxxxxG1001111 ...........SCM name............. | +cclo ..short length..xxxxxx10G1001111 ...........SCM **elts........... | PTOBs - port int portnum.CwroxxxxxxxxG0110111 ..........FILE *stream.......... - socket int portnum.C001xxxxxxxxG0110111 ..........FILE *stream.......... - inport int portnum.C011xxxxxxxxG0110111 ..........FILE *stream.......... -outport int portnum.0101xxxxxxxxG0110111 ..........FILE *stream.......... - ioport int portnum.C111xxxxxxxxG0110111 ..........FILE *stream.......... -fport int portnum.C 00000000G0110111 ..........FILE *stream.......... -pipe int portnum.C 00000001G0110111 ..........FILE *stream.......... -strport 00000000000.0 00000010G0110111 ..........FILE *stream.......... -sfport int portnum.C 00000011G0110111 ..........FILE *stream.......... - SUBRs - spare 010001x1 - spare 010011x1 + port int portnum.CwroxxxxxxxxG1000111 ..........FILE *stream.......... | + socket int portnum.C001xxxxxxxxG1000111 ..........FILE *stream.......... | + inport int portnum.C011xxxxxxxxG1000111 ..........FILE *stream.......... | +outport int portnum.0101xxxxxxxxG1000111 ..........FILE *stream.......... | + ioport int portnum.C111xxxxxxxxG1000111 ..........FILE *stream.......... | +fport int portnum.C 00000000G1000111 ..........FILE *stream.......... | +pipe int portnum.C 00000001G1000111 ..........FILE *stream.......... | +strport 00000000000.0 00000010G1000111 ..........FILE *stream.......... | +sfport int portnum.C 00000011G1000111 ..........FILE *stream.......... | + SUBRs | subr_0 ..........int hpoff.....01010101 ...........SCM (*f)()........... subr_1 ..........int hpoff.....01010111 ...........SCM (*f)()........... cxr ..........int hpoff.....01011101 .........double (*f)().......... @@ -6339,7 +6397,7 @@ symbols, "symhash". mark bit in OBJ, then calls `gc_mark()' on any SCM components of OBJ. The last call to `gc_mark()' is tail-called (looped). - -- Function: void mark_locations (STACKITEM X[], sizet LEN)) + -- Function: void mark_locations (STACKITEM X[], sizet LEN) | The function `mark_locations' is used for marking segments of C-stack or saved segments of C-stack (marked continuations). The argument LEN is the size of the stack in units of size @@ -6664,12 +6722,12 @@ To add a package of new procedures to scm (see `crs.c' for example): add_feature("foo"); - will append a symbol `'foo' to the (list) value of `*features*'. + will append a symbol `'foo' to the (list) value of `slib:features'. | 7. put any scheme code which needs to be run as part of your package into `Ifoo.scm'. - 8. put an `if' into `Init5e2.scm' which loads `Ifoo.scm' if your | + 8. put an `if' into `Init5e3.scm' which loads `Ifoo.scm' if your | package is included: (if (defined? twiddle-bits!) @@ -6969,7 +7027,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 "Init5e2_scm"), and the directory separator string | + (default "Init5e3_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. @@ -7072,7 +7130,7 @@ Here is a minimal embedding program `libtest.c': int main(argc, argv) int argc; - const char **argv; | + const char **argv; { SCM retval; char *implpath, *execpath; @@ -7092,7 +7150,7 @@ Here is a minimal embedding program `libtest.c': -| dld_find_executable(./libtest): /home/jaffer/scm/libtest - implpath: /home/jaffer/scm/Init5e2.scm | + implpath: /home/jaffer/scm/Init5e3.scm | This is libtest_init_user_scm hello world @@ -7108,7 +7166,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 - `Init5e2.scm'. | + `Init5e3.scm'. | -- Function: int scm_ldprog (char *FILE) Loads the Scheme source file `(in-vicinity (program-vicinity) @@ -7528,7 +7586,7 @@ File: scm.info, Node: Executable Pathname, Next: Script Support, Prev: File-S 6.3.2 Executable Pathname ------------------------- -For purposes of finding `Init5e2.scm', dumping an executable, and | +For purposes of finding `Init5e3.scm', dumping an executable, and | dynamic linking, a SCM session needs the pathname of its executable image. @@ -7547,7 +7605,7 @@ the full pathname for the associated executable file. for the first occurrence. Thus, it is advisable to invoke `dld_init' as: - main (int argc, const char **argv) | + main (int argc, const char **argv) { ... if (dld_init (dld_find_executable (argv[0]))) { @@ -7773,23 +7831,24 @@ with a VMS system needs to finish and debug it. File: scm.info, Node: Index, Prev: The Implementation, Up: Top -Procedure and Macro Index -************************* +Index | +***** | -This is an alphabetical list of all the procedures and macros in SCM. +Procedure and Macro Index | +========================= | * Menu: * #!: Unix Scheme Scripts. (line 40) * #': Common-Lisp Read Syntax. - (line 50) + (line 49) | * #+: Common-Lisp Read Syntax. (line 16) * #-: Common-Lisp Read Syntax. - (line 26) + (line 25) | * #.: Common-Lisp Read Syntax. - (line 39) + (line 38) | * #;text-till-end-of-line: Documentation and Comments. (line 31) * #?column: Load Syntax. (line 12) @@ -7798,76 +7857,58 @@ This is an alphabetical list of all the procedures and macros in SCM. * #\token: Common-Lisp Read Syntax. (line 7) * #|: Common-Lisp Read Syntax. - (line 29) -* $abs: Numeric. (line 38) -* $acos: Numeric. (line 45) -* $acosh: Numeric. (line 51) -* $asin: Numeric. (line 44) -* $asinh: Numeric. (line 50) -* $atan: Numeric. (line 46) -* $atan2: Numeric. (line 60) -* $atanh: Numeric. (line 52) -* $cos: Numeric. (line 42) -* $cosh: Numeric. (line 48) -* $exp: Numeric. (line 39) -* $expt: Numeric. (line 63) -* $log: Numeric. (line 40) -* $log10: Numeric. (line 57) -* $sin: Numeric. (line 41) -* $sinh: Numeric. (line 47) -* $sqrt: Numeric. (line 37) -* $tan: Numeric. (line 43) -* $tanh: Numeric. (line 49) + (line 28) | +* $atan2: Numeric. (line 59) | * -: SCM Options. (line 108) * ---: SCM Options. (line 109) -* ---c-source-files=: Build Options. (line 133) -* ---compiler-options=: Build Options. (line 118) -* ---defines=: Build Options. (line 111) -* ---features=: Build Options. (line 191) +* ---c-source-files=: Build Options. (line 134) | +* ---compiler-options=: Build Options. (line 119) | +* ---defines=: Build Options. (line 112) | +* ---features=: Build Options. (line 192) | * ---help: SCM Options. (line 20) -* ---initialization=: Build Options. (line 141) -* ---libraries=: Build Options. (line 103) -* ---linker-options=: Build Options. (line 121) +* ---initialization=: Build Options. (line 142) | +* ---libraries=: Build Options. (line 104) | +* ---linker-options=: Build Options. (line 122) | * ---no-init-file: SCM Options. (line 17) -* ---object-files=: Build Options. (line 137) -* ---outname=: Build Options. (line 97) +* ---object-files=: Build Options. (line 138) | +* ---outname=: Build Options. (line 98) | * ---platform=: Build Options. (line 12) -* ---scheme-initial=: Build Options. (line 125) -* ---type=: Build Options. (line 146) +* ---scheme-initial=: Build Options. (line 126) | +* ---type=: Build Options. (line 147) | * ---version: SCM Options. (line 23) -* --batch-dialect=: Build Options. (line 164) -* --script-name=: Build Options. (line 186) +* --batch-dialect=: Build Options. (line 165) | +* --script-name=: Build Options. (line 187) | * -a: SCM Options. (line 9) * -b: SCM Options. (line 98) * -c <1>: SCM Options. (line 46) -* -c: Build Options. (line 132) +* -c: Build Options. (line 133) | * -d: SCM Options. (line 42) -* -D: Build Options. (line 110) +* -D: Build Options. (line 111) | * -e: SCM Options. (line 45) * -f: SCM Options. (line 37) -* -F: Build Options. (line 190) -* -f: Build Options. (line 68) +* -F: Build Options. (line 191) | +* -f: Build Options. (line 69) | * -h <1>: SCM Options. (line 33) -* -h: Build Options. (line 163) +* -h: Build Options. (line 164) | * -i <1>: SCM Options. (line 88) -* -i: Build Options. (line 140) -* -j: Build Options. (line 136) +* -i: Build Options. (line 141) | +* -j: Build Options. (line 137) | * -l <1>: SCM Options. (line 36) -* -l: Build Options. (line 102) +* -l: Build Options. (line 103) | * -m: SCM Options. (line 75) * -no-init-file: SCM Options. (line 16) * -o <1>: SCM Options. (line 52) -* -o: Build Options. (line 96) +* -o: Build Options. (line 97) | * -p <1>: SCM Options. (line 62) * -p: Build Options. (line 11) * -q: SCM Options. (line 71) * -r: SCM Options. (line 26) * -s <1>: SCM Options. (line 103) -* -s: Build Options. (line 124) -* -t: Build Options. (line 145) +* -s: Build Options. (line 125) | +* -t: Build Options. (line 146) | * -u: SCM Options. (line 82) * -v: SCM Options. (line 66) -* -w: Build Options. (line 185) +* -w: Build Options. (line 186) | * @apply: Environment Frames. (line 54) * @copy-tree: Storage. (line 16) * @macroexpand1: Syntactic Hooks for Hygienic Macros. @@ -7918,7 +7959,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * CAR: Cells. (line 23) * cbreak: Terminal Mode Setting. (line 12) -* CCLO_LENGTH: Header Cells. (line 101) +* CCLO_LENGTH: Header Cells. (line 110) | * CDR: Cells. (line 24) * char: Type Conversions. (line 27) * char-ready: Port Properties. (line 39) @@ -7982,7 +8023,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * exec-self: Internal State. (line 27) * execl: I/O-Extensions. (line 207) * execlp: I/O-Extensions. (line 208) -* execpath: Internal State. (line 78) +* execpath: Internal State. (line 79) | * execv: I/O-Extensions. (line 218) * execvp: I/O-Extensions. (line 219) * exit: SCM Session. (line 19) @@ -8004,7 +8045,7 @@ This is an alphabetical list of all the procedures and macros in SCM. (line 10) * free_continuation: Continuations. (line 79) * freshline: Port Properties. (line 26) -* gc: Internal State. (line 57) +* gc: Internal State. (line 58) | * gc-hook: Storage. (line 28) * gc_mark: Marking Cells. (line 27) * GCCDR: Marking Cells. (line 15) @@ -8096,7 +8137,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * macroexpand-1: Defmacro. (line 6) * main: Embedding SCM. (line 12) * makargvfrmstrs: Type Conversions. (line 76) -* makcclo: Header Cells. (line 96) +* makcclo: Header Cells. (line 105) | * make-arbiter: Process Synchronization. (line 35) * make-edited-line-port: Line Editing. (line 29) @@ -8178,13 +8219,13 @@ This is an alphabetical list of all the procedures and macros in SCM. * port-type: Port Properties. (line 10) * PORTP: Ptob Cells. (line 33) * pp: Debugging Scheme Code. - (line 79) + (line 75) | * pprint: Debugging Scheme Code. - (line 66) + (line 62) | * print: Debugging Scheme Code. - (line 58) + (line 54) | * print-args: Debugging Scheme Code. - (line 84) + (line 80) | * procedure->identifier-macro: Macro Primitives. (line 14) * procedure->macro: Macro Primitives. (line 12) * procedure->memoizing-macro: Macro Primitives. (line 13) @@ -8207,6 +8248,23 @@ This is an alphabetical list of all the procedures and macros in SCM. (line 7) * readdir: I/O-Extensions. (line 92) * 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) | * record-printer-set!: Records. (line 10) * redirect-port!: I/O-Extensions. (line 83) * refresh: Window Manipulation. (line 29) @@ -8241,7 +8299,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * restore_signals: Embedding SCM. (line 90) * rewinddir: I/O-Extensions. (line 97) * rmdir: I/O-Extensions. (line 140) -* room: Internal State. (line 61) +* room: Internal State. (line 62) | * savetty: Terminal Mode Setting. (line 59) * scalar->array: Array Mapping. (line 51) @@ -8323,7 +8381,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * touchline: Window Manipulation. (line 55) * touchwin: Window Manipulation. (line 54) * trace: Debugging Scheme Code. - (line 41) + (line 37) | * transpose-array: Conventional Arrays. (line 21) * try-arbiter: Process Synchronization. (line 39) @@ -8343,7 +8401,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * uniform-array-read!: Uniform Array. (line 67) * uniform-array-write: Uniform Array. (line 79) * untrace: Debugging Scheme Code. - (line 49) + (line 45) | * user-interrupt: Interrupts. (line 49) * usr:lib: Dynamic Linking. (line 18) * utime: I/O-Extensions. (line 167) @@ -8378,9 +8436,7 @@ This is an alphabetical list of all the procedures and macros in SCM. * x:lib: Dynamic Linking. (line 23) Variable Index -************** - -This is an alphabetical list of all the global variables in SCM. +============== | * Menu: @@ -8392,7 +8448,7 @@ This is an alphabetical list of all the global variables in SCM. * *interactive*: SCM Variables. (line 36) * *load-pathname*: Eval and Load. (line 15) * *load-reader*: Line Numbers. (line 50) -* *scm-version*: Internal State. (line 66) +* *scm-version*: Internal State. (line 67) | * *slib-load-reader*: Line Numbers. (line 51) * *syntax-rules*: SCM Variables. (line 30) * af_inet: Host and Other Inquiries. @@ -8425,9 +8481,7 @@ This is an alphabetical list of all the global variables in SCM. * UNSPECIFIED: Immediates. (line 78) Type Index -********** - -This is an alphabetical list of data types and feature names in SCM. +========== | * Menu: @@ -8485,39 +8539,40 @@ This is an alphabetical list of data types and feature names in SCM. * tc3_closure: Cells. (line 39) * tc3_cons: Cells. (line 32) * tc7_asubr: Subr Cells. (line 12) -* tc7_bvect: Header Cells. (line 55) -* tc7_contin: Header Cells. (line 76) -* tc7_cvect: Header Cells. (line 73) +* tc7_contin: Header Cells. (line 85) | * tc7_cxr: Subr Cells. (line 22) -* tc7_dvect: Header Cells. (line 70) -* tc7_fvect: Header Cells. (line 67) -* tc7_ivect: Header Cells. (line 58) -* tc7_lsubr: Subr Cells. (line 62) -* tc7_lsubr_2: Subr Cells. (line 59) +* tc7_lsubr: Subr Cells. (line 63) | +* tc7_lsubr_2: Subr Cells. (line 60) | * tc7_msymbol: Header Cells. (line 29) -* tc7_rpsubr: Subr Cells. (line 47) -* tc7_specfun: Header Cells. (line 79) +* tc7_rpsubr: Subr Cells. (line 48) | +* tc7_specfun: Header Cells. (line 88) | * tc7_ssymbol: Header Cells. (line 26) * tc7_string: Header Cells. (line 41) * tc7_subr_0: Subr Cells. (line 16) * tc7_subr_1: Subr Cells. (line 19) -* tc7_subr_1o: Subr Cells. (line 51) -* tc7_subr_2: Subr Cells. (line 44) -* tc7_subr_2o: Subr Cells. (line 55) -* tc7_subr_3: Subr Cells. (line 41) -* tc7_svect: Header Cells. (line 64) -* tc7_uvect: Header Cells. (line 61) +* tc7_subr_1o: Subr Cells. (line 52) | +* tc7_subr_2: Subr Cells. (line 45) | +* tc7_subr_2o: Subr Cells. (line 56) | +* tc7_subr_3: Subr Cells. (line 42) | +* tc7_Vbool: Header Cells. (line 55) | * tc7_vector: Header Cells. (line 13) +* tc7_VfixN16: Header Cells. (line 64) | +* tc7_VfixN32: Header Cells. (line 61) | +* tc7_VfixN8: Header Cells. (line 70) | +* tc7_VfixZ16: Header Cells. (line 67) | +* tc7_VfixZ32: Header Cells. (line 58) | +* tc7_VfixZ8: Header Cells. (line 73) | +* tc7_VfloC64: Header Cells. (line 82) | +* tc7_VfloR32: Header Cells. (line 76) | +* tc7_VfloR64: Header Cells. (line 79) | * tc_dblc: Smob Cells. (line 33) * tc_dblr: Smob Cells. (line 30) * tc_free_cell: Smob Cells. (line 15) * turtle-graphics: Dynamic Linking. (line 56) * unexec: Dump. (line 6) - -This is an alphabetical list of concepts introduced in this manual. - + | Concept Index -************* +============= | * Menu: @@ -8531,29 +8586,32 @@ Concept Index * #!.bat: MS-DOS Compatible Scripts. (line 8) * array <1>: Conventional Arrays. (line 9) -* array: Build Options. (line 195) -* array-for-each: Build Options. (line 198) -* arrays: Build Options. (line 201) -* bignums: Build Options. (line 204) -* byte: Build Options. (line 207) +* array: Build Options. (line 196) | +* array-for-each: Build Options. (line 199) | +* arrays: Build Options. (line 202) | +* bignums: Build Options. (line 205) | +* build: Building SCM. (line 6) | +* build.scm: Building SCM. (line 6) | +* byte: Build Options. (line 208) | * callbacks: Callbacks. (line 6) -* careful-interrupt-masking: Build Options. (line 210) -* cautious: Build Options. (line 216) -* cheap-continuations: Build Options. (line 225) -* compiled-closure: Build Options. (line 234) +* careful-interrupt-masking: Build Options. (line 211) | +* cautious: Build Options. (line 217) | +* cheap-continuations: Build Options. (line 226) | +* compiled-closure: Build Options. (line 235) | * continuations: Continuations. (line 6) -* curses: Build Options. (line 237) -* debug: Build Options. (line 240) -* differ: Build Options. (line 245) +* curses: Build Options. (line 238) | +* debug: Build Options. (line 241) | +* differ: Build Options. (line 246) | * documentation string: Documentation and Comments. (line 13) -* dump: Build Options. (line 248) -* dynamic-linking: Build Options. (line 251) +* dont-memoize-locals: Build Options. (line 249) | +* dump: Build Options. (line 254) | +* dynamic-linking: Build Options. (line 257) | * ecache: Memory Management for Environments. (line 6) -* edit-line: Build Options. (line 254) +* edit-line: Build Options. (line 260) | * Embedding SCM: Embedding SCM. (line 6) -* engineering-notation: Build Options. (line 257) +* engineering-notation: Build Options. (line 263) | * environments: Memory Management for Environments. (line 6) * exchanger: Process Synchronization. @@ -8563,187 +8621,186 @@ Concept Index (line 13) * foo.c: Compiling and Linking Custom Files. (line 13) -* generalized-c-arguments: Build Options. (line 262) +* generalized-c-arguments: Build Options. (line 268) | * graphics: Packages. (line 23) * hobbit: Packages. (line 23) -* i/o-extensions: Build Options. (line 265) +* i/o-extensions: Build Options. (line 271) | * IEEE: Bibliography. (line 7) -* inexact: Build Options. (line 269) +* inexact: Build Options. (line 275) | * JACAL: Bibliography. (line 49) -* lit: Build Options. (line 272) -* macro: Build Options. (line 275) +* lit: Build Options. (line 278) | +* macro: Build Options. (line 281) | * memory management: Memory Management for Environments. (line 6) -* mysql: Build Options. (line 279) -* no-heap-shrink: Build Options. (line 282) +* mysql: Build Options. (line 285) | +* no-heap-shrink: Build Options. (line 288) | * NO_ENV_CACHE: Memory Management for Environments. (line 89) -* none: Build Options. (line 287) +* none: Build Options. (line 293) | * posix: Posix Extensions. (line 6) * Posix: Posix Extensions. (line 6) -* posix: Build Options. (line 290) +* posix: Build Options. (line 296) | * R4RS: Bibliography. (line 11) * R5RS: Bibliography. (line 18) -* reckless: Build Options. (line 295) -* record: Build Options. (line 300) -* regex: Build Options. (line 304) -* rev2-procedures: Build Options. (line 307) +* reckless: Build Options. (line 301) | +* record: Build Options. (line 306) | +* regex: Build Options. (line 310) | +* rev2-procedures: Build Options. (line 313) | * rope <1>: Type Conversions. (line 6) * rope: Callbacks. (line 6) * SchemePrimer: Bibliography. (line 39) -* SICP: Build Options. (line 313) -* sicp: Build Options. (line 311) +* SICP: Build Options. (line 319) | +* sicp: Build Options. (line 317) | * SICP: Bibliography. (line 30) * signals: Signals. (line 6) * Simply: Bibliography. (line 35) -* single-precision-only: Build Options. (line 325) +* single-precision-only: Build Options. (line 331) | * SLIB: Bibliography. (line 43) -* socket: Build Options. (line 331) -* stack-limit: Build Options. (line 335) -* tick-interrupts: Build Options. (line 342) -* turtlegr: Build Options. (line 345) +* socket: Build Options. (line 337) | +* tick-interrupts: Build Options. (line 341) | +* turtlegr: Build Options. (line 344) | * unix: Unix Extensions. (line 6) * Unix: Unix Extensions. (line 6) -* unix: Build Options. (line 349) -* wb: Build Options. (line 353) -* windows: Build Options. (line 356) +* unix: Build Options. (line 348) | +* wb: Build Options. (line 352) | +* windows: Build Options. (line 355) | * X: Packages. (line 23) * x <1>: Packages. (line 23) -* x: Build Options. (line 359) +* x: Build Options. (line 358) | * xlib: Packages. (line 23) * Xlib: Packages. (line 23) -* xlib: Build Options. (line 362) +* xlib: Build Options. (line 361) | * xlibscm: Packages. (line 23) * Xlibscm: Packages. (line 23) Tag Table: -Node: Top203 -Node: Overview1498 -Node: SCM Features1813 -Node: SCM Authors3833 -Node: Copying4734 -Node: The SCM License5063 -Node: SIOD copyright8987 -Node: Bibliography10340 -Node: Installing SCM12216 -Node: Making SCM12735 -Node: SLIB13660 -Node: Building SCM15576 -Node: Invoking Build16158 -Node: Build Options18495 -Node: Compiling and Linking Custom Files31870 -Node: Installing Dynamic Linking33866 -Node: Configure Module Catalog35652 -Node: Saving Images37660 -Node: Automatic C Preprocessor Definitions38343 -Node: Problems Compiling42241 -Node: Problems Linking43902 -Node: Problems Running44175 -Node: Testing46293 -Node: Reporting Problems49437 -Node: Operational Features50289 -Node: Invoking SCM50685 -Node: SCM Options52339 -Node: Invocation Examples56708 -Node: SCM Variables57668 -Node: SCM Session59148 -Node: Editing Scheme Code60679 -Node: Debugging Scheme Code62697 -Node: Debugging Continuations67109 -Node: Errors69669 -Node: Memoized Expressions73987 -Node: Internal State76351 -Node: Scripting79518 -Node: Unix Scheme Scripts79822 -Node: MS-DOS Compatible Scripts82854 -Node: Unix Shell Scripts84709 -Node: The Language86850 -Node: Standards Compliance87472 -Node: Storage89895 -Node: Time92375 -Node: Interrupts93391 -Node: Process Synchronization97024 -Node: Files and Ports98553 -Node: Opening and Closing98894 -Node: Port Properties101385 -Node: Port Redirection104071 -Node: Soft Ports105563 -Node: Eval and Load107345 -Node: Line Numbers108761 -Node: Lexical Conventions111184 -Node: Common-Lisp Read Syntax111446 -Node: Load Syntax113473 -Node: Documentation and Comments114093 -Node: Modifying Read Syntax115317 -Node: Syntax117040 -Node: Define and Set117944 -Node: Defmacro121478 -Node: Syntax-Rules122558 -Node: Macro Primitives124364 -Node: Environment Frames126003 -Node: Syntactic Hooks for Hygienic Macros128423 -Node: Packages135397 -Node: Dynamic Linking136277 -Node: Dump140961 -Node: Numeric144982 -Node: Arrays146748 -Node: Conventional Arrays146966 -Node: Uniform Array150505 -Node: Bit Vectors155317 -Node: Array Mapping156625 -Node: Records159319 -Node: I/O-Extensions160191 -Node: Posix Extensions168823 -Node: Unix Extensions178375 -Node: Sequence Comparison180276 -Node: Regular Expression Pattern Matching180606 -Node: Line Editing184584 -Node: Curses185945 -Node: Output Options Setting186880 -Node: Terminal Mode Setting189547 -Node: Window Manipulation192648 -Node: Output196133 -Node: Input199785 -Node: Curses Miscellany200829 -Node: Sockets202270 -Node: Host and Other Inquiries202633 -Node: Internet Addresses and Socket Names205774 -Node: Socket207347 -Node: SCMDB214580 -Node: The Implementation214818 -Node: Data Types215081 -Node: Immediates215910 -Node: Cells220292 -Node: Header Cells222410 -Node: Subr Cells225492 -Node: Ptob Cells227733 -Node: Smob Cells229302 -Node: Data Type Representations232510 -Node: Operations237171 -Node: Garbage Collection237765 -Node: Marking Cells238398 -Node: Sweeping the Heap240520 -Node: Memory Management for Environments241482 -Node: Signals246051 -Node: C Macros247612 -Node: Changing Scm248749 -Node: Defining Subrs253210 -Node: Defining Smobs255070 -Node: Defining Ptobs258127 -Node: Allocating memory259316 -Node: Embedding SCM261646 -Node: Callbacks269411 -Node: Type Conversions271232 -Node: Continuations275281 -Node: Evaluation279519 -Node: Program Self-Knowledge284702 -Node: File-System Habitat284956 -Node: Executable Pathname288569 -Node: Script Support290242 -Node: Improvements To Make291577 -Node: VMS Dynamic Linking293795 -Node: Index298508 +Node: Top1723 +Node: Overview3323 +Node: SCM Features3638 +Node: SCM Authors5713 +Node: Copying6614 +Node: The SCM License6943 +Node: SIOD copyright10867 +Node: Bibliography12253 +Node: Installing SCM14129 +Node: Making SCM14648 +Node: SLIB15573 +Node: Building SCM17489 +Node: Invoking Build18071 +Node: Build Options20408 +Node: Compiling and Linking Custom Files34079 +Node: Installing Dynamic Linking36075 +Node: Configure Module Catalog37861 +Node: Saving Images39869 +Node: Automatic C Preprocessor Definitions42952 +Node: Problems Compiling46727 +Node: Problems Linking48388 +Node: Problems Running48661 +Node: Testing50779 +Node: Reporting Problems54096 +Node: Operational Features54948 +Node: Invoking SCM55344 +Node: SCM Options57078 +Node: Invocation Examples61447 +Node: SCM Variables62407 +Node: SCM Session63887 +Node: Editing Scheme Code65418 +Node: Debugging Scheme Code67436 +Node: Debugging Continuations71888 +Node: Errors74448 +Node: Memoized Expressions78766 +Node: Internal State81130 +Node: Scripting84409 +Node: Unix Scheme Scripts84713 +Node: MS-DOS Compatible Scripts87745 +Node: Unix Shell Scripts89600 +Node: The Language91741 +Node: Standards Compliance92363 +Node: Storage94786 +Node: Time97266 +Node: Interrupts98282 +Node: Process Synchronization101915 +Node: Files and Ports103444 +Node: Opening and Closing103785 +Node: Port Properties106276 +Node: Port Redirection108962 +Node: Soft Ports110454 +Node: Eval and Load112236 +Node: Line Numbers113652 +Node: Lexical Conventions116075 +Node: Common-Lisp Read Syntax116337 +Node: Load Syntax118369 +Node: Documentation and Comments118989 +Node: Modifying Read Syntax120213 +Node: Syntax121936 +Node: Define and Set122840 +Node: Defmacro126374 +Node: Syntax-Rules127454 +Node: Macro Primitives129260 +Node: Environment Frames130899 +Node: Syntactic Hooks for Hygienic Macros133319 +Node: Packages140293 +Node: Dynamic Linking141173 +Node: Dump145848 +Node: Numeric149869 +Node: Arrays152669 +Node: Conventional Arrays152887 +Node: Uniform Array156426 +Node: Bit Vectors161238 +Node: Array Mapping162546 +Node: Records165240 +Node: I/O-Extensions166112 +Node: Posix Extensions174744 +Node: Unix Extensions184296 +Node: Sequence Comparison186197 +Node: Regular Expression Pattern Matching186527 +Node: Line Editing190505 +Node: Curses191866 +Node: Output Options Setting192801 +Node: Terminal Mode Setting195468 +Node: Window Manipulation198569 +Node: Output202054 +Node: Input205706 +Node: Curses Miscellany206750 +Node: Sockets208191 +Node: Host and Other Inquiries208554 +Node: Internet Addresses and Socket Names211695 +Node: Socket213268 +Node: SCMDB220501 +Node: The Implementation220739 +Node: Data Types221002 +Node: Immediates221831 +Node: Cells226213 +Node: Header Cells228331 +Node: Subr Cells232539 +Node: Ptob Cells234935 +Node: Smob Cells236504 +Node: Data Type Representations239806 +Node: Operations244944 +Node: Garbage Collection245538 +Node: Marking Cells246171 +Node: Sweeping the Heap248311 +Node: Memory Management for Environments249273 +Node: Signals253842 +Node: C Macros255403 +Node: Changing Scm256540 +Node: Defining Subrs261011 +Node: Defining Smobs262871 +Node: Defining Ptobs265928 +Node: Allocating memory267117 +Node: Embedding SCM269447 +Node: Callbacks277161 +Node: Type Conversions278982 +Node: Continuations283031 +Node: Evaluation287269 +Node: Program Self-Knowledge292452 +Node: File-System Habitat292706 +Node: Executable Pathname296319 +Node: Script Support297957 +Node: Improvements To Make299292 +Node: VMS Dynamic Linking301510 +Node: Index306223 End Tag Table @@ -1,5 +1,5 @@ %define name scm -%define version 5e2 +%define version 5e3 %define release 1 %define implpath %{prefix}/lib/scm %define slibpath %{prefix}/lib/slib @@ -10,15 +10,15 @@ Name: %{name} Release: %{release} Version: %{version} -Packager: Radey Shouman <shouman@ne.mediaone.net> +Packager: Aubrey Jaffer <agj @ alum.mit.edu> -Copyright: GPL +License: GPL Vendor: Aubrey Jaffer <agj @ alum.mit.edu> Group: Development/Languages Provides: scm Requires: slib -Summary: SCM Scheme implementation. +Summary: SCM Scheme implementation Source: ftp://swiss.csail.mit.edu/pub/scm/scm%{version}.zip URL: http://swiss.csail.mit.edu/~jaffer/SCM BuildRoot: %{_tmppath}/%{name}%{version} @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @c %**start of header @setfilename scm.info -@settitle SCM +@settitle scm @include version.txi @setchapternewpage on @c Choices for setchapternewpage are {on,off,odd}. @@ -10,6 +10,31 @@ @syncodeindex ft tp @c %**end of header +@copying +@noindent +This manual is for SCM (version @value{SCMVERSION}, @value{SCMDATE}), +and algorithmic language Scheme implementation. + +@noindent +Copyright @copyright{} 1990-2006 Free Software Foundation, Inc. + +@quotation +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided that the entire +resulting derived work is distributed under the terms of a permission +notice identical to this one. + +Permission is granted to copy and distribute translations of this manual +into another language, under the above conditions for modified versions, +except that this permission notice may be stated in a translation approved +by the author. +@end quotation +@end copying + @dircategory The Algorithmic Language Scheme @direntry * SCM: (scm). A Scheme interpreter. @@ -26,61 +51,19 @@ @title SCM @subtitle Scheme Implementation @subtitle Version @value{SCMVERSION} -@author by Aubrey Jaffer - +@author Aubrey Jaffer @page @vskip 0pt plus 1filll -Copyright @copyright{} 1990-1999 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by the author. +@insertcopying @end titlepage -@node Top, Overview, (dir), (dir) - - -@ifinfo -This manual documents the SCM Scheme implementation. SCM version -@value{SCMVERSION} was released @value{SCMDATE}. 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} - - -Copyright (C) 1990-1999 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). +@contents -@end ignore -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. +@ifnottex +@node Top, Overview, (dir), (dir) +@top SCM -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by the author. -@end ifinfo +@insertcopying @menu * Overview:: @@ -91,6 +74,7 @@ by the author. * The Implementation:: How it works. * Index:: @end menu +@end ifnottex @node Overview, Installing SCM, Top, Top @chapter Overview @@ -150,7 +134,7 @@ and @code{eval}. @item @code{Char-code-limit}, @code{most-positive-fixnum}, @code{most-negative-fixnum}, @code{and internal-time-units-per-second} -constants. @code{*Features*} and @code{*load-pathname*} variables. +constants. @code{slib:features} and @code{*load-pathname*} variables. @item Arrays and bit-vectors. String ports and software emulation ports. I/O extensions providing ANSI C and POSIX.1 facilities. @@ -293,7 +277,7 @@ OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. @subsection SIOD copyright @sp 1 -@center COPYRIGHT (c) 1989 BY +@center COPYRIGHT @copyright{} 1989 BY @center PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. @center ALL RIGHTS RESERVED @@ -533,34 +517,34 @@ low priority. SLIB is available from the same sites as SCM: @ifclear html @itemize @bullet @item -swiss.csail.mit.edu:/pub/scm/slib3a3.tar.gz +swiss.csail.mit.edu:/pub/scm/slib3a4.tar.gz @item -ftp.gnu.org:/pub/gnu/jacal/slib3a3.tar.gz +ftp.gnu.org:/pub/gnu/jacal/slib3a4.tar.gz @item -ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a3.tar.gz +ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a4.tar.gz @end itemize @end ifclear @ifset html @itemize @bullet @item -<A HREF="http://swiss.csail.mit.edu/ftpdir/scm/slib3a3.zip"> -http://swiss.csail.mit.edu/ftpdir/scm/slib3a3.zip +<A HREF="http://swiss.csail.mit.edu/ftpdir/scm/slib3a4.zip"> +http://swiss.csail.mit.edu/ftpdir/scm/slib3a4.zip </A> @item -<A HREF="ftp://ftp.gnu.org/pub/gnu/jacal/slib3a3.tar.gz"> -ftp.gnu.org:/pub/gnu/jacal/slib3a3.tar.gz +<A HREF="ftp://ftp.gnu.org/pub/gnu/jacal/slib3a4.tar.gz"> +ftp.gnu.org:/pub/gnu/jacal/slib3a4.tar.gz </A> @item -<A HREF="ftp://ftp.cs.indiana.edu/pub/scheme-repository/code/lib/slib3a3.tar.gz"> -ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib3a3.tar.gz +<A HREF="ftp://ftp.cs.indiana.edu/pub/scheme-repository/code/lib/slib3a4.tar.gz"> +ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib3a4.tar.gz </A> @end itemize @end ifset @noindent -Unpack SLIB (@samp{tar xzf slib3a3.tar.gz} or @samp{unzip -ao -slib3a3.zip}) in an appropriate directory for your system; both +Unpack SLIB (@samp{tar xzf slib3a4.tar.gz} or @samp{unzip -ao +slib3a4.zip}) in an appropriate directory for your system; both @code{tar} and @code{unzip} will create the directory @file{slib}. @noindent @@ -598,6 +582,8 @@ absolute pathnames are recommended. @node Building SCM, Installing Dynamic Linking, SLIB, 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. @file{build.scm} has information for the platforms which SCM has been @@ -1022,20 +1008,51 @@ Remember to delete the file @file{slibcat} after modifying the file @node Saving Images, Automatic C Preprocessor Definitions, Configure Module Catalog, Installing SCM @section Saving Images -@noindent 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 with feature @samp{dump}. @code{dump}ed executables are compatible with dynamic linking. -@noindent Most of the code for @dfn{dump} is taken from @file{emacs-19.34/src/unex*.c}. No modifications to the emacs source code were required to use @file{unexelf.c}. Dump has not been ported to all platforms. If @file{unexec.c} or @file{unexelf.c} don't work for you, try using the appropriate @file{unex*.c} file from emacs. +The @samp{dscm4} and @samp{dscm5} targets in the SCM @file{Makefile} +save images from @file{udscm4} and @file{udscm5} executables +respectively. + +Recent Linux innovations interfere with @code{dump}. For: + +@table @asis +@item Fedora-Core-1 +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: +[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 @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} +mentions the @dfn{exec-shield} feature. Kernels later than 2.6.11 +must do (as root): + +@example +echo 0 > /proc/sys/kernel/randomize_va_space +@end example + +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. +@end table @node Automatic C Preprocessor Definitions, Problems Compiling, Saving Images, Installing SCM @section Automatic C Preprocessor Definitions @@ -1298,8 +1315,10 @@ tracking effects of changes to SCM on performance. @tab Check character defines in @file{scmfig.h}. @item Negative numbers turn positive. @tab Check SRS in @file{scmfig.h}. +@item ;ERROR: bignum: numerical overflow +@tab Increase NUMDIGS_MAX in @file{scmfig.h} and recompile. @item VMS: Couldn't unwind stack. -@tab @t{#define CHEAP_CONTIUATIONS} in @file{scmfig.h}. +@tab @t{#define CHEAP_CONTINUATIONS} in @file{scmfig.h}. @item VAX: botched longjmp. @end multitable @@ -1391,10 +1410,11 @@ compile parameter @var{IMPLINIT} (defined in the makefile or @noindent Unless the option @code{-no-init-file} or @code{--no-init-file} occurs -in the command line, @file{Init@value{SCMVERSION}.scm} checks to see if -there is file @file{ScmInit.scm} in the path specified by the -environment variable @var{HOME} (or in the current directory if -@var{HOME} is undefined). If it finds such a file it is loaded. +in the command line, or if @code{scm} is being invoked as a script, +@file{Init@value{SCMVERSION}.scm} checks to see if there is file +@file{ScmInit.scm} in the path specified by the environment variable +@var{HOME} (or in the current directory if @var{HOME} is undefined). +If it finds such a file, then it is loaded. @noindent @file{Init@value{SCMVERSION}.scm} then looks for command input from one @@ -1721,8 +1741,8 @@ After editing, the modified file will be loaded. @section Debugging Scheme Code @noindent -The @code{cautious} and @code{stack-limit} options of @code{build} -(@pxref{Build Options}) support debugging in Scheme. +The @code{cautious} option of @code{build} +(@pxref{Build Options}) supports debugging in Scheme. @table @dfn @item CAUTIOUS @@ -1742,18 +1762,14 @@ program execution can be resumed by @code{(continue)}. In this configuration one can interrupt a running Scheme program with @key{C-c}, inspect or modify top-level values, trace or untrace procedures, and continue execution with @code{(continue)}. - -@item STACK_LIMIT -If SCM is built with the @samp{STACK_LIMIT} flag, the interpreter will -check stack size periodically. If the size of stack exceeds a certain -amount (default is @code{HEAP_SEG_SIZE/2}), SCM generates a -@code{segment violation} interrupt. - -The usefulness of @samp{STACK_LIMIT} depends on the user. I don't use -it; but the user I added this feature for got primarily this type of -error. @end table +If @code{verbose} (@pxref{Internal State, verbose}) is called with an +argument greater than 2, then the interpreter will check stack size +periodically. If the size of stack in use exceeds the C #define +@code{STACK_LIMIT} (default is @code{HEAP_SEG_SIZE}), SCM generates a +@samp{stack} @code{segment violation}. + @noindent There are several SLIB macros which so useful that SCM automatically loads the appropriate module from SLIB if they are invoked. @@ -2191,7 +2207,8 @@ a prompt is printed. messages bracketing file loading are printed. @item >= 3 the CPU time is printed after each top level form evaluated; -notifications of heap growth printed. +notifications of heap growth printed; the interpreter checks stack +depth periodically. @item >= 4 a garbage collection summary is printed after each top level form evaluated; @@ -3240,14 +3257,13 @@ combined. @end deffn @deffn {Read syntax} #+ feature form -If feature is @code{provided?} (by @code{*features*}) then @var{form} is -read as a scheme expression. If not, then @var{form} is treated as -whitespace. +If feature is @code{provided?} then @var{form} is read as a scheme +expression. If not, then @var{form} is treated as whitespace. Feature is a boolean expression composed of symbols and @code{and}, @code{or}, and @code{not} of boolean expressions. -For more information on @code{provided?} and @code{*features*}, +For more information on @code{provided?}, @xref{Require, , , slib, SLIB}. @end deffn @@ -4230,29 +4246,28 @@ Return the hyperbolic sine, cosine, and tangent of @var{z} Return the inverse hyperbolic sine, cosine, and tangent of @var{z} @end defun -@defun $sqrt x -@defunx $abs x -@defunx $exp x -@defunx $log x -@defunx $sin x -@defunx $cos x -@defunx $tan x -@defunx $asin x -@defunx $acos x -@defunx $atan x - -@defunx $sinh x -@defunx $cosh x -@defunx $tanh x -@defunx $asinh x -@defunx $acosh x -@defunx $atanh x +@defun real-sqrt x +@defunx real-exp x +@defunx real-ln x +@defunx real-sin x +@defunx real-cos x +@defunx real-tan x +@defunx real-asin x +@defunx real-acos x +@defunx real-atan x + +@defunx real-sinh x +@defunx real-cosh x +@defunx real-tanh x +@defunx real-asinh x +@defunx real-acosh x +@defunx real-atanh x Real-only versions of these popular functions. The argument @var{x} must be a real number. It is an error if the value which should be returned by a call to these procedures is @emph{not} real. @end defun -@defun $log10 x +@defun real-log10 x Real-only base 10 logarithm. @end defun @@ -4261,9 +4276,9 @@ Computes @code{(angle (make-rectangular x y))} for real numbers @var{y} and @var{x}. @end defun -@defun $expt x1 x2 +@defun real-expt x1 x2 Returns real number @var{x1} raised to the real power @var{x2}. It is -an error if the value which should be returned by a call to @code{$expt} +an error if the value which should be returned by a call to @code{real-expt} is not real. @end defun @@ -6602,31 +6617,43 @@ the elements of string @var{x} or its length, respectively. @end defmac @end deftp -@deftp Header tc7_bvect +@deftp Header tc7_Vbool uniform vector of booleans (bit-vector) @end deftp -@deftp Header tc7_ivect +@deftp Header tc7_VfixZ32 uniform vector of integers @end deftp -@deftp Header tc7_uvect +@deftp Header tc7_VfixN32 uniform vector of non-negative integers @end deftp -@deftp Header tc7_svect +@deftp Header tc7_VfixN16 +uniform vector of non-negative short integers +@end deftp + +@deftp Header tc7_VfixZ16 uniform vector of short integers @end deftp -@deftp Header tc7_fvect +@deftp Header tc7_VfixN8 +uniform vector of non-negative bytes +@end deftp + +@deftp Header tc7_VfixZ8 +uniform vector of signed bytes +@end deftp + +@deftp Header tc7_VfloR32 uniform vector of short inexact real numbers @end deftp -@deftp Header tc7_dvect +@deftp Header tc7_VfloR64 uniform vector of double precision inexact real numbers @end deftp -@deftp Header tc7_cvect +@deftp Header tc7_VfloC64 uniform vector of double precision inexact complex numbers @end deftp @@ -6692,10 +6719,10 @@ These subrs are handled specially. If inexact numbers are enabled, the @code{double}. Conversions are handled in the interpreter. @code{floor}, @code{ceiling}, @code{truncate}, @code{round}, -@code{$sqrt}, @code{$abs}, @code{$exp}, @code{$log}, @code{$sin}, -@code{$cos}, @code{$tan}, @code{$asin}, @code{$acos}, @code{$atan}, -@code{$sinh}, @code{$cosh}, @code{$tanh}, @code{$asinh}, @code{$acosh}, -@code{$atanh}, and @code{exact->inexact} are defined this way. +@code{real-sqrt}, @code{real-exp}, @code{real-ln}, @code{real-sin}, +@code{real-cos}, @code{real-tan}, @code{real-asin}, @code{real-acos}, @code{real-atan}, +@code{real-sinh}, @code{real-cosh}, @code{real-tanh}, @code{real-asinh}, @code{real-acosh}, +@code{real-atanh}, and @code{exact->inexact} are defined this way. If the @code{CDR} is @code{0} (@code{NULL}), the name string of the procedure is used to control traversal of its list structure argument. @@ -6914,8 +6941,8 @@ as elements @pxref{Conventional Arrays}) and uniform arrays (those with elements of a uniform type @pxref{Uniform Array}). Conventional Arrays have a pointer to a vector for their @code{CDR}. -Uniform Arrays have a pointer to a Uniform Vector type (string, bvect, -ivect, uvect, fvect, dvect, or cvect) in their @code{CDR}. +Uniform Arrays have a pointer to a Uniform Vector type (string, Vbool, +VfixZ32, VfixN32, VfloR32, VfloR64, or VfloC64) in their @code{CDR}. @end deftp @@ -6945,33 +6972,35 @@ ssymbol .........long length....G0000101 ..........char *chars........... msymbol .........long length....G0000111 ..........char *chars........... string .........long length....G0001101 ..........char *chars........... vector .........long length....G0001111 ...........SCM **elts........... -bvect .........long length....G0010101 ..........long *words........... - spare G0010111 -ivect .........long length....G0011101 ..........long *words........... -uvect .........long length....G0011111 ......unsigned long *words...... - spare G0100101 -svect .........long length....G0100111 ........ short *words........... -fvect .........long length....G0101101 .........float *words........... -dvect .........long length....G0101111 ........double *words........... -cvect .........long length....G0110101 ........double *words........... - -contin .........long length....G0111101 .............*regs.............. -specfun ................xxxxxxxxG1111111 ...........SCM name............. -cclo ..short length..xxxxxx10G1111111 ...........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........... +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 +contin .........long length....G1001101 .............*regs.............. +specfun ................xxxxxxxxG1001111 ...........SCM name............. +cclo ..short length..xxxxxx10G1001111 ...........SCM **elts...........} @r{ PTOBs@:} -@t{ port int portnum.CwroxxxxxxxxG0110111 ..........FILE *stream.......... - socket int portnum.C001xxxxxxxxG0110111 ..........FILE *stream.......... - inport int portnum.C011xxxxxxxxG0110111 ..........FILE *stream.......... -outport int portnum.0101xxxxxxxxG0110111 ..........FILE *stream.......... - ioport int portnum.C111xxxxxxxxG0110111 ..........FILE *stream.......... -fport int portnum.C 00000000G0110111 ..........FILE *stream.......... -pipe int portnum.C 00000001G0110111 ..........FILE *stream.......... -strport 00000000000.0 00000010G0110111 ..........FILE *stream.......... -sfport int portnum.C 00000011G0110111 ..........FILE *stream..........} +@t{ port int portnum.CwroxxxxxxxxG1000111 ..........FILE *stream.......... + socket int portnum.C001xxxxxxxxG1000111 ..........FILE *stream.......... + inport int portnum.C011xxxxxxxxG1000111 ..........FILE *stream.......... +outport int portnum.0101xxxxxxxxG1000111 ..........FILE *stream.......... + ioport int portnum.C111xxxxxxxxG1000111 ..........FILE *stream.......... +fport int portnum.C 00000000G1000111 ..........FILE *stream.......... +pipe int portnum.C 00000001G1000111 ..........FILE *stream.......... +strport 00000000000.0 00000010G1000111 ..........FILE *stream.......... +sfport int portnum.C 00000011G1000111 ..........FILE *stream..........} @r{ SUBRs@:} -@t{ spare 010001x1 - spare 010011x1 -subr_0 ..........int hpoff.....01010101 ...........SCM (*f)()........... +@t{subr_0 ..........int hpoff.....01010101 ...........SCM (*f)()........... subr_1 ..........int hpoff.....01010111 ...........SCM (*f)()........... cxr ..........int hpoff.....01011101 .........double (*f)().......... subr_3 ..........int hpoff.....01011111 ...........SCM (*f)()........... @@ -7066,7 +7095,7 @@ unmarked, gc_mark sets the mark bit in @var{obj}, then calls @code{gc_mark()} is tail-called (looped). @end deftypefun -@deftypefun void mark_locations (STACKITEM @var{x}[], sizet @var{len})) +@deftypefun void mark_locations (STACKITEM @var{x}[], sizet @var{len}) The function @code{mark_locations} is used for marking segments of C-stack or saved segments of C-stack (marked continuations). The argument @var{len} is the size of the stack in units of size @@ -7424,7 +7453,7 @@ add_feature("@i{foo}"); @end example will append a symbol @code{'@i{foo}} to the (list) value of -@code{*features*}. +@code{slib:features}. @item put any scheme code which needs to be run as part of your package into @file{I@i{foo}.scm}. @@ -8637,33 +8666,10 @@ that have been linked against it. @end enumerate - +@ifinfo @node Index, , The Implementation, Top -@c @node Procedure and Macro Index, Variable Index, The Implementation, Top -@unnumbered Procedure and Macro Index - -This is an alphabetical list of all the procedures and macros in SCM. - -@printindex fn - -@c @node Variable Index, Type Index, Procedure and Macro Index, Top -@unnumbered Variable Index - -This is an alphabetical list of all the global variables in SCM. - -@printindex vr - -@c @node Type Index, , Variable Index, Top -@unnumbered Type Index - -This is an alphabetical list of data types and feature names in SCM. - -@printindex tp - -This is an alphabetical list of concepts introduced in this manual. - -@unnumbered Concept Index -@printindex cp +@unnumbered Index +@end ifinfo -@contents +@include indexes.texi @bye @@ -122,8 +122,6 @@ rgx.c init_rgx(); regcomp and regexec. */ /* #define CAUTIOUS */ -/* #define STACK_LIMIT (HEAP_SEG_SIZE/2) */ - /* #define BIGNUMS */ /* #define ARRAYS */ @@ -192,7 +190,6 @@ rgx.c init_rgx(); regcomp and regexec. */ /* Define GC_FREE_SEGMENTS if you want segments of unused heap to be freed up after garbage collection. Don't define it if you never want the heap to shrink. */ - #ifndef DONT_GC_FREE_SEGMENTS # define GC_FREE_SEGMENTS #endif @@ -200,8 +197,10 @@ rgx.c init_rgx(); regcomp and regexec. */ /* MEMOIZE_LOCALS means to convert references to local variables to ILOCs, (relative lexical addresses into the environment). This memoization makes evaluated Scheme code harder to read, so you may want to undefine - this flag for debugging -- but SCM will run 3 to 5 times slower */ -#define MEMOIZE_LOCALS + this flag for debugging -- but SCM will run 3 to 6 times slower */ +#ifndef DONT_MEMOIZE_LOCALS +# define MEMOIZE_LOCALS +#endif /* #define CHEAP_CONTINUATIONS */ @@ -281,7 +280,7 @@ rgx.c init_rgx(); regcomp and regexec. */ #ifdef __alpha # define SHORT_INT #endif -#ifdef __ia64 +#ifdef __ia64__ # define SHORT_INT # define CDR_DOUBLES #endif @@ -521,12 +520,12 @@ extern ints_infot *ints_info; # endif #endif -#ifdef STACK_LIMIT -# define CHECK_STACK {stack_check();} -#else -# define CHECK_STACK /**/ +#ifndef STACK_LIMIT +# define STACK_LIMIT (HEAP_SEG_SIZE) #endif +#define CHECK_STACK {if (2 < scm_verbose) stack_check();} + /* Cray machines have pointers that are incremented once for each word, rather than each byte, the 3 most significant bits encode the byte within the word. The following macros deal with this by storing the diff --git a/setjump.mar b/setjump.mar index 2b49243..3fc223c 100644 --- a/setjump.mar +++ b/setjump.mar @@ -1,10 +1,11 @@ .title setjump and longjump -; The VAX C runtime library uses the $unwind utility for implementing -; longjmp. That fails if your program do not follow normal -; stack decipline. This is a dirty implementation of setjmp -; and longjmp that does not have that problem. -; the names longjmp and setjmp are avoided so that the code can be linked -; with the vax c runtime library without name clashes. + +; The VAX C runtime library uses the $unwind utility for +; implementing longjmp. That fails if your program does not +; follow normal stack decipline. This is a dirty implementation +; of setjmp and longjmp that does not have that problem. The +; names longjmp and setjmp are avoided so that the code can be +; linked with the vax c runtime library without name clashes. ; This code was contributed by an anonymous reviewer from ; comp.sources.reviewed. @@ -1745,13 +1745,14 @@ SCM make_vector(k, fill) return v; } #ifdef BIGDIG +char s_big_OVFLOW[] = "numerical overflow; NUMDIGS_MAX <"; char s_bignum[] = "bignum"; SCM mkbig(nlen, sign) sizet nlen; int sign; { SCM v; - if (NUMDIGS_MAX <= nlen) wta(MAKINUM(nlen), (char *)NALLOC, s_bignum); + if (NUMDIGS_MAX <= nlen) wta(MAKINUM(nlen), s_big_OVFLOW, s_bignum); DEFER_INTS; v = must_malloc_cell((0L+nlen)*sizeof(BIGDIG), MAKE_NUMDIGS(nlen, sign ? tc16_bigneg : tc16_bigpos), @@ -1779,7 +1780,7 @@ SCM adjbig(b, nlen) { long nsiz = nlen; if (((nsiz << 16) >> 16) != nlen) - wta(MAKINUM(nsiz), (char *)NALLOC, s_adjbig); + wta(MAKINUM(nsiz), s_big_OVFLOW, s_adjbig); DEFER_INTS; must_realloc_cell(b, (long)(NUMDIGS(b)*sizeof(BIGDIG)), (long)(nsiz*sizeof(BIGDIG)), s_adjbig); @@ -50,7 +50,7 @@ # include <io.h> #endif -void igc P((const char *what, STACKITEM *stackbase)); +void igc P((const char *what, SCM basecont)); void lfflush P((SCM port)); /* internal SCM call */ SCM *loc_open_file; /* for open-file callback */ SCM *loc_try_create_file; @@ -1264,7 +1264,7 @@ static char *igc_for_alloc(where, olen, size, what) /* Check to see that heap is initialized */ ASRTER(heap_cells > 0, MAKINUM(size), NALLOC, what); /* printf("igc_for_alloc(%lx, %lu, %u, %s)\n", where, olen, size, what); fflush(stdout); */ - igc(what, CONT(rootcont)->stkbse); + igc(what, rootcont); nm = mallocated + size - olen; if (nm > mltrigger) { if (nm > mtrigger) grew_lim(nm + nm/2); @@ -1574,22 +1574,21 @@ SCM makcclo(proc, len) } #endif -#ifdef STACK_LIMIT void stack_check() { STACKITEM *start = CONT(rootcont)->stkbse; STACKITEM stack; -# ifdef STACK_GROWS_UP +#ifdef STACK_GROWS_UP if (&stack - start > STACK_LIMIT/sizeof(STACKITEM)) -# else +#else if (start - &stack > STACK_LIMIT/sizeof(STACKITEM)) -# endif /* def STACK_GROWS_UP */ +#endif /* def STACK_GROWS_UP */ { stack_report(); wta(UNDEFINED, (char *)SEGV_SIGNAL, "stack"); } } -#endif + void stack_report() { STACKITEM stack; @@ -2029,7 +2028,7 @@ SCM scm_port_entry(stream, ptype, flags) } } else { - igc(s_port_table, CONT(rootcont)->stkbse); + igc(s_port_table, rootcont); for (i = 0; i < scm_port_table_len; i++) if (0L==scm_port_table[i].flags) goto ret; wta(UNDEFINED, s_nogrow, s_port_table); @@ -2249,7 +2248,7 @@ SCM gc_for_newcell() SCM fl; int oints = ints_disabled; /* Temporary expedient */ if (!oints) ints_disabled = 1; - igc(s_cells, CONT(rootcont)->stkbse); + igc(s_cells, rootcont); if ((gc_cells_collected < MIN_GC_YIELD) || IMP(freelist)) { alloc_some_heap(); growth_mon(s_numheaps, (long)(hplim_ind/2), s_segs, !0); @@ -2264,13 +2263,13 @@ SCM gc_for_newcell() void gc_for_open_files() { - igc("open files", CONT(rootcont)->stkbse); + igc("open files", rootcont); } void scm_fill_freelist() { while IMP(freelist) { - igc(s_cells, CONT(rootcont)->stkbse); + igc(s_cells, rootcont); if ((gc_cells_collected < MIN_GC_YIELD) || IMP(freelist)) { alloc_some_heap(); growth_mon(s_numheaps, (long)(hplim_ind/2), s_segs, !0); @@ -2280,7 +2279,6 @@ void scm_fill_freelist() } static char s_bad_type[] = "unknown type in "; -jump_buf save_regs_gc_mark; void mark_locations P((STACKITEM x[], sizet n)); static void mark_syms P((SCM v)); static void mark_sym_values P((SCM v)); @@ -2297,7 +2295,7 @@ SCM gc(arg) { DEFER_INTS; if (UNBNDP(arg)) - igc("call", CONT(rootcont)->stkbse); + igc("call", rootcont); else scm_egc(); ALLOW_INTS; @@ -2346,12 +2344,13 @@ void scm_gc_hook () gc_hook_active = 0; } -void igc(what, stackbase) +void igc(what, basecont) const char *what; - STACKITEM *stackbase; + SCM basecont; { int j = num_protects; long oheap_cells = heap_cells; + STACKITEM * stackbase = IMP(basecont) ? 0 : CONT(basecont)->stkbse; #ifdef DEBUG_GMALLOC int err = check_frag_blocks(); if (err) wta(MAKINUM(err), "malloc corrupted", what); @@ -2373,6 +2372,10 @@ void igc(what, stackbase) mark_subrs(); egc_mark(); if (stackbase) { +#ifdef __ia64__ + mark_regs_ia64(CONT(basecont)); +#else + jump_buf save_regs_gc_mark; FLUSH_REGISTER_WINDOWS; /* This assumes that all registers are saved into the jump_buf */ setjump(save_regs_gc_mark); @@ -2382,22 +2385,23 @@ void igc(what, stackbase) { /* stack_len is long rather than sizet in order to guarantee that &stack_len is long aligned */ -#ifdef STACK_GROWS_UP -# ifdef nosve +# ifdef STACK_GROWS_UP +# ifdef nosve long stack_len = (STACKITEM *)(&stack_len) - stackbase; -# else +# else long stack_len = stack_size(stackbase); -# endif +# endif mark_locations(stackbase, (sizet)stack_len); -#else -# ifdef nosve - long stack_len = stackbase - (STACKITEM *)(&stack_len); # else +# ifdef nosve + long stack_len = stackbase - (STACKITEM *)(&stack_len); +# else long stack_len = stack_size(stackbase); -# endif +# endif mark_locations((stackbase - stack_len), (sizet)stack_len); -#endif +# endif } +#endif } while(j--) gc_mark(sys_protects[j]); @@ -2556,13 +2560,12 @@ void gc_mark(p) ASRTER(!(CHARS(ptr)[HUGE_LENGTH(ptr)]), MAKINUM(HUGE_LENGTH(ptr)), s_wrong_length, s_gc); case tc7_ssymbol: - case tc7_bvect: - case tc7_ivect: - case tc7_uvect: - case tc7_svect: - case tc7_fvect: - case tc7_dvect: - case tc7_cvect: + 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; @@ -2679,28 +2682,38 @@ static void gc_sweep(contin_bad) must_free(CHARS(scmptr), minc); /* SETCHARS(scmptr, 0);*/ break; - case tc7_bvect: + case tc7_Vbool: if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = sizeof(long)*((HUGE_LENGTH(scmptr)+LONG_BIT-1)/LONG_BIT); goto freechars; - case tc7_ivect: - case tc7_uvect: + case tc7_VfixZ32: + case tc7_VfixN32: if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*sizeof(long); goto freechars; - case tc7_svect: + case tc7_VfixN8: + case tc7_VfixZ8: + if (GC8MARKP(scmptr)) goto c8mrkcontinue; + minc = HUGE_LENGTH(scmptr)*sizeof(char); + goto freechars; + case tc7_VfixZ16: + case tc7_VfixN16: if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*sizeof(short); goto freechars; - case tc7_fvect: + case tc7_VfloR32: if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*sizeof(float); goto freechars; - case tc7_dvect: + case tc7_VfloC32: + if (GC8MARKP(scmptr)) goto c8mrkcontinue; + minc = HUGE_LENGTH(scmptr)*2*sizeof(float); + goto freechars; + case tc7_VfloR64: if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*sizeof(double); goto freechars; - case tc7_cvect: + case tc7_VfloC64: if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*2*sizeof(double); goto freechars; @@ -3144,7 +3157,7 @@ void scm_egc() /* We need to make sure there are enough cells available to migrate the entire environment cache, gc does not work properly during ecache gc */ while (egc_need_gc()) { - igc("ecache", CONT(rootcont)->stkbse); + igc("ecache", rootcont); if ((gc_cells_collected < MIN_GC_YIELD) || (heap_cells - cells_allocated <= scm_ecache_len) || IMP(freelist)) { alloc_some_heap(); @@ -101,6 +101,9 @@ # include <sys/types.h> # include <sys/time.h> # include <sys/timeb.h> +# include <sys/times.h> +# include <unistd.h> +# define CLKTCK (sysconf(_SC_CLK_TCK)) # define USE_GETTIMEOFDAY #endif #ifdef __MACH__ @@ -153,8 +156,8 @@ # define LACK_FTIME #endif #ifdef PLAN9 -#define LACK_FTIME -#define LACK_TIMES +# define LACK_FTIME +# define LACK_TIMES #endif #ifdef nosve # define LACK_FTIME @@ -219,30 +222,32 @@ # define LACK_FTIME #endif -#ifdef CLK_TCK -# define CLKTCK CLK_TCK -# ifdef CLOCKS_PER_SEC -# ifdef HAVE_UNIX -# ifndef ARM_ULIB -# include <sys/times.h> -# endif -# define LACK_CLOCK +#ifndef CLKTCK +# ifdef CLK_TCK +# define CLKTCK CLK_TCK +# ifdef CLOCKS_PER_SEC +# ifdef HAVE_UNIX +# ifndef ARM_ULIB +# include <sys/times.h> +# endif +# define LACK_CLOCK /* This is because clock() might be POSIX rather than ANSI. This occurs on HP-UX machines */ +# endif # endif -# endif -#else -# ifdef CLOCKS_PER_SEC -# define CLKTCK CLOCKS_PER_SEC # else -# define LACK_CLOCK -# ifdef AMIGA -# include <stddef.h> -# define LACK_TIMES -# define LACK_FTIME -# define CLKTCK 1000 +# ifdef CLOCKS_PER_SEC +# define CLKTCK CLOCKS_PER_SEC # else -# define CLKTCK 60 +# define LACK_CLOCK +# ifdef AMIGA +# include <stddef.h> +# define LACK_TIMES +# define LACK_FTIME +# define CLKTCK 1000 +# else +# define CLKTCK 60 +# endif # endif # endif #endif diff --git a/ugsetjump.s b/ugsetjump.s new file mode 100644 index 0000000..e9e29f4 --- /dev/null +++ b/ugsetjump.s @@ -0,0 +1,35 @@ +#NO_APP +.text + .align 1 +.globl _setjump +_setjump: + .word 0x0 + movl 4(ap),r0 + movq r2,(r0)+ + movq r4,(r0)+ + movq r6,(r0)+ + movq r8,(r0)+ + movq r10,(r0)+ + movl fp,(r0)+ + movo 4(fp),(r0)+ + movq 20(fp),(r0) + clrl r0 + ret + ret + .align 1 +.globl _longjump +_longjump: + .word 0x0 + movl 4(ap),r0 + movq (r0)+,r2 + movq (r0)+,r4 + movq (r0)+,r6 + movq (r0)+,r8 + movq (r0)+,r10 + movl (r0)+,r1 + movo (r0)+,4(r1) + movq (r0),20(r1) + movl 8(ap),r0 + movl r1,fp + ret + ret @@ -45,12 +45,13 @@ The set of uniform vector types is: Vector of: Called: char string -boolean bvect -signed int ivect -unsigned int uvect -float fvect -double dvect -complex double cvect +boolean Vbool +signed int VfixZ32 +unsigned int VfixN32 +float VfloR32 +complex float VfloC32 +double VfloR64 +complex double VfloC64 */ #include "scm.h" @@ -85,24 +86,32 @@ SCM resizuve(vect, len) sz = sizeof(SCM); break; #ifdef ARRAYS - case tc7_bvect: + case tc7_Vbool: ol = (ol+LONG_BIT-1)/LONG_BIT; l = (l+LONG_BIT-1)/LONG_BIT; - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: sz = sizeof(long); break; - case tc7_svect: + case tc7_VfixN16: + case tc7_VfixZ16: sz = sizeof(short); break; + case tc7_VfixN8: + case tc7_VfixZ8: + sz = sizeof(char); + break; # ifdef FLOATS - case tc7_fvect: + case tc7_VfloR32: sz = sizeof(float); break; - case tc7_dvect: + case tc7_VfloC32: + sz = 2*sizeof(float); + break; + case tc7_VfloR64: sz = sizeof(double); break; - case tc7_cvect: + case tc7_VfloC64: sz = 2*sizeof(double); break; # endif @@ -150,24 +159,24 @@ long scm_prot2type(prot) { if (ICHRP(prot)) return tc7_string; switch (prot) { - case BOOL_T: return tc7_bvect; - case MAKINUM(8L): - case MAKINUM(16L): - case MAKINUM(32L): return tc7_uvect; - case MAKINUM(-32L): return tc7_ivect; - case MAKINUM(-16L): return tc7_svect; - case MAKINUM(-8L): return tc7_svect; - } - /* if (INUMP(prot)) return INUM(prot) > 0 ? tc7_uvect : tc7_ivect; */ + case BOOL_T: return tc7_Vbool; + case MAKINUM(8L): return tc7_VfixN8; + case MAKINUM(16L): return tc7_VfixN16; + case MAKINUM(32L): return tc7_VfixN32; + case MAKINUM(-32L): return tc7_VfixZ32; + case MAKINUM(-16L): return tc7_VfixZ16; + case MAKINUM(-8L): return tc7_VfixZ8; + } + /* if (INUMP(prot)) return INUM(prot) > 0 ? tc7_VfixN32 : tc7_VfixZ32; */ if (IMP(prot)) return tc7_vector; # ifdef FLOATS if (INEXP(prot)) { double x; - if (CPLXP(prot)) return tc7_cvect; + if (CPLXP(prot)) return (32.0==IMAG(prot)) ? tc7_VfloC32 : tc7_VfloC64; x = REALPART(prot); - if (32.0==x) return tc7_fvect; - if (64.0==x) return tc7_dvect; - return tc7_dvect; + if (32.0==x) return tc7_VfloR32; + if (64.0==x) return tc7_VfloR64; + return tc7_VfloR64; } # endif return tc7_vector; @@ -184,26 +193,35 @@ SCM make_uve(k, prot) default: case tc7_vector: /* Huge non-unif vectors are NOT supported. */ return make_vector(MAKINUM(k), UNDEFINED); /* no special vector */ - case tc7_bvect: + case tc7_Vbool: i = sizeof(long)*((k+LONG_BIT-1)/LONG_BIT); break; case tc7_string: i = sizeof(char)*(k + 1); break; - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: i = sizeof(long)*k; break; - case tc7_svect: + case tc7_VfixN16: + case tc7_VfixZ16: i = sizeof(short)*k; + break; + case tc7_VfixN8: + case tc7_VfixZ8: + i = sizeof(char)*k; + break; # ifdef FLOATS - case tc7_fvect: + case tc7_VfloR32: i = sizeof(float)*k; break; - case tc7_dvect: + case tc7_VfloC32: + i = 2*sizeof(float)*k; + break; + case tc7_VfloR64: i = sizeof(double)*k; break; - case tc7_cvect: + case tc7_VfloC64: i = 2*sizeof(double)*k; break; # endif @@ -232,14 +250,18 @@ SCM arrayp(v, prot) if (enclosed++) return BOOL_F; v = ARRAY_V(v); goto loop; - case tc7_bvect: + case tc7_Vbool: case tc7_string: - case tc7_uvect: - case tc7_ivect: - case tc7_svect: - case tc7_fvect: - case tc7_dvect: - case tc7_cvect: + 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; @@ -399,7 +421,7 @@ int rafill(ra, fill, ignore) ve[i] = f; break; } - case tc7_bvect: { + case tc7_Vbool: { long *ve = (long *)VELTS(ra); if (1==inc && (n >= LONG_BIT || n==LENGTH(ra))) { i = base/LONG_BIT; @@ -432,11 +454,11 @@ int rafill(ra, fill, ignore) } break; } - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: { long *ve = VELTS(ra); - long f = (tc7_uvect==TYP7(ra) ? + long f = (tc7_VfixN32==TYP7(ra) ? num2ulong(fill, (char *)ARG2, s_array_fill) : num2long(fill, (char *)ARG2, s_array_fill)); for (i = base; n--; i += inc) @@ -444,21 +466,36 @@ int rafill(ra, fill, ignore) break; } # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *ve = (float *)VELTS(ra); float f = num2dbl(fill, (char *)ARG2, s_array_fill); for (i = base; n--; i += inc) ve[i] = f; break; } - case tc7_dvect: { + case tc7_VfloC32: { + float fr, fi=0.0; + float (*ve)[2] = (float (*)[2])VELTS(ra); + if (NIMP(fill) && CPLXP(fill)) { + fr = REAL(fill); + fi = IMAG(fill); + } + else + fr = num2dbl(fill, (char *)ARG2, s_array_fill); + for (i = base; n--; i += inc) { + ve[i][0] = fr; + ve[i][1] = fi; + } + break; + } + case tc7_VfloR64: { double *ve = (double *)VELTS(ra); double f = num2dbl(fill, (char *)ARG2, s_array_fill); for (i = base; n--; i += inc) ve[i] = f; break; } - case tc7_cvect: { + case tc7_VfloC64: { double fr, fi=0.0; double (*ve)[2] = (double (*)[2])VELTS(ra); if (NIMP(fill) && CPLXP(fill)) { @@ -515,11 +552,12 @@ SCM dims2ura(dims, prot, fill) switch TYP7(make_uve(0L, prot)) { default: bit = LONG_BIT; break; case tc7_vector: wta(dims, (char *)OUTOFRANGE, s_dims2ura); - case tc7_bvect: bit = 1; break; + case tc7_Vbool: bit = 1; break; case tc7_string: bit = CHAR_BIT; break; - case tc7_fvect: bit = sizeof(float)*CHAR_BIT/sizeof(char); break; - case tc7_dvect: bit = sizeof(double)*CHAR_BIT/sizeof(char); break; - case tc7_cvect: bit = 2*sizeof(double)*CHAR_BIT/sizeof(char); break; + case tc7_VfloR32: bit = sizeof(float)*CHAR_BIT/sizeof(char); break; + case tc7_VfloC32: bit = 2*sizeof(float)*CHAR_BIT/sizeof(char); break; + case tc7_VfloR64: bit = sizeof(double)*CHAR_BIT/sizeof(char); break; + case tc7_VfloC64: bit = 2*sizeof(double)*CHAR_BIT/sizeof(char); break; } ARRAY_BASE(ra) = (LONG_BIT + bit - 1)/bit; rlen += ARRAY_BASE(ra); @@ -859,30 +897,39 @@ SCM aref(v, args) } return res; } - case tc7_bvect: + case tc7_Vbool: if (VELTS(v)[pos/LONG_BIT]&(1L<<(pos%LONG_BIT))) return BOOL_T; else return BOOL_F; case tc7_string: return MAKICHR(CHARS(v)[pos]); - case tc7_svect: + case tc7_VfixN8: + return MAKINUM(((unsigned char *)CDR(v))[pos]); + case tc7_VfixZ8: + return MAKINUM(((signed char *)CDR(v))[pos]); + case tc7_VfixN16: + return MAKINUM(((unsigned short *)CDR(v))[pos]); + case tc7_VfixZ16: return MAKINUM(((short *)CDR(v))[pos]); # ifdef INUMS_ONLY - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: return MAKINUM(VELTS(v)[pos]); # else - case tc7_uvect: + case tc7_VfixN32: return ulong2num(VELTS(v)[pos]); - case tc7_ivect: + case tc7_VfixZ32: return long2num(VELTS(v)[pos]); # endif # ifdef FLOATS - case tc7_fvect: + case tc7_VfloR32: return makflo(((float *)CDR(v))[pos]); - case tc7_dvect: + case tc7_VfloC32: + return makdbl(((float *)CDR(v))[2*pos], + ((float *)CDR(v))[2*pos+1]); + case tc7_VfloR64: return makdbl(((double *)CDR(v))[pos], 0.0); - case tc7_cvect: + case tc7_VfloC64: return makdbl(((double *)CDR(v))[2*pos], ((double *)CDR(v))[2*pos+1]); # endif @@ -906,26 +953,58 @@ SCM cvref(v, pos, last) { switch TYP7(v) { default: wta(v, (char *)ARG1, "PROGRAMMING ERROR: cvref"); - case tc7_bvect: + case tc7_smob: { /* enclosed array */ + int k = ARRAY_NDIM(v); + if (IMP(last) || (!ARRAYP(last))) { + last = make_ra(k); + ARRAY_V(last) = ARRAY_V(v); + ARRAY_BASE(last) = pos; + while (k--) { + ARRAY_DIMS(last)[k].ubnd = ARRAY_DIMS(v)[k].ubnd; + ARRAY_DIMS(last)[k].lbnd = ARRAY_DIMS(v)[k].lbnd; + ARRAY_DIMS(last)[k].inc = ARRAY_DIMS(v)[k].inc; + } + } + return last; + } + case tc7_Vbool: if (VELTS(v)[pos/LONG_BIT]&(1L<<(pos%LONG_BIT))) return BOOL_T; else return BOOL_F; case tc7_string: return MAKICHR(CHARS(v)[pos]); - case tc7_svect: + case tc7_VfixN8: + return MAKINUM(((unsigned char *)CDR(v))[pos]); + case tc7_VfixZ8: + return MAKINUM(((signed char *)CDR(v))[pos]); + case tc7_VfixN16: + return MAKINUM(((unsigned short *)CDR(v))[pos]); + case tc7_VfixZ16: return MAKINUM(((short *)CDR(v))[pos]); # ifdef INUMS_ONLY - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: return MAKINUM(VELTS(v)[pos]); # else - case tc7_uvect: + case tc7_VfixN32: return ulong2num(VELTS(v)[pos]); - case tc7_ivect: + case tc7_VfixZ32: return long2num(VELTS(v)[pos]); # endif # ifdef FLOATS - case tc7_fvect: + case tc7_VfloC32: + if (0.0 != ((float *)CDR(v))[2*pos+1]) { + if (NIMP(last) && tc_dblc==CAR(last)) { + REAL(last) = ((float *)CDR(v))[2*pos]; + IMAG(last) = ((float *)CDR(v))[2*pos+1]; + return last; + } + return makdbl(((float *)CDR(v))[2*pos], + ((float *)CDR(v))[2*pos+1]); + } + else pos *= 2; + /* Fall through */ + case tc7_VfloR32: # ifdef SINGLES if (NIMP(last) && (last != flo0) && (tc_flo==CAR(last))) { FLO(last) = ((float *)CDR(v))[pos]; @@ -939,7 +1018,7 @@ SCM cvref(v, pos, last) } return makdbl((double)((float *)CDR(v))[pos], 0.0); # endif - case tc7_cvect: + case tc7_VfloC64: if (0.0!=((double *)CDR(v))[2*pos+1]) { if (NIMP(last) && tc_dblc==CAR(last)) { REAL(last) = ((double *)CDR(v))[2*pos]; @@ -951,7 +1030,7 @@ SCM cvref(v, pos, last) } else pos *= 2; /* Fall through */ - case tc7_dvect: + case tc7_VfloR64: # ifdef CDR_DOUBLES if (NIMP(last) && (last != flo0) && (tc_flo==CAR(last))) { FLO(last) = ((double *)CDR(v))[pos]; @@ -961,31 +1040,17 @@ SCM cvref(v, pos, last) # ifdef SINGLES if (NIMP(last) && tc_dblr==CAR(last)) # else - if (NIMP(last) && (last != flo0) && (tc_dblr==CAR(last))) + if (NIMP(last) && (last != flo0) && (tc_dblr==CAR(last))) # endif - { - REAL(last) = ((double *)CDR(v))[pos]; - return last; - } + { + REAL(last) = ((double *)CDR(v))[pos]; + return last; + } # endif /* ndef CDR_DOUBLES */ return makdbl(((double *)CDR(v))[pos], 0.0); # endif /* def FLOATS */ case tc7_vector: return VELTS(v)[pos]; - case tc7_smob: { /* enclosed array */ - int k = ARRAY_NDIM(v); - if (IMP(last) || (!ARRAYP(last))) { - last = make_ra(k); - ARRAY_V(last) = ARRAY_V(v); - while (k--) { - ARRAY_DIMS(last)[k].ubnd = ARRAY_DIMS(v)[k].ubnd; - ARRAY_DIMS(last)[k].lbnd = ARRAY_DIMS(v)[k].lbnd; - ARRAY_DIMS(last)[k].inc = ARRAY_DIMS(v)[k].inc; - } - } - ARRAY_BASE(last) = pos; - return last; - } } } @@ -1017,7 +1082,7 @@ SCM aset(v, obj, args) wna: wta(UNDEFINED, (char *)WNA, s_aset); case tc7_smob: /* enclosed */ goto badarg1; - case tc7_bvect: + case tc7_Vbool: if (BOOL_F==obj) VELTS(v)[pos/LONG_BIT] &= ~(1L<<(pos%LONG_BIT)); else if (BOOL_T==obj) @@ -1027,25 +1092,41 @@ SCM aset(v, obj, args) case tc7_string: ASRTGO(ICHRP(obj), badarg2); CHARS(v)[pos] = ICHR(obj); break; - case tc7_svect: + case tc7_VfixN8: + ((unsigned char *)VELTS(v))[pos] = num2uchar(obj, (char *)ARG2, s_aset); break; + case tc7_VfixZ8: + ((signed char *)VELTS(v))[pos] = num2char(obj, (char *)ARG2, s_aset); break; + case tc7_VfixN16: + ((unsigned short *)VELTS(v))[pos] = num2ushort(obj, (char *)ARG2, s_aset); break; + case tc7_VfixZ16: ((short *)VELTS(v))[pos] = num2short(obj, (char *)ARG2, s_aset); break; # ifdef INUMS_ONLY - case tc7_uvect: + case tc7_VfixN32: ASRTGO(INUM(obj) >= 0, badarg2); - case tc7_ivect: + case tc7_VfixZ32: ASRTGO(INUMP(obj), badarg2); VELTS(v)[pos] = INUM(obj); break; # else - case tc7_uvect: + case tc7_VfixN32: VELTS(v)[pos] = num2ulong(obj, (char *)ARG2, s_aset); break; - case tc7_ivect: + case tc7_VfixZ32: VELTS(v)[pos] = num2long(obj, (char *)ARG2, s_aset); break; # endif # ifdef FLOATS - case tc7_fvect: + case tc7_VfloR32: ((float*)VELTS(v))[pos] = (float)num2dbl(obj, (char *)ARG2, s_aset); break; - case tc7_dvect: + case tc7_VfloC32: + if (NIMP(obj) && CPLXP(obj)) { + ((float *)CDR(v))[2*pos] = REALPART(obj); + ((float *)CDR(v))[2*pos+1] = IMAG(obj); + } + else { + ((float *)CDR(v))[2*pos] = num2dbl(obj, (char *)ARG2, s_aset); + ((float *)CDR(v))[2*pos+1] = 0.0; + } + break; + case tc7_VfloR64: ((double*)VELTS(v))[pos] = num2dbl(obj, (char *)ARG2, s_aset); break; - case tc7_cvect: + case tc7_VfloC64: if (NIMP(obj) && CPLXP(obj)) { ((double *)CDR(v))[2*pos] = REALPART(obj); ((double *)CDR(v))[2*pos+1] = IMAG(obj); @@ -1081,7 +1162,7 @@ SCM array_contents(ra, strict) len *= ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1; if (!UNBNDP(strict)) { if (ndim && (1 != ARRAY_DIMS(ra)[ndim-1].inc)) return BOOL_F; - if (tc7_bvect==TYP7(ARRAY_V(ra))) { + if (tc7_Vbool==TYP7(ARRAY_V(ra))) { if (ARRAY_BASE(ra)%LONG_BIT) return BOOL_F; if (len != LENGTH(ARRAY_V(ra)) && len%LONG_BIT) return BOOL_F; } @@ -1127,24 +1208,32 @@ SCM uve_read(v, port) case tc7_string: sz = sizeof(char); break; - case tc7_bvect: + case tc7_Vbool: len = (len+LONG_BIT-1)/LONG_BIT; start /= LONG_BIT; - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: sz = sizeof(long); break; - case tc7_svect: + case tc7_VfixN16: + case tc7_VfixZ16: sz = sizeof(short); break; + case tc7_VfixN8: + case tc7_VfixZ8: + sz = sizeof(char); + break; # ifdef FLOATS - case tc7_fvect: + case tc7_VfloR32: sz = sizeof(float); break; - case tc7_dvect: + case tc7_VfloC32: + sz = 2*sizeof(float); + break; + case tc7_VfloR64: sz = sizeof(double); break; - case tc7_cvect: + case tc7_VfloC64: sz = 2*sizeof(double); break; # endif @@ -1160,7 +1249,7 @@ SCM uve_read(v, port) len -= 1; } SYSCALL(ans = fread(CHARS(v)+start*sz, (sizet)sz, (sizet)len, STREAM(port));); - if (TYP7(v)==tc7_bvect) ans *= LONG_BIT; + if (TYP7(v)==tc7_Vbool) ans *= LONG_BIT; return MAKINUM(ans); } @@ -1192,30 +1281,38 @@ SCM uve_write(v, port) case tc7_string: sz = sizeof(char); break; - case tc7_bvect: + case tc7_Vbool: len = (len+LONG_BIT-1)/LONG_BIT; start /= LONG_BIT; - case tc7_uvect: - case tc7_ivect: + case tc7_VfixN32: + case tc7_VfixZ32: sz = sizeof(long); break; - case tc7_svect: + case tc7_VfixN16: + case tc7_VfixZ16: sz = sizeof(short); break; + case tc7_VfixN8: + case tc7_VfixZ8: + sz = sizeof(char); + break; # ifdef FLOATS - case tc7_fvect: + case tc7_VfloR32: sz = sizeof(float); break; - case tc7_dvect: + case tc7_VfloC32: + sz = 2*sizeof(float); + break; + case tc7_VfloR64: sz = sizeof(double); break; - case tc7_cvect: + case tc7_VfloC64: sz = 2*sizeof(double); break; # endif } ans = lfwrite(CHARS(v)+start*sz, (sizet)sz, (sizet)len, port); - if (TYP7(v)==tc7_bvect) ans *= LONG_BIT; + if (TYP7(v)==tc7_Vbool) ans *= LONG_BIT; return MAKINUM(ans); } @@ -1232,7 +1329,7 @@ SCM lcount(item, seq) tail: switch TYP7(seq) { default: badarg2: wta(seq, (char *)ARG2, s_count); - case tc7_bvect: + case tc7_Vbool: if (lbnd>ubnd) return INUM0; i = ubnd/LONG_BIT; imin = lbnd/LONG_BIT; @@ -1293,7 +1390,7 @@ SCM bit_position(item, v, k) tail: switch TYP7(v) { default: badarg2: wta(v, (char *)ARG2, s_uve_pos); - case tc7_bvect: + case tc7_Vbool: ASRTER((pos <= len) && (pos >= 0), k, OUTOFRANGE, s_uve_pos); if (pos==len) return BOOL_F; if (0==len) return MAKINUM(-1L); @@ -1358,10 +1455,10 @@ SCM bit_set(v, kv, obj) ASRTGO(NIMP(kv), badarg2); switch TYP7(kv) { default: badarg2: wta(kv, (char *)ARG2, s_bit_set); - case tc7_uvect: + case tc7_VfixN32: switch TYP7(v) { default: badarg1: wta(v, (char *)ARG1, s_bit_set); - case tc7_bvect: + case tc7_Vbool: vlen = LENGTH(v); if (BOOL_F==obj) for (i = LENGTH(kv);i;) { k = VELTS(kv)[--i]; @@ -1377,8 +1474,8 @@ SCM bit_set(v, kv, obj) badarg3: wta(obj, (char *)ARG3, s_bit_set); } break; - case tc7_bvect: - ASRTGO(TYP7(v)==tc7_bvect && LENGTH(v)==LENGTH(kv), badarg1); + case tc7_Vbool: + ASRTGO(TYP7(v)==tc7_Vbool && LENGTH(v)==LENGTH(kv), badarg1); if (BOOL_F==obj) for (k = (LENGTH(v)+LONG_BIT-1)/LONG_BIT;k--;) VELTS(v)[k] &= ~(VELTS(kv)[k]); @@ -1401,10 +1498,10 @@ SCM bit_count(v, kv, obj) ASRTGO(NIMP(kv), badarg2); switch TYP7(kv) { default: badarg2: wta(kv, (char *)ARG2, s_bit_count); - case tc7_uvect: + case tc7_VfixN32: switch TYP7(v) { default: badarg1: wta(v, (char *)ARG1, s_bit_count); - case tc7_bvect: + case tc7_Vbool: vlen = LENGTH(v); if (BOOL_F==obj) for (i = LENGTH(kv);i;) { k = VELTS(kv)[--i]; @@ -1420,8 +1517,8 @@ SCM bit_count(v, kv, obj) badarg3: wta(obj, (char *)ARG3, s_bit_count); } break; - case tc7_bvect: - ASRTGO(TYP7(v)==tc7_bvect && LENGTH(v)==LENGTH(kv), badarg1); + case tc7_Vbool: + ASRTGO(TYP7(v)==tc7_Vbool && LENGTH(v)==LENGTH(kv), badarg1); if (0==LENGTH(v)) return INUM0; ASRTGO(BOOL_T==obj || BOOL_F==obj, badarg3); obj = (BOOL_T==obj); @@ -1445,7 +1542,7 @@ SCM bit_inv(v) ASRTGO(NIMP(v), badarg1); k = LENGTH(v); switch TYP7(v) { - case tc7_bvect: + case tc7_Vbool: for (k = (k+LONG_BIT-1)/LONG_BIT;k--;) VELTS(v)[k] = ~VELTS(v)[k]; break; @@ -1585,7 +1682,7 @@ SCM array2list(v) return ra2l(v, ARRAY_BASE(v), 0); case tc7_vector: return vector2list(v); case tc7_string: return string2list(v); - case tc7_bvect: { + case tc7_Vbool: { long *data = (long *)VELTS(v); register unsigned long mask; for (k = (LENGTH(v)-1)/LONG_BIT; k > 0; k--) @@ -1596,21 +1693,21 @@ SCM array2list(v) return res; } # ifdef INUMS_ONLY - case tc7_uvect: - case tc7_ivect: { + case tc7_VfixN32: + case tc7_VfixZ32: { long *data = (long *)VELTS(v); for (k = LENGTH(v) - 1; k >= 0; k--) res = cons(MAKINUM(data[k]), res); return res; } # else - case tc7_uvect: { + case tc7_VfixN32: { long *data = (long *)VELTS(v); for (k = LENGTH(v) - 1; k >= 0; k--) res = cons(ulong2num(data[k]), res); return res; } - case tc7_ivect: { + case tc7_VfixZ32: { long *data = (long *)VELTS(v); for (k = LENGTH(v) - 1; k >= 0; k--) res = cons(long2num(data[k]), res); @@ -1618,19 +1715,25 @@ SCM array2list(v) } # endif # ifdef FLOATS - case tc7_fvect: { + case tc7_VfloR32: { float *data = (float *)VELTS(v); for (k = LENGTH(v) - 1; k >= 0; k--) res = cons(makflo(data[k]), res); return res; } - case tc7_dvect: { + case tc7_VfloC32: { + float (*data)[2] = (float (*)[2])VELTS(v); + for (k = LENGTH(v) - 1; k >= 0; k--) + res = cons(makdbl(data[k][0], data[k][1]), res); + return res; + } + case tc7_VfloR64: { double *data = (double *)VELTS(v); for (k = LENGTH(v) - 1; k >= 0; k--) res = cons(makdbl(data[k], 0.0), res); return res; } - case tc7_cvect: { + case tc7_VfloC64: { double (*data)[2] = (double (*)[2])VELTS(v); for (k = LENGTH(v) - 1; k >= 0; k--) res = cons(makdbl(data[k][0], data[k][1]), res); @@ -1772,9 +1875,9 @@ static void rapr1(ra, j, k, port, writing) for (j += inc; n-- > 0; j += inc) lputc(CHARS(ra)[j], port); break; - case tc7_uvect: + case tc7_VfixN32: if (errjmp_bad) { - ipruk("uvect", ra, port); + ipruk("VfixN32", ra, port); break; } if (n-- > 0) intprint(VELTS(ra)[j], -10, port); @@ -1783,7 +1886,7 @@ static void rapr1(ra, j, k, port, writing) intprint(VELTS(ra)[j], -10, port); } break; - case tc7_ivect: + case tc7_VfixZ32: if (n-- > 0) intprint(VELTS(ra)[j], 10, port); for (j += inc; n-- > 0; j += inc) { lputc(' ', port); @@ -1791,9 +1894,10 @@ static void rapr1(ra, j, k, port, writing) } break; # ifdef FLOATS - case tc7_fvect: - case tc7_dvect: - case tc7_cvect: + case tc7_VfloR32: + case tc7_VfloC32: + case tc7_VfloR64: + case tc7_VfloC64: if (n-- > 0) { SCM z = cvref(ra, j, UNDEFINED); floprint(z, port, writing); @@ -1832,7 +1936,7 @@ int raprin1(exp, port, writing) goto tail; } } - case tc7_bvect: + case tc7_Vbool: if (exp==v) { /* a uve, not an array */ register long i, j, w; lputc('*', port); @@ -1856,24 +1960,32 @@ int raprin1(exp, port, writing) default: if (exp==v) lputc('1', port); switch TYP7(v) { - case tc7_bvect: + case tc7_Vbool: lputs("A:bool", port); break; case tc7_vector: lputc('A', port); break; case tc7_string: lputs("A:char", port); break; - case tc7_uvect: + case tc7_VfixN32: lputs("A:fixN32b", port); break; - case tc7_ivect: + case tc7_VfixZ32: lputs("A:fixZ32b", port); break; - case tc7_svect: + case tc7_VfixN16: + lputs("A:fixN16b", port); break; + case tc7_VfixZ16: lputs("A:fixZ16b", port); break; + case tc7_VfixN8: + lputs("A:fixN8b", port); break; + case tc7_VfixZ8: + lputs("A:fixZ8b", port); break; # ifdef FLOATS - case tc7_fvect: + case tc7_VfloR32: lputs("A:floR32b", port); break; - case tc7_dvect: + case tc7_VfloC32: + lputs("A:floC32b", port); break; + case tc7_VfloR64: lputs("A:floR64b", port); break; - case tc7_cvect: + case tc7_VfloC64: lputs("A:floC64b", port); break; # endif /*FLOATS*/ } @@ -1904,15 +2016,19 @@ SCM array_prot(ra) ra = ARRAY_V(ra); goto loop; case tc7_vector: return EOL; - case tc7_bvect: return BOOL_T; + case tc7_Vbool: return BOOL_T; case tc7_string: return MAKICHR('a'); - case tc7_uvect: return MAKINUM(32L); - case tc7_ivect: return MAKINUM(-32L); - case tc7_svect: return MAKINUM(-16L); + case tc7_VfixN32: return MAKINUM(32L); + case tc7_VfixZ32: return MAKINUM(-32L); + case tc7_VfixN16: return MAKINUM(16L); + case tc7_VfixZ16: return MAKINUM(-16L); + case tc7_VfixN8: return MAKINUM(8L); + case tc7_VfixZ8: return MAKINUM(-8L); # ifdef FLOATS - case tc7_fvect: return makflo(32.0); - case tc7_dvect: return makdbl(64.0, 0.0); - case tc7_cvect: return makdbl(0.0, 64.0); + case tc7_VfloR32: return makflo(32.0); + case tc7_VfloC32: return makdbl(0.0, 32.0); + case tc7_VfloR64: return makdbl(64.0, 0.0); + case tc7_VfloC64: return makdbl(0.0, 64.0); # endif } } diff --git a/version.txi b/version.txi index 00ff734..4f3847d 100644 --- a/version.txi +++ b/version.txi @@ -1,2 +1,2 @@ -@set SCMVERSION 5e2 -@set SCMDATE February 2006 +@set SCMVERSION 5e3 +@set SCMDATE October 2006 @@ -675,12 +675,12 @@ void scm2XPoint(signp, dat, ipr, pos, s_caller) x = VELTS(dat)[0]; y = VELTS(dat)[1]; break; - case tc7_uvect: case tc7_ivect: + case tc7_VfixN32: case tc7_VfixZ32: ASRTGO(2==LENGTH(dat), badarg); x = MAKINUM(((long *)VELTS(dat))[0]); y = MAKINUM(((long *)VELTS(dat))[1]); break; - case tc7_svect: + case tc7_VfixZ16: ASRTGO(2==LENGTH(dat), badarg); x = MAKINUM(((short *)VELTS(dat))[0]); y = MAKINUM(((short *)VELTS(dat))[1]); @@ -742,7 +742,7 @@ int scm2xpointslen(sara, s_caller) if (!((1==(adm[1].ubnd - adm[1].lbnd)) && (1==adm[1].inc) && ARRAY_CONTP(sara) - && (tc7_svect==TYP7(ARRAY_V(sara))))) return -1; + && (tc7_VfixZ16==TYP7(ARRAY_V(sara))))) return -1; len = 1 + adm[0].ubnd - adm[0].lbnd; if (len < 0) return 0; return len; @@ -1337,7 +1337,7 @@ SCM x_free_color_cells(scmap, spxls, sargs) unsigned int planes = 0; ASRTER(NIMP(scmap) && COLORMAPP(scmap), scmap, ARG1, s_x_free_color_cells); xcm = COLORMAP(scmap); - ASRTER(NIMP(spxls) && (TYP7(spxls)==tc7_uvect), spxls, ARG2, + ASRTER(NIMP(spxls) && (TYP7(spxls)==tc7_VfixN32), spxls, ARG2, s_x_free_color_cells); switch (ilength(sargs) + 2) { default: wta(sargs, (char *)WNA, s_x_free_color_cells); |