diff options
| -rw-r--r-- | ANNOUNCE | 306 | ||||
| -rw-r--r-- | ChangeLog | 166 | ||||
| -rw-r--r-- | Init5e2.scm (renamed from Init5e1.scm) | 10 | ||||
| -rw-r--r-- | Makefile | 11 | ||||
| -rw-r--r-- | README | 20 | ||||
| -rw-r--r-- | Transcen.scm | 134 | ||||
| -rw-r--r-- | bench.scm | 2 | ||||
| -rw-r--r-- | build.scm | 4 | ||||
| -rw-r--r-- | byte.c | 6 | ||||
| -rw-r--r-- | continue.c | 4 | ||||
| -rw-r--r-- | crs.c | 26 | ||||
| -rw-r--r-- | debug.c | 2 | ||||
| -rw-r--r-- | differ.c | 7 | ||||
| -rw-r--r-- | dynl.c | 28 | ||||
| -rw-r--r-- | eval.c | 192 | ||||
| -rw-r--r-- | grtest.scm | 82 | ||||
| -rw-r--r-- | gsubr.c | 6 | ||||
| -rw-r--r-- | hobbit.info | 4 | ||||
| -rw-r--r-- | hobbit.scm | 6 | ||||
| -rw-r--r-- | ioext.c | 25 | ||||
| -rw-r--r-- | patchlvl.h | 4 | ||||
| -rw-r--r-- | posix.c | 8 | ||||
| -rw-r--r-- | r4rstest.scm | 2 | ||||
| -rw-r--r-- | ramap.c | 78 | ||||
| -rw-r--r-- | record.c | 10 | ||||
| -rw-r--r-- | repl.c | 80 | ||||
| -rw-r--r-- | rope.c | 51 | ||||
| -rw-r--r-- | rwb-isam.scm | 616 | ||||
| -rw-r--r-- | sc2.c | 8 | ||||
| -rw-r--r-- | scl.c | 749 | ||||
| -rw-r--r-- | scm.1 | 12 | ||||
| -rw-r--r-- | scm.c | 20 | ||||
| -rw-r--r-- | scm.doc | 319 | ||||
| -rw-r--r-- | scm.h | 80 | ||||
| -rw-r--r-- | scm.info | 4483 | ||||
| -rw-r--r-- | scm.spec | 2 | ||||
| -rw-r--r-- | scm.texi | 31 | ||||
| -rw-r--r-- | scmfig.h | 36 | ||||
| -rw-r--r-- | scmmain.c | 6 | ||||
| -rw-r--r-- | script.c | 8 | ||||
| -rw-r--r-- | socket.c | 43 | ||||
| -rw-r--r-- | subr.c | 165 | ||||
| -rw-r--r-- | sys.c | 150 | ||||
| -rw-r--r-- | time.c | 6 | ||||
| -rw-r--r-- | turtle | 20 | ||||
| -rw-r--r-- | turtlegr.c | 1298 | ||||
| -rw-r--r-- | unexelf.c | 1093 | ||||
| -rw-r--r-- | unif.c | 104 | ||||
| -rw-r--r-- | unix.c | 2 | ||||
| -rw-r--r-- | version.txi | 4 | ||||
| -rw-r--r-- | wbtab.scm | 525 | ||||
| -rw-r--r-- | x.c | 54 |
52 files changed, 7038 insertions, 4070 deletions
@@ -1,190 +1,136 @@ -This message announces the availability of Scheme release scm5e1. - -New in scm5e1: - - * r4rstest.scm: Removed tests for 0^0 in anticipation of SRFI-70. - * r4rstest.scm (test-numeric-predicates): Raised exponent so - intransitive 128-bit-float implementations are caught. - * r4rstest.scm (SECTION 6 5 5): Removed tests for (EXPT 0 -255) - so Common-Lisp compatible EXPT won't bomb. - Test EXPT inexactness contagion of zero cases. - * r4rstest.scm (SECTION 6 5 5): Added exact tests for EXPT. - Inexact EXPT corner cases should return inexacts. - * r4rstest.scm: Added URLs. - - * Transcen.scm (limit): Check and report input errors. - * Transcen.scm (limit): Added srfi-70 procedure. - * Transcen.scm (expt, quotient, remainder, modulo): SRFI-70 extensions. - * Transcen.scm (expt): Changed so (expt 0 -5) signals error. - EXPT of zero returns zero or one matching input exactness. - - * Link.scm (link:link): Converted to use with-load-pathname. - - * Init5d9.scm (numerator, denominator): Check rational. - * Init5d9.scm (numerator, denominator): Added. - * Init5d9.scm (with-load-pathname): Moved from slib/require.scm. - * Init5d9.scm (any-bits-set?, first-set-bit, bitwise-merge): Added - remaining SRFI-33 aliases. - * Init5d9.scm (read-array-type): Handle A:char. - * Init5d9.scm (list->array, vector->array, array->vector): Added. - * Init5d9.scm: Updated per SRFI-60. - * Init5d9.scm (arithmetic-shift): Aliases ASH. - * Init5d9.scm (read:array, read:sharp): Accept whole boatload of - SRFI-58 sytnaxes. - * Init5d9.scm (inexact->exact, exact->inexact): Identity when - exacts-only. - * Init5d9.scm (slib:eval-load): Converted to use (SLIB) - with-load-pathname. - * Init5d9.scm (slib:eval-load): Define moved to "slib/require.scm" - * Init5d9.scm (read:array): Ignore third argument; line-numbers - were hosing array reading. - - * build.scm (dlll gnu-win32): Changed flag to "-DSCM_WIN_DLL". - (dlll microsoft-c-nt): Changed flag to "-DSCM_WIN_DLL". - * build.scm (wb): Added for source in ../wb/. - (build:command): Assume c-files are relative to cd; don't prefix - c-files with scm-srcdir. - (compile-dll-c-files): Many were missing include-spec "-I" call. - * build.scm (compile-dll-c-files): For those platforms supporting - shared object files, generate just one combining all FILES. - * build.scm (compile-dll-c-files): Fixed -I for netbsd, openbsd. - (compile-dll-c-files): Added -I for svr4-gcc-sun-ld. - (file-categories): Renamed CORE from REQUIRED. - - * mkimpcat.scm: Support WB compiled in implementation-vicinity. - * mkimpcat.scm: Added 'DIFF. - - * xgen.scm, build.bat, inc2scm: Replaced %0 ... %9 with %~f0 %* - - * scmhob.scm: Moved LOGICAL: aliases from logical.scm. - - * Makefile (install): Added db.so. - (uninstall): Beefed up. - * Makfile (scm5): Added target for undumpable architectures (FC3). - * Makefile (SETARCH): Workaround for unexec on Fedora Linux i386. - * Makefile (mydlls): Call BUILD separately for each dll. - * Makefile (srcdir.mk): Include after target. - Separated shell assignments and exports. - * Makefile: (SHOBJS): Abstracted *.sl and *.so. - * Makefile (db.so, rwb-isam.scm, wbtab.scm): Added. - * Makefile (differ.so): Added target. - - * scm.spec (differ.so, Idiffer.scm): Added to %files. - - * scm.texi (MS-DOS Compatible Scripts): Replaced %0 ... %9 with %~f0 %* - * scm.texi (SCMDB): Added section with link. - (Hobbit): Moved notinfo stuff after Xlib so it appears same place - in all products. - * scm.texi (Sequence Comparison): Added. - * scm.texi (SIOD copyright): Put in subsection. - (The SCM License): Parallel Guile License text. - * scm.texi (Automatic C Preprocessor Definitions): Added "sun". - - * scm.h (infi): Nonreal infinity added to sys_protects. - * scm.h (SCM_WIN_DLL): renamed from SCM_DLL and DLLSCM. - - * scmfig.h (IS_INF): Removed. - - * scl.c (scm_complex_p): 0/0 is not complex. - * scl.c (inf2str): Renamed from NaN2str(). - (makdbl): Returns `infi' for unreal infinities. - (scm_rationalp): Added (infinities not). - * scl.c (scm_intexpt): EXPT of zero behaves like Common-Lisp. - * scl.c (scm_intexpt): Bombed given (integer-expt 0 25). - - * subr.c (scm_copybitfield): Changed argument order (SRFI-60). - - * unif.c (scm_prot2type): Was not defaulting correctly. - * unif.c (raprin1): Don't elide 1 from #1A. - * unif.c, sys.c: Sun cc doesn't like fwrite declaration. - - * byte.c (scm_write_byte): Was hosed for even number of bytes. - * byte.c (scm_substring_read): Fixed off-by-one reading backwards. - - * ramap.c (array:copy!): Renamed from array-copy!. - (array_copy): Arguments reversed. - * ramap.c (init_ramap): Its tc7_subr_2 not tc7_subr2! - * ramap.c (rafe): Removed unused variables inc and base. - - * repl.c (err_head): Fixed "loaded from" messages and formatting. - * repl.c (iprin1): Slashify uppercase chars in symbols. - * repl.c (read_token, iprin1, lreadr): Handle slashified symbols. - * repl.c (handle_it): Added comments. Call scm_fill_freelist() if - interrupt lacks handler. - * repl.c (scm_top_level): Default value of toplvl_fun just once. - - * differ.c, Idiffer.scm: Linear-space O(PN) sequence comparison. - - * eval.c (definedp): Added third (dummy) argument. - -From Radey Shouman: - - * Init5d9.scm (read:array): Make default rank one, not zero. - (as before). - * Init5d9.scm (read:array): (read:sharp): (load:sharp): Use read - argument passed to READ:SHARP only for eval, otherwise unexpected - line numbers cause trouble. eg #+(or) in load file. - - * script.c (find_impl_file): Find executable path accurately - on MS windows. - - * scm.texi (Debugging Continuations): Added documenting - frame-trace, frame->environment, scope-trace, frame-eval. - - * eval.c (toplevel_define) (scm_arity_check) (ceval_1) - (scm_cvapply) (apply): Pass multiple arguments to captured - continuations, eg: - (call-with-values (lambda () (call/cc (lambda (k) 1 2))) list) - Better error checking for multiple-value returns in repl. - - * sys.c (scm_dynthrow): Allow passing multiple arguments - to a continuation captured in the producer argument of - call-with-values. - - * subr.c (scm_logbitp): Fixed bug in range check for fixnum - case. Eg (logbit? 10 #xffff) now correctly returns #t. +This message announces the availability of Scheme release scm5e2. - * eval.c (macroexp1): Catch more syntax errors: ('f . f) - * eval.c (m_case) (definedp): Avoid segfault in cases of syntax - error. +SCM conforms to Revised^5 Report on the Algorithmic Language Scheme +and the IEEE P1178 specification. SCM is written in C and runs under +Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS, Windows, +Unix, and similar systems. -From Wim Lewis: +SCM is free software. It is released under the GNU Public License +(GPL) with an exception allowing it to be linked with non-GPL +programs (see http://swiss.csail.mit.edu/~jaffer/SCM_LICENSE). - * Makefile (scmflags): Use "cmp -s" instead of "diff". - (x.h): Use -x $CPROTO to test for cproto's existence. +Documentation and distributions in several formats are linked from +SCM's home page: - -=-=- + http://swissnet.ai.mit.edu/~jaffer/SCM.html -Scm conforms to Revised^5 Report on the Algorithmic Language Scheme -and the IEEE P1178 specification. Scm is written in C and runs under -Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS, Windows, -Unix, and similar systems. ASCII and EBCDIC are supported. +Links to distributions of SCM and related softwares are at the end of +this message. -Documentation is included explaining the many Scheme Language -extensions in scm, the internal representations, and how to extend or -include SCM in other programs. Documentation is online at: + -=-=- +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. - http://swissnet.ai.mit.edu/~jaffer/SCM.html + -=-=- SCM source is available from: - http://swissnet.ai.mit.edu/ftpdir/scm/scm5e1.zip - swissnet.ai.mit.edu:/pub/scm/scm5e1.zip - http://swissnet.ai.mit.edu/ftpdir/scm/scm-5e1-1.src.rpm - swissnet.ai.mit.edu:/pub/scm/scm-5e1-1.src.rpm + 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 Also available as i386 binary RPM: - http://swissnet.ai.mit.edu/ftpdir/scm/scm-5e1-1.i386.rpm - swissnet.ai.mit.edu:/pub/scm/scm-5e1-1.i386.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/scm-5e2-1.i386.rpm + swissnet.ai.mit.edu:/pub/scm/scm-5e2-1.i386.rpm SLIB is a portable Scheme library which SCM uses: - http://swissnet.ai.mit.edu/ftpdir/scm/slib3a2.zip - swissnet.ai.mit.edu:/pub/scm/slib3a2.zip + http://swissnet.ai.mit.edu/ftpdir/scm/slib3a3.zip + swissnet.ai.mit.edu:/pub/scm/slib3a3.zip Also available as RPM: - http://swissnet.ai.mit.edu/ftpdir/scm/slib-3a2-1.noarch.rpm - swissnet.ai.mit.edu:/pub/scm/slib-3a2-1.noarch.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/slib-3a3-1.noarch.rpm + swissnet.ai.mit.edu:/pub/scm/slib-3a3-1.noarch.rpm JACAL is a symbolic math system written in Scheme: - http://swissnet.ai.mit.edu/ftpdir/scm/jacal1b5.zip - swissnet.ai.mit.edu:/pub/scm/jacal1b5.zip + http://swissnet.ai.mit.edu/ftpdir/scm/jacal1b6.zip + swissnet.ai.mit.edu:/pub/scm/jacal1b6.zip SLIB-PSD is a portable debugger for Scheme (requires emacs editor): http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz @@ -212,13 +158,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/wb1c1.zip - swissnet.ai.mit.edu:/pub/scm/wb1c1.zip - http://swissnet.ai.mit.edu/ftpdir/scm/wb-1c1-1.src.rpm - swissnet.ai.mit.edu:/pub/scm/wb-1c1-1.src.rpm + 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 Also available as i386 binary RPM: - http://swissnet.ai.mit.edu/ftpdir/scm/wb-1c1-1.i386.rpm - swissnet.ai.mit.edu:/pub/scm/wb-1c1-1.i386.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/wb-1c2-1.i386.rpm + swissnet.ai.mit.edu:/pub/scm/wb-1c2-1.i386.rpm SIMSYNCH is a digital logic simulation system written in SCM. http://swissnet.ai.mit.edu/ftpdir/scm/synch1b0.zip @@ -230,8 +176,8 @@ files on VAX (Ultrix), Sun 3 (SunOS 3.4 and 4.0), SPARCstation systems. ftp.gnu.org:pub/gnu/dld/dld-3.3.tar.gz -SCM.EXE (282k) is a SCM executable for DOS and MS-Windows. -Note: SCM.EXE still requires slib3a2 and scm5e1 above. +SCM.EXE (314k) is a SCM executable for DOS and MS-Windows. +Note: SCM.EXE still requires slib3a3 and scm5e2 above. http://swissnet.ai.mit.edu/ftpdir/scm/scm.exe swissnet.ai.mit.edu:/pub/scm/scm.exe @@ -1,3 +1,169 @@ +2006-02-19 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (atanh, acosh, asinh): define if #ifndef HAVE_ATANH. + + * scmfig.h (HAVE_ATANH): Decides whether atanh, asinh, and acosh + are supported. + +2006-02-16 Radey Shouman <shouman@comcast.net> + + * scl.c: Changes to allow compilation with MinGW (gnu-win32); + asinh, acosh, and atanh are not yet supported. + +2006-02-13 Aubrey Jaffer <jaffer@aubrey> + + * patchlvl.h (SCMVERSION): Bumped from 5e1 to 5e2. + +2006-02-08 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (lasinh, lacosh, latanh): Replaced by libc functions. + +2006-02-08 Steve VanDevender + + * scmfig.h (SHORT_INT, CDR_DOUBLES): For __x86_64 (AMD Opteron). + +2006-01-23 Aubrey Jaffer <agj@alum.mit.edu> + + * Transcen.scm (exact-round, exact-floor, exact-ceiling) + (exact-truncate): Returned inexacts. + +2006-01-14 Aubrey Jaffer <agj@alum.mit.edu> + + * Transcen.scm (quo, rem, mod): New names for inexact quotient, + remainder, and modulo. + + * scmfig.h (SCM_EXPECT_TRUE, SCM_EXPECT_FALSE): Added. + (POSFIXABLE, NEGFIXABLE, UNEGFIXABLE): SCM_EXPECT_TRUE. + + * scm.h: SCM_EXPECT_TRUE and SCM_EXPECT_FALSE replace + __builtin_expect(). + (ASRTER, ASRTGO): SCM_EXPECT_FALSE. + + * scl.c (sum, difference, divide): Added BIGDIG* cast to &z. + + * scmfig.h (__builtin_expect): Added stub for non-gcc compilers. + + * 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. + +2006-01-09 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (udscm4.opt, scm5.opt): Condition + -fno-guess-branch-probability on `type gcc'. + +2006-01-06 Aubrey Jaffer <agj@alum.mit.edu> + + * 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. + + * 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. + +2006-01-04 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (numident): Don't bomb given bignums. + + * scm.c (l_pause): __CYGWIN__ now has pause(). + + * scmfig.h (LACK_FTIME): __CYGWIN__ now has ftime(). + + * ioext.c: __CYGWIN__ has <unistd.h>. + + * build.scm (build:command): Comment to script: [-p <platform>]. + +2005-12-18 Aubrey Jaffer <agj@alum.mit.edu> + + * socket.c (l_lna, l_hostinfo, l_netinfo, l_setnet): Made + conditional on __CYGWIN__. + +2005-12-07 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (makdbl): (+ -1/0 +5i) ==> -1/0; not 0/0. + +2005-12-01 Aubrey Jaffer <agj@alum.mit.edu> + + * scmmain.c, scm.h, scm.c, rope.c, repl.c: Added const decls. + + * scl.c (apx_log10): Removed unused variable. + +2005-10-29 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (scm_magnitude): Renamed from magnitude(). + (scm_abs): Added, real-only. + + * subr.c (absval): Moved to scl.c. + + * 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. + + * Init5e1.scm (abs): Is no longer synonym for magnitude. + +2005-10-28 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (turfiles): Added turtle-graphics files. + +2005-10-27 Thomas Bushnell + + * scm.doc, scm.1: Corrected spelling errors. + +2005-10-02 Aubrey Jaffer <agj@alum.mit.edu> + + * unexelf.c: Imported from emacs-22.0.50 to fix FC4 build. + +2005-09-22 Aubrey Jaffer <agj@alum.mit.edu> + + * rope.c (num2dbl): Handle 0/0. + +2005-08-16 Aubrey Jaffer <agj@alum.mit.edu> + + * Transcen.scm (exact-round, exact-floor, exact-ceiling) + (exact-truncate): Renamed from xxx->exact. + (limit): Removed. + + * scl.c (inf2str): Changed to "+inf.0" and "-inf.0". + (istr2flo): Parse "+inf.0", "-inf.0", and + COMPACT_INFINITY_NOTATION. + +2005-08-07 Aubrey Jaffer <agj@alum.mit.edu> + + * Transcen.scm (round->exact, floor->exact, ceiling->exact, + truncate->exact): Added SRFI-70 convenience functions. + + * differ.c (diff_mid_split): Unused `m' argument removed. + +2005-07-17 Aubrey Jaffer <agj@alum.mit.edu> + + * scl.c (safe_add_1): Replaces add1. + (scm_truncate): Renamed from ltrunc. + + * scm.h (scm_truncate): Renamed from ltrunc. + (scm_floor, scm_ceiling): Added. + +2005-07-02 Aubrey Jaffer <agj@alum.mit.edu> + + * Transcen.scm (sequence->limit): Removed use of 1/0 literal. + + * scl.c (inf2str): Prefix "1/0" with '+'. + (istr2flo, inf2str): COMPACT_INFINITY_NOTATION flag enables +/0 + and -/0 infinity notations. + +2005-06-30 Aubrey Jaffer <agj@alum.mit.edu> + + * r4rstest.scm (SECTION 6 5 5): Restored 0^0 test. + + * Transcen.scm (expt): 0^0 ==> 1. + + * scl.c (scm_intexpt): 0^0 ==> 1. + 2005-06-25 Aubrey Jaffer <agj@alum.mit.edu> * scm.spec (slibpath, dumparch): Added. diff --git a/Init5e1.scm b/Init5e2.scm index ae2f591..447e721 100644 --- a/Init5e1.scm +++ b/Init5e2.scm @@ -42,7 +42,7 @@ ;;; Author: Aubrey Jaffer. (define (scheme-implementation-type) 'SCM) -(define (scheme-implementation-version) "5e1") +(define (scheme-implementation-version) "5e2") (define (scheme-implementation-home-page) "http://swiss.csail.mit.edu/~jaffer/SCM") @@ -1145,19 +1145,21 @@ (require 'debug) (apply breakpoint args)) )) -;;; ABS and MAGNITUDE can be the same. (cond ((and (inexact? (string->number "0.0")) (not (defined? exp))) (or (and (defined? usr:lib) (usr:lib "m") (load (in-vicinity (implementation-vicinity) "Transcen") (usr:lib "m"))) - (load (in-vicinity (implementation-vicinity) "Transcen"))) - (set! abs magnitude)) + (load (in-vicinity (implementation-vicinity) "Transcen")))) (else (define (infinite? z) #f) (define finite? number?) (define inexact->exact identity) (define exact->inexact identity) + (define round->exact identity) + (define floor->exact identity) + (define ceiling->exact identity) + (define truncate->exact identity) (define expt integer-expt))) (define (numerator q) @@ -88,6 +88,7 @@ IMPLINIT = $(IMPLPATH)Init$(VERSION).scm # SCM_INIT_PATH is the environment variable whose value is the # pathname where InitXXX.scm resides. +hfiles = scm.h scmfig.h setjump.h patchlvl.h continue.h cfiles = scmmain.c scm.c time.c repl.c ioext.c scl.c sys.c eval.c \ subr.c sc2.c unif.c rgx.c crs.c dynl.c record.c posix.c socket.c\ unix.c rope.c ramap.c gsubr.c edline.c continue.c \ @@ -98,6 +99,7 @@ ofiles = scm.o time.o repl.o scl.o sys.o eval.o subr.o unif.o rope.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 +turfiles = turtlegr.c turtle grtest.scm xafiles = xatoms.scm x11.scm xevent.scm keysymdef.scm xfiles = x.c x.h xgen.scm xevent.h inc2scm $(xafiles) @@ -147,6 +149,7 @@ scm5.opt: echo "-F cautious bignums arrays inexact" >> scm5.opt echo "-F engineering-notation dynamic-linking" >> scm5.opt echo "-F macro" >> scm5.opt +# if type gcc; then echo "--compiler-options=\"-fno-guess-branch-probability\"" >> scm5.opt; fi scm5: $(cfiles) $(hfiles) build.scm build scm5.opt $(BUILD) -f scm5.opt -o scm -s $(IMPLPATH) rm $(ofiles) scmmain.o @@ -157,6 +160,7 @@ scm5: $(cfiles) $(hfiles) build.scm build scm5.opt udscm4.opt: echo "-F cautious bignums arrays inexact" >> udscm4.opt echo "-F engineering-notation dump dynamic-linking" >> udscm4.opt +# if type gcc; then echo "--compiler-options=\"-fno-guess-branch-probability\"" >> udscm4.opt; fi udscm4: $(cfiles) $(hfiles) build.scm build udscm4.opt $(BUILD) -f udscm4.opt -o udscm4 -s $(IMPLPATH) rm $(ofiles) scmmain.o @@ -166,7 +170,8 @@ dscm4: udscm4 $(ifiles) require.scm echo "(quit)" | $(SETARCH) ./udscm4 -no-init-file -o scm # dumpable R5RS interpreter -udscm5.opt: udscm4.opt +udscm5.opt: + $(MAKE) udscm4.opt cat udscm4.opt >> udscm5.opt echo "-F macro" >> udscm5.opt # echo "-DNO_SYM_GC" >> udscm5.opt @@ -511,7 +516,6 @@ ufiles = pre-crt0.c ecrt0.c gmalloc.c unexec.c unexelf.c unexhp9k800.c \ confiles = scmconfig.h.in mkinstalldirs acconfig-1.5.h install-sh \ configure configure.in Makefile.in COPYING README.unix -hfiles = scm.h scmfig.h setjump.h patchlvl.h continue.h tfiles = r4rstest.scm example.scm pi.scm pi.c split.scm bench.scm \ syntest2.scm syntest1.scm dfiles = ANNOUNCE README COPYING scm.1 scm.doc QUICKREF \ @@ -520,8 +524,9 @@ dfiles = ANNOUNCE README COPYING scm.1 scm.doc QUICKREF \ mfiles = Makefile build.scm build build.bat requires.scm \ .gdbinit mkimpcat.scm disarm.scm scm.spec vfiles = setjump.mar setjump.s +wbfiles = wbtab.scm rwb-isam.scm afiles = $(dfiles) $(cfiles) $(hfiles) $(ifiles) $(tfiles) $(mfiles) \ - $(hobfiles) $(vfiles) $(ufiles) $(xfiles) + $(hobfiles) $(vfiles) $(ufiles) $(xfiles) $(turfiles) $(wbfiles) makedev = make -f $(HOME)/makefile.dev CHPAT=$(HOME)/bin/chpat @@ -1,4 +1,4 @@ -This directory contains the distribution of scm5e1. Scm conforms to +This directory contains the distribution of scm5e2. 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. @@ -104,18 +104,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/slib3a2.tar.gz + * swiss.csail.mit.edu:/pub/scm/slib3a3.tar.gz - * ftp.gnu.org:/pub/gnu/jacal/slib3a2.tar.gz + * ftp.gnu.org:/pub/gnu/jacal/slib3a3.tar.gz - * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a2.tar.gz + * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a3.tar.gz -Unpack SLIB (`tar xzf slib3a2.tar.gz' or `unzip -ao slib3a2.zip') in an +Unpack SLIB (`tar xzf slib3a3.tar.gz' or `unzip -ao slib3a3.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 `Init5e1.scm' is +(this is the same directory as where the file `Init5e2.scm' is installed). `require.scm' should have the contents: (define (library-vicinity) "/usr/local/lib/slib/") @@ -280,17 +280,17 @@ remove <FLAG> in scmfig.h and Do so and recompile files. recompile scm. add <FLAG> in scmfig.h and recompile scm. -ERROR: Init5e1.scm not found. Assign correct IMPLINIT in makefile +ERROR: Init5e2.scm not found. Assign correct IMPLINIT in makefile or scmfig.h. Define environment variable SCM_INIT_PATH to be the full - pathname of Init5e1.scm. + pathname of Init5e2.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 - Init5e1.scm to point to library or + Init5e2.scm to point to library or remove. Make sure the value of (library-vicinity) has a trailing @@ -351,7 +351,7 @@ Some symbol names print incorrectly. Change memory model option to C than HEAP_SEG_SIZE). ERROR: Rogue pointer in Heap. See above under machine crashes. Newlines don't appear correctly in Check file mode (define OPEN_... in -output files. `Init5e1.scm'). +output files. `Init5e2.scm'). Spaces or control characters appear Check character defines in in symbol names. `scmfig.h'. Negative numbers turn positive. Check SRS in `scmfig.h'. diff --git a/Transcen.scm b/Transcen.scm index dd869a7..3b87837 100644 --- a/Transcen.scm +++ b/Transcen.scm @@ -133,119 +133,39 @@ (define expt (let ((integer-expt integer-expt)) (lambda (z1 z2) - (cond ((and (exact? z2) (not (and (zero? z1) (not (positive? 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)))))))) -(set! quotient - (let ((integer-quotient quotient)) - (lambda (x1 x2) - (if (and (exact? x1) (exact? x2)) - (integer-quotient x1 x2) - (truncate (/ x1 x2)))))) - -(set! remainder - (let ((integer-remainder remainder)) - (lambda (x1 x2) - (if (and (exact? x1) (exact? x2)) - (integer-remainder x1 x2) - (- x1 (* x2 (quotient x1 x2))))))) - -(set! modulo - (let ((integer-modulo modulo)) - (lambda (x1 x2) - (if (and (exact? x1) (exact? x2)) - (integer-modulo x1 x2) - (- x1 (* x2 (floor (/ x1 x2)))))))) +(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 (exact-round x) (inexact->exact (round x))) +(define (exact-floor x) (inexact->exact (floor x))) +(define (exact-ceiling x) (inexact->exact (ceiling x))) +(define (exact-truncate x) (inexact->exact (truncate x))) (define (infinite? z) (and (= z (* 2 z)) (not (zero? z)))) (define (finite? z) (not (infinite? z))) - -(define (invintp f1 f2 f3) - (define f1^2 (* f1 f1)) - (define f2^2 (* f2 f2)) - (define f3^2 (expt f3 2)) - (let ((c (+ (* -3 f1^2 f2) - (* 3 f1 f2^2) - (* (- (* 2 f1^2) f2^2) f3) - (* (- f2 (* 2 f1)) f3^2))) - (b (+ (- f1^2 (* 2 f2^2)) f3^2)) - (a (- (* 2 f2) f1 f3))) - (define disc (- (* b b) (* 4 a c))) - (if (negative? (real-part disc)) - (/ b -2 a) - (let ((sqrt-disc (sqrt disc))) - (define root+ (/ (- sqrt-disc b) 2 a)) - (define root- (/ (+ sqrt-disc b) -2 a)) - (if (< (magnitude (- root+ f1)) (magnitude (- root- f1))) - root+ - root-))))) - -(define (extrapolate-0 fs) - (define n (length fs)) - (define (choose n k) - (do ((kdx 1 (+ 1 kdx)) - (prd 1 (/ (* (- n kdx -1) prd) kdx))) - ((> kdx k) prd))) - (do ((k 1 (+ 1 k)) - (lst fs (cdr lst)) - (L 0 (+ (* -1 (expt -1 k) (choose n k) (car lst)) L))) - ((null? lst) L))) - -(define (sequence->limit proc sequence) - (define lval (proc (car sequence))) - (if (finite? lval) - (let ((val (proc (cadr sequence)))) - (define h_n*nsamps (* (length sequence) (magnitude (- val lval)))) - (if (finite? val) - (let loop ((sequence (cddr sequence)) - (fxs (list val lval)) - (trend #f) - (ldelta (- val lval)) - (jdx (+ -1 (length sequence)))) - (cond ((null? sequence) - (case trend - ((diverging) (and (real? val) (* ldelta 1/0))) - ((bounded) (invintp val lval (caddr fxs))) - (else (cond ((zero? ldelta) val) - ((not (real? val)) #f) - (else (extrapolate-0 fxs)))))) - (else - (set! lval val) - (set! val (proc (car sequence))) - (if (finite? val) - (let ((delta (- val lval))) - (define h_j (/ h_n*nsamps jdx)) - (cond ((case trend - ((converging) (<= (magnitude delta) h_j)) - ((bounded) (<= (magnitude ldelta) (magnitude delta))) - ((diverging) (>= (magnitude delta) h_j)) - (else #f)) - (loop (cdr sequence) (cons val fxs) trend delta (+ -1 jdx))) - (trend #f) - (else - (loop (cdr sequence) (cons val fxs) - (cond ((> (magnitude delta) h_j) 'diverging) - ((< (magnitude ldelta) (magnitude delta)) 'bounded) - (else 'converging)) - delta (+ -1 jdx))))) - (and (eq? trend 'diverging) val))))) - (and (real? val) val))) - (and (real? lval) lval))) - -(define (limit proc x1 x2 . k) - (set! k (if (null? k) 8 (car k))) - (cond ((not (finite? x2)) (slib:error 'limit 'infinite 'x2 x2)) - ((not (finite? x1)) - (or (positive? (* x1 x2)) (slib:error 'limit 'start 'mismatch x1 x2)) - (limit (lambda (x) (proc (/ x))) 0.0 (/ x2) k)) - ((= x1 (+ x1 x2)) (slib:error 'limit 'null 'range x1 (+ x1 x2))) - (else (let ((dec (/ x2 k))) - (do ((x (+ x1 x2 0.0) (- x dec)) - (cnt (+ -1 k) (+ -1 cnt)) - (lst '() (cons x lst))) - ((negative? cnt) - (sequence->limit proc (reverse lst)))))))) @@ -98,7 +98,7 @@ )))))) (define (prng samples modu sta) - (define sra (create-array (Au32) samples)) + (define sra (create-array (A:fixN32b) samples)) (do ((cnt (+ -1 samples) (+ -1 cnt)) (num (random modu sta) (random modu sta)) (sum 0 (+ sum num))) @@ -1934,7 +1934,9 @@ (lambda (batch-port) (define o-files #f) (adjoin-parameters! parms (list 'batch-port batch-port)) - + (batch:comment + parms + (string-append "[-p " (symbol->string platform) "]")) (let ((options-file (parameter-list-ref parms 'options-file))) (and (not (null? options-file)) (batch:comment @@ -131,7 +131,7 @@ SCM scm_write_byte(chr, port) SCM chr, port; { int k = INUM(chr); - if UNBNDP(port) port = cur_outp; + if (UNBNDP(port)) port = cur_outp; else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write_byte); ASRTER(INUMP(chr) && 0 <= k && k <= 255, chr, ARG1, s_write_byte); lputc(k, port); @@ -142,7 +142,7 @@ SCM scm_read_byte(port) SCM port; { int c; - if UNBNDP(port) port = cur_inp; + if (UNBNDP(port)) port = cur_inp; ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_byte); c = lgetc(port); if (EOF==c) return EOF_VAL; @@ -173,7 +173,7 @@ SCM scm_substring_read(sstr, start, args) long ans = 0; /* An ungetc before an fread will not work on some systems if setbuf(0), so we read one element char by char. */ - if CRDYP(port) { + if (CRDYP(port)) { CHARS(sstr)[start] = lgetc(port); start += 1; len -= 1; @@ -191,7 +191,7 @@ void dynthrow(a) puts("grow_throw: check if long growth[]; being optimized out"); # 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); + if (PTR_GE(dst + (cont->length), (STACKITEM *)&a)) grow_throw(a); # else # ifndef hpux if (a[2] && (((long *)a[3]) - a < SCM_GROWTH)) @@ -199,7 +199,7 @@ void dynthrow(a) # 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); + if (PTR_LE(dst, (STACKITEM *)&a)) grow_throw(a); # endif/* def STACK_GROWS_UP */ FLUSH_REGISTER_WINDOWS; src = (STACKITEM *)(cont + 1); @@ -112,7 +112,7 @@ SCM *loc_stdscr = 0; SCM linitscr() { WINDOW *win; - if NIMP(*loc_stdscr) { + if (NIMP(*loc_stdscr)) { refresh(); return *loc_stdscr; } @@ -121,7 +121,7 @@ SCM linitscr() } SCM lendwin() { - if IMP(*loc_stdscr) return BOOL_F; + if (IMP(*loc_stdscr)) return BOOL_F; return ERR==endwin() ? BOOL_F : BOOL_T; } @@ -204,9 +204,9 @@ SCM lwadd(win, obj) SCM win, obj; { ASRTER(NIMP(win) && WINP(win), win, ARG1, s_wadd); - if ICHRP(obj) + if (ICHRP(obj)) return ERR==waddch(WIN(win), ICHR(obj)) ? BOOL_F : BOOL_T; - if INUMP(obj) + if (INUMP(obj)) return ERR==waddch(WIN(win), INUM(obj)) ? BOOL_F : BOOL_T; ASRTER(NIMP(obj) && STRINGP(obj), obj, ARG2, s_wadd); return ERR==waddstr(WIN(win), CHARS(obj)) ? BOOL_F : BOOL_T; @@ -216,7 +216,7 @@ SCM lwinsch(win, obj) SCM win, obj; { ASRTER(NIMP(win) && WINP(win), win, ARG1, s_winsch); - if INUMP(obj) + if (INUMP(obj)) return ERR==winsch(WIN(win), INUM(obj)) ? BOOL_F : BOOL_T; ASRTER(ICHRP(obj), obj, ARG2, s_winsch); return ERR==winsch(WIN(win), ICHR(obj)) ? BOOL_F : BOOL_T; @@ -227,12 +227,12 @@ SCM lbox(win, vertch, horch) { int v, h; ASRTER(NIMP(win) && WINP(win), win, ARG1, s_box); - if INUMP(vertch) v = INUM(vertch); + if (INUMP(vertch)) v = INUM(vertch); else { ASRTER(ICHRP(vertch), vertch, ARG2, s_box); v = ICHR(vertch); } - if INUMP(horch) h = INUM(horch); + if (INUMP(horch)) h = INUM(horch); else { ASRTER(ICHRP(horch), horch, ARG3, s_box); h = ICHR(horch); @@ -271,20 +271,20 @@ static char s_oheight[] = "output-port-height"; SCM owidth(arg) SCM arg; { - if UNBNDP(arg) arg = cur_outp; + if (UNBNDP(arg)) arg = cur_outp; ASRTER(NIMP(arg) && OPOUTPORTP(arg), arg, ARG1, s_owidth); - if NIMP(*loc_stdscr) - if WINP(arg) return MAKINUM(WIN(arg)->_maxx+1); + if (NIMP(*loc_stdscr)) + if (WINP(arg)) return MAKINUM(WIN(arg)->_maxx+1); else return MAKINUM(COLS); return MAKINUM(80); } SCM oheight(arg) SCM arg; { - if UNBNDP(arg) arg = cur_outp; + if (UNBNDP(arg)) arg = cur_outp; ASRTER(NIMP(arg) && OPOUTPORTP(arg), arg, ARG1, s_owidth); - if NIMP(*loc_stdscr) - if WINP(arg) return MAKINUM(WIN(arg)->_maxy+1); + if (NIMP(*loc_stdscr)) + if (WINP(arg)) return MAKINUM(WIN(arg)->_maxy+1); else return MAKINUM(LINES); return MAKINUM(24); } @@ -54,7 +54,7 @@ static void prinbindings P((SCM names, SCM inits, SCM init_env, SCM scm_env_rlookup(addr, stenv, what) SCM addr, stenv; - char *what; + const char *what; { SCM env, fr; int icdrp; @@ -61,7 +61,7 @@ int fp_compare(int *fp,int fpoff,int *cc,void *a,int m,void *b,int n,int_functio int fp_run(int *fp,int fpoff,int k,void *a,int m,void *b,int n,int_function array_refsEql_P,int *cc,int p); -int diff_mid_split(int m,int n,int *rr,int *cc,int cost); +int diff_mid_split(int n,int *rr,int *cc,int cost); void fp_init(int *fp,int fpoff,int fill,int mindx,int maxdx); @@ -234,8 +234,7 @@ L_snloop: } } -int diff_mid_split(m, n, rr, cc, cost) - int m; +int diff_mid_split(n, rr, cc, cost) int n; int *rr; int *cc; @@ -313,7 +312,7 @@ int diff_divide_and_conquer(fp, fpoff, ccrr, a, start_a, end_a, b, start_b, end_ fp_init(fp, fpoff, -1, -(1+(p_lim)), 1+(p_lim)+((len_b)-(m2))); fp_compare(fp, fpoff, rr, procs->subarray(a, mid_a, end_a), m2, procs->subarray(b, start_b, end_b), len_b, procs->array_refs_revEql_P, MIN(p_lim, len_a)); { - int b_splt = diff_mid_split(len_a, len_b, rr, cc, tcst); + int b_splt = diff_mid_split(len_b, rr, cc, tcst); int est_c = cc[b_splt]; int est_r = rr[(len_b)-(b_splt)]; check_cost("cc", est_c, diff2et(fp, fpoff, ccrr, a, start_a, mid_a, b, start_b, (start_b)+(b_splt), edits, edx, epo, procs, ((est_c)-((b_splt)-((mid_a)-(start_a))))/2)); @@ -110,14 +110,14 @@ SCM l_dyn_main_call(symb, shl, args) SCM symb, shl, args; { int i; - int (*func)(int argc, char **argv) = 0; - char **argv; + int (*func)(int argc, const char **argv) = 0; + const char **argv; /* SCM oloadpath = *loc_loadpath; */ ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); DEFER_INTS; argv = makargvfrmstrs(args, s_main_call); if ((i = dld_function_executable_p(CHARS(symb)))) - func = (int (*) (int argc, char **argv)) dld_get_func(CHARS(symb)); + func = (int (*) (int argc, const char **argv)) dld_get_func(CHARS(symb)); else dld_perror("DLDP"); if (!i) listundefs(); if (!func) { @@ -235,8 +235,8 @@ SCM l_dyn_main_call(symb, shl, args) SCM symb, shl, args; { int i; - int (*func)P((int argc, char **argv)) = 0; - char **argv; + int (*func)P((int argc, const char **argv)) = 0; + const char **argv; /* SCM oloadpath = *loc_loadpath; */ ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); @@ -369,7 +369,7 @@ sizet frshl(ptr) # if 0 /* Should freeing a shl close and possibly unmap the object file it */ /* refers to? */ - if(SHL(ptr)) + if (SHL(ptr)) dlclose(SHL(ptr)); # endif return 0; @@ -392,7 +392,7 @@ SCM l_dyn_link(fname) { SCM z; void *handle; - if FALSEP(fname) return fname; + if (FALSEP(fname)) return fname; ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); NEWCELL(z); DEFER_INTS; @@ -447,8 +447,8 @@ SCM l_dyn_main_call(symb, shl, args) SCM symb, shl, args; { int i; - int (*func)P((int argc, char **argv)) = 0; - char **argv; + int (*func)P((int argc, const char **argv)) = 0; + const char **argv; /* SCM oloadpath = *loc_loadpath; */ ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); @@ -519,7 +519,7 @@ sizet frshl(ptr) # if 0 /* Should freeing a shl close and possibly unmap the object file it */ /* refers to? */ - if(SHL(ptr)) + if (SHL(ptr)) dlclose(SHL(ptr)); # endif return 0; @@ -548,7 +548,7 @@ SCM l_dyn_link(fname) Ptr mainAddr; Str255 errMessage; - if FALSEP(fname) return fname; + if (FALSEP(fname)) return fname; ASRTER(NIMP(fname) && STRINGP(fname), fname, ARG1, s_link); NEWCELL(z); DEFER_INTS; @@ -602,8 +602,8 @@ SCM l_dyn_main_call(symb, shl, args) SCM symb, shl, args; { int i; - int (*func)P((int argc, char **argv)) = 0; - char **argv; + int (*func)P((int argc, const char **argv)) = 0; + const char **argv; OSErr err; CFragSymbolClass symClass; Str255 symName; @@ -734,7 +734,7 @@ SCM scm_dyn_main_call(symb, shl, args) { int i; FARPROC func; - char **argv; + const char **argv; ASRTER(NIMP(symb) && STRINGP(symb), symb, ARG1, s_main_call); ASRTER(NIMP(shl) && CAR(shl)==tc16_shl, shl, ARG2, s_main_call); DEFER_INTS; @@ -174,7 +174,7 @@ static SCM m_binding P((SCM name, SCM value, SCM env, SCM ctxt)); static SCM m_bindings P((SCM name, SCM value, SCM env, SCM ctxt)); static SCM m_seq P((SCM x, SCM env, SCM ctxt)); static SCM m_expr P((SCM x, SCM env, SCM ctxt)); -static void checked_define P((SCM name, SCM val, char *what)); +static void checked_define P((SCM name, SCM val, const char *what)); static int topdenote_eq P((SCM sym, SCM id, SCM env)); static int constant_p P((SCM x)); static int prinenv P((SCM exp, SCM port, int writing)); @@ -188,9 +188,9 @@ static void env_tail P((int depth)); static void unpaint P((SCM *p)); static void ecache_evalx P((SCM x)); static int ecache_eval_args P((SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM x)); -static int varcheck P((SCM vars, SCM op, char *what)); +static int varcheck P((SCM vars, SCM op, const char *what)); #ifdef CAREFUL_INTS -static void debug_env_warn P((char *fnam, int line, char *what)); +static void debug_env_warn P((char *fnam, int line, const char *what)); static void debug_env_save P((char *fnam, int line)); #endif @@ -233,7 +233,7 @@ SCM scm_trace, scm_trace_env; #endif #define ENV_MAY_POP(p, guard) if (p>0 && !(guard)) {ENV_POP; p=-1;} #define ENV_MAY_PUSH(p) if (p<=0) {ENV_PUSH; p=1;} -#define SIDEVAL_1(x) if NIMP(x) ceval_1(x) +#define SIDEVAL_1(x) if (NIMP(x)) ceval_1(x) #define STATIC_ENV (scm_estk_ptr[2]) #ifdef CAUTIOUS # define TRACE(x) {scm_estk_ptr[3]=(x);} @@ -342,7 +342,7 @@ int ecache_p(x) SCM x; { register CELLPTR ptr; - if NCELLP(x) return 0; + if (NCELLP(x)) return 0; ptr = (CELLPTR)SCM2PTR(x); if (PTR_LE(scm_ecache, ptr) && PTR_GT(scm_ecache+scm_ecache_len, ptr)) @@ -352,7 +352,7 @@ int ecache_p(x) static void debug_env_warn(fnam, line, what) char *fnam; int line; - char *what; + const char *what; { lputs(fnam, cur_errp); lputc(':', cur_errp); @@ -419,7 +419,7 @@ SCM *ilookup(iloc) eloc = &CAR(er); for (ir = IDIST(iloc); 0 != ir; --ir) eloc = &CDR(*eloc); - if ICDRP(iloc) return eloc; + if (ICDRP(iloc)) return eloc; return &CAR(*eloc); } SCM *farlookup(farloc) @@ -641,7 +641,7 @@ static SCM evalatomcar(x, toplevelp) return CAR(CDR(ret)); case tc7_smob: #ifdef MACRO - if M_IDENTP(CAR(x)) goto lookup; + if (M_IDENTP(CAR(x))) goto lookup; #endif /* fall through */ case tcs_uves: @@ -818,10 +818,10 @@ static int ecache_eval_args(proc, arg1, arg2, arg3, x) proc = CDR(proc); proc = CDR(proc); for (; NIMP(proc); proc=CDR(proc)) { - if IMP(x) return 0; + if (IMP(x)) return 0; x = CDR(x); } - if NIMP(x) return 0; + if (NIMP(x)) return 0; #endif return 1; } @@ -839,10 +839,10 @@ static SCM asubr_apply(proc, arg1, arg2, arg3, args) } return arg1; case tc7_rpsubr: - if FALSEP(SUBRF(proc)(arg1, arg2)) return BOOL_F; + if (FALSEP(SUBRF(proc)(arg1, arg2))) return BOOL_F; while (!0) { - if FALSEP(SUBRF(proc)(arg2, arg3)) return BOOL_F; - if IMP(args) return BOOL_T; + if (FALSEP(SUBRF(proc)(arg2, arg3))) return BOOL_F; + if (IMP(args)) return BOOL_T; arg2 = arg3; arg3 = CAR(args); args = CDR(args); @@ -855,7 +855,7 @@ static char s_values[] = "values"; static char s_call_wv[] = "call-with-values"; SCM scm_values(arg1, arg2, rest, what) SCM arg1, arg2, rest; - char *what; + const char *what; { DEFER_INTS_EGC; ASRTER(IM_VALUES_TOKEN==scm_env_tmp, UNDEFINED, "one value expected", what); @@ -877,7 +877,7 @@ static char s_clauses[] = "bad or missing clauses"; static char s_formals[] = "bad formals"; static char s_expr[] = "bad expression"; #define ASSYNT(_cond, _arg, _pos, _subr)\ - if(!(_cond))scm_experr(_arg, (char *)_pos, _subr); + if (!(_cond))scm_experr(_arg, (char *)_pos, _subr); /* These symbols are needed by the reader, in repl.c */ SCM i_dot, i_quote, i_quasiquote, i_unquote, i_uq_splicing; @@ -888,7 +888,7 @@ static SCM i_bind, i_anon, i_side_effect, i_test, i_procedure, static SCM f_begin, f_define; -#define ASRTSYNTAX(cond_, msg_) if(!(cond_))wta(xorig, (msg_), what); +#define ASRTSYNTAX(cond_, msg_) if (!(cond_))wta(xorig, (msg_), what); #ifdef MACRO # define TOPLEVELP(x, env) (topdenote_eq(UNDEFINED, (x), (env))) # define TOPDENOTE_EQ topdenote_eq @@ -907,7 +907,7 @@ static int topdenote_eq(sym, id, env) static SCM id2sym(id) SCM id; { - if NIMP(id) + if (NIMP(id)) while M_IDENTP(id) id = IDENT_PARENT(id); return id; @@ -924,7 +924,7 @@ static void unpaint(p) { SCM x; while NIMP((x = *p)) { - if CONSP(x) { + if (CONSP(x)) { if (NIMP(CAR(x))) unpaint(&CAR(x)); else if (SCM_LINUMP(CAR(x))) { @@ -933,7 +933,7 @@ static void unpaint(p) } p = &CDR(*p); } - else if VECTORP(x) { + else if (VECTORP(x)) { sizet i = LENGTH(x); if (0==i) return; while (i-- > 1) unpaint(&(VELTS(x)[i])); @@ -1144,7 +1144,7 @@ SCM m_cond(xorig, env, ctxt) static int varcheck(vars, op, what) SCM vars, op; - char *what; + const char *what; { SCM v1, vs; char *opstr = ISYMCHARS(op) + 2; @@ -1351,15 +1351,15 @@ static SCM iqq(form) SCM form; { SCM tmp; - if IMP(form) return form; - if VECTORP(form) { + if (IMP(form)) return form; + if (VECTORP(form)) { long i = LENGTH(form); SCM *data = VELTS(form); tmp = EOL; for(;--i >= 0;) tmp = cons(data[i], tmp); return vector(iqq(tmp)); } - if NCONSP(form) return form; + if (NCONSP(form)) return form; tmp = CAR(form); if (IM_UNQUOTE==tmp) return evalcar(CDR(form)); @@ -1374,8 +1374,8 @@ static SCM m_iqq(form, depth, env, ctxt) { SCM tmp; int edepth = depth; - if IMP(form) return form; - if VECTORP(form) { + if (IMP(form)) return form; + if (VECTORP(form)) { long i = LENGTH(form); SCM *data = VELTS(form); tmp = EOL; @@ -1387,7 +1387,7 @@ static SCM m_iqq(form, depth, env, ctxt) } return form; } - if NCONSP(form) { + if (NCONSP(form)) { #ifdef MACRO while M_IDENTP(form) form = IDENT_PARENT(form); #endif @@ -1395,8 +1395,8 @@ static SCM m_iqq(form, depth, env, ctxt) } form = scm_check_linum(form, 0L); /* needed? */ tmp = scm_check_linum(CAR(form), 0L); - if NIMP(tmp) { - if IDENTP(tmp) { + if (NIMP(tmp)) { + if (IDENTP(tmp)) { #ifdef MACRO while M_IDENTP(tmp) tmp = IDENT_PARENT(tmp); #endif @@ -1447,11 +1447,11 @@ SCM m_delay(xorig, env, ctxt) static int built_inp(name, x) SCM name, x; { - if NIMP(x) { + if (NIMP(x)) { tail: switch TYP7(x) { case tcs_subrs: return CHARS(name)==SNAME(x); - case tc7_smob: if MACROP(x) {x = CDR(x); goto tail;} + case tc7_smob: if (MACROP(x)) {x = CDR(x); goto tail;} /* else fall through */ } } @@ -1465,7 +1465,7 @@ char s_built_in_syntax[] = "built-in syntax "; #endif static void checked_define(name, val, what) SCM name, val; - char *what; + const char *what; { SCM old, vcell; #ifdef MACRO @@ -1519,9 +1519,9 @@ static SCM m_parse_let(imm, xorig, x, vars, inits) SCM clause, bdgs, *varloc = vars, *initloc = inits; int len = ilength(x); #ifdef MACRO - char *what = CHARS(ident2sym(CAR(xorig))); + const char *what = CHARS(ident2sym(CAR(xorig))); #else - char *what = CHARS(CAR(xorig)); + const char *what = CHARS(CAR(xorig)); #endif *varloc = imm; *initloc = EOL; @@ -1613,12 +1613,12 @@ static SCM m_body(xorig, env, ctxt) SCM xorig, env, ctxt; { SCM form, denv = env, x = xorig, defs = EOL; - char *what = 0; /* Should this be passed in? */ + const char *what = 0; /* Should this be passed in? */ ASRTSYNTAX(ilength(xorig) >= 1, s_expression); while NIMP(x) { form = scm_check_linum(CAR(x), 0L); if (IMP(form) || NCONSP(form)) break; - if IMP(CAR(form)) break; + if (IMP(CAR(form))) break; if (! IDENTP(CAR(form))) break; form = macroexp1(CAR(x), denv, i_check_defines, 1); if (IM_DEFINE==CAR(form)) { @@ -1635,7 +1635,7 @@ static SCM m_body(xorig, env, ctxt) else x = append(cons2(form, x, EOL)); } - else if NIMP(defs) { + else if (NIMP(defs)) { break; } else { @@ -1736,7 +1736,7 @@ static SCM macroexp1(xorig, env, ctxt, mode) #ifndef RECKLESS SCM trace = scm_trace, trace_env = scm_trace_env; long argc; - char *what = s_wtap; + const char *what = s_wtap; MACROEXP_TRACE(xorig, env); #endif x = scm_check_linum(xorig, &linum); @@ -1914,8 +1914,8 @@ int badargsp(formals, args) SCM formals, args; { while NIMP(formals) { - if NCONSP(formals) return 0; - if IMP(args) return 1; + if (NCONSP(formals)) return 0; + if (IMP(args)) return 1; formals = CDR(formals); args = CDR(args); } @@ -1925,7 +1925,7 @@ int badargsp(formals, args) int scm_arity_check(proc, argc, what) SCM proc; long argc; - char *what; + const char *what; { SCM p = proc; if (IMP(p) || argc < 0) goto badproc; @@ -1991,7 +1991,7 @@ char s_call_cc[] = "call-with-current-continuation"; /* s_apply[] = "apply"; */ /* {return (NIMP(ctxt) && i_check_defines==CAR(ctxt));} */ /* static SCM wrapenv() */ /* {register SCM z; */ -/* DEFER_INTS_EGC; if NULLP(scm_env) return EOL; */ +/* DEFER_INTS_EGC; if (NULLP(scm_env)) return EOL; */ /* NEWCELL(z); DEFER_INTS_EGC; */ /* if (NIMP(scm_env) && ENVP(scm_env)) return scm_env; */ /* CDR(z) = scm_env; CAR(z) = tc16_env; */ @@ -2101,11 +2101,11 @@ static SCM ceval_1(x) x = arg1; } carloop: /* eval car of last form in list */ - if NCELLP(CAR(x)) { + if (NCELLP(CAR(x))) { x = CAR(x); x = IMP(x) ? EVALIMP(x) : I_VAL(x); } - else if ATOMP(CAR(x)) + else if (ATOMP(CAR(x))) x = evalatomcar(x, 0); else { x = CAR(x); @@ -2123,9 +2123,9 @@ static SCM ceval_1(x) while(NIMP(x = CDR(x))) { proc = CAR(x); arg1 = EVALCAR(proc); - if NFALSEP(arg1) { + if (NFALSEP(arg1)) { x = CDR(proc); - if NULLP(x) { + if (NULLP(x)) { x = arg1; goto retx; } @@ -2156,12 +2156,12 @@ static SCM ceval_1(x) EXTEND_VALENV; } x = CDR(proc); - if NULLP(x) {x = UNSPECIFIED; goto retx;} + if (NULLP(x)) {x = UNSPECIFIED; goto retx;} goto begin; case (127 & IM_IF): x = CDR(x); - if NFALSEP(EVALCAR(x)) x = CDR(x); - else if IMP(x = CDR(CDR(x))) {x = UNSPECIFIED; goto retx;} + if (NFALSEP(EVALCAR(x))) x = CDR(x); + else if (IMP(x = CDR(CDR(x)))) {x = UNSPECIFIED; goto retx;} goto carloop; case (127 & IM_LET): ENV_MAY_PUSH(envpp); @@ -2198,7 +2198,7 @@ static SCM ceval_1(x) x = CDR(x); proc = CDR(CAR(x)); /* No longer happens. - if IMP(proc) { + if (IMP(proc)) { scm_env_tmp = EOL; EXTEND_VALENV; goto cdrxbegin; @@ -2218,7 +2218,7 @@ static SCM ceval_1(x) arg1 = x; while(NNULLP(arg1 = CDR(arg1))) { x = EVALCAR(x); - if NFALSEP(x) goto retx; + if (NFALSEP(x)) goto retx; x = arg1; } goto carloop; @@ -2234,8 +2234,8 @@ static SCM ceval_1(x) proc = CAR(x); switch (7 & (int)proc) { case 0: - if ECONSP(proc) - if ISYMP(CAR(proc)) *farlookup(proc) = arg2; + if (ECONSP(proc)) + if (ISYMP(CAR(proc))) *farlookup(proc) = arg2; else { x = scm_multi_set(proc, arg2); goto retx; @@ -2342,7 +2342,7 @@ static SCM ceval_1(x) x = macroexp1(x, STATIC_ENV, EOL, 3); goto loop; #else - if ATOMP(CAR(x)) { + if (ATOMP(CAR(x))) { proc = scm_lookupval(x, 0); if (KEYWORDP(proc)) { x = macroexp1(x, STATIC_ENV, EOL, 3); @@ -2356,7 +2356,7 @@ static SCM ceval_1(x) position and x has the form which is being evaluated. */ ASRTGO(NIMP(proc), badfun); scm_estk_ptr[0] = scm_env; /* For error reporting at wrongnumargs. */ - if NULLP(CDR(x)) { + if (NULLP(CDR(x))) { evap0: TOP_TRACE(xorig, STATIC_ENV); ENV_MAY_POP(envpp, CLOSUREP(proc)); @@ -2386,12 +2386,12 @@ static SCM ceval_1(x) DEFER_INTS_EGC; arg2 = scm_env_tmp; while NIMP(arg1) { - if NCONSP(arg1) goto clo_unchecked; - if IMP(arg2) goto umwrongnumargs; + if (NCONSP(arg1)) goto clo_unchecked; + if (IMP(arg2)) goto umwrongnumargs; arg1 = CDR(arg1); arg2 = CDR(arg2); } - if NNULLP(arg2) goto umwrongnumargs; + if (NNULLP(arg2)) goto umwrongnumargs; } #else /* def CAUTIOUS */ clo_checked: @@ -2447,7 +2447,7 @@ static SCM ceval_1(x) #endif arg1 = EVALCAR(x); x = CDR(x); - if NULLP(x) { + if (NULLP(x)) { TOP_TRACE(xorig, STATIC_ENV); evap1: ENV_MAY_POP(envpp, CLOSUREP(proc)); @@ -2460,14 +2460,14 @@ evap1: return SUBRF(proc)(arg1); case tc7_cxr: #ifdef FLOATS - if SUBRF(proc) { - if INUMP(arg1) + if (SUBRF(proc)) { + if (INUMP(arg1)) return makdbl(DSUBRF(proc)((double) INUM(arg1)), 0.0); ASRTGO(NIMP(arg1), floerr); - if REALP(arg1) + if (REALP(arg1)) return makdbl(DSUBRF(proc)(REALPART(arg1)), 0.0); # ifdef BIGDIG - if BIGP(arg1) + if (BIGP(arg1)) return makdbl(DSUBRF(proc)(big2dbl(arg1)), 0.0); # endif floerr: @@ -2561,7 +2561,7 @@ evap1: { /* have two or more arguments */ arg2 = EVALCAR(x); x = CDR(x); - if NULLP(x) { /* have two arguments */ + if (NULLP(x)) { /* have two arguments */ TOP_TRACE(xorig, STATIC_ENV); evap2: ENV_MAY_POP(envpp, CLOSUREP(proc)); @@ -2582,7 +2582,7 @@ evap1: case tc16_apply: proc = arg1; ASRTGO(NIMP(proc), badfun); - if NULLP(arg2) goto evap0; + if (NULLP(arg2)) goto evap0; if (IMP(arg2) || NCONSP(arg2)) { x = arg2; badlst: wta(x, (char *)ARGn, s_apply); @@ -2590,17 +2590,17 @@ evap1: arg1 = CAR(arg2); x = CDR(arg2); apply3: - if NULLP(x) goto evap1; + if (NULLP(x)) goto evap1; ASRTGO(NIMP(x) && CONSP(x), badlst); arg2 = CAR(x); x = CDR(x); apply4: - if NULLP(x) goto evap2; + if (NULLP(x)) goto evap2; ASRTGO(NIMP(x) && CONSP(x), badlst); arg3 = x; x = scm_cp_list(CDR(x), 0); #ifndef RECKLESS - if UNBNDP(x) {x = arg3; goto badlst;} + if (UNBNDP(x)) {x = arg3; goto badlst;} #endif arg3 = CAR(arg3); goto evap3; @@ -2665,7 +2665,7 @@ evap1: { /* have 3 or more arguments */ arg3 = EVALCAR(x); x = CDR(x); - if NIMP(x) { + if (NIMP(x)) { if (CLOSUREP(proc) && 3==ARGC(proc)) { ALLOW_INTS_EGC; ENV_MAY_PUSH(envpp); @@ -2716,12 +2716,12 @@ evap1: proc = arg1; ASRTGO(NIMP(proc), badfun); arg1 = arg2; - if IMP(x) { + if (IMP(x)) { x = arg3; goto apply3; } arg2 = arg3; - if IMP(CDR(x)) { + if (IMP(CDR(x))) { x = CAR(x); goto apply4; } @@ -2756,7 +2756,7 @@ evap1: SCM procedurep(obj) SCM obj; { - if NIMP(obj) switch TYP7(obj) { + if (NIMP(obj)) switch TYP7(obj) { case tcs_closures: case tc7_contin: case tcs_subrs: @@ -2838,8 +2838,8 @@ SCM apply(proc, arg1, args) SCM proc, arg1, args; { ASRTGO(NIMP(proc), badproc); - if NULLP(args) - if NULLP(arg1) arg1 = UNDEFINED; + if (NULLP(args)) + if (NULLP(arg1)) arg1 = UNDEFINED; else { args = CDR(arg1); arg1 = CAR(arg1); @@ -2855,7 +2855,7 @@ SCM apply(proc, arg1, args) wrongnumargs: wta(proc, (char *)WNA, s_apply); case tc7_subr_2o: - if NULLP(args) { + if (NULLP(args)) { args = UNDEFINED; return SUBRF(proc)(arg1, args); } @@ -2874,14 +2874,14 @@ SCM apply(proc, arg1, args) case tc7_cxr: ASRTGO(NULLP(args), wrongnumargs); #ifdef FLOATS - if SUBRF(proc) { - if INUMP(arg1) + if (SUBRF(proc)) { + if (INUMP(arg1)) return makdbl(DSUBRF(proc)((double) INUM(arg1)), 0.0); ASRTGO(NIMP(arg1), floerr); - if REALP(arg1) + if (REALP(arg1)) return makdbl(DSUBRF(proc)(REALPART(arg1)), 0.0); # ifdef BIGDIG - if BIGP(arg1) + if (BIGP(arg1)) return makdbl(DSUBRF(proc)(big2dbl(arg1)), 0.0); # endif floerr: @@ -2911,7 +2911,7 @@ SCM apply(proc, arg1, args) ASRTGO(NIMP(args) && CONSP(args), wrongnumargs); return SUBRF(proc)(arg1, CAR(args), CDR(args)); case tc7_asubr: - if NULLP(args) return SUBRF(proc)(arg1, UNDEFINED); + if (NULLP(args)) return SUBRF(proc)(arg1, UNDEFINED); while NIMP(args) { ASRTER(CONSP(args), args, ARG2, s_apply); arg1 = SUBRF(proc)(arg1, CAR(args)); @@ -2919,10 +2919,10 @@ SCM apply(proc, arg1, args) } return arg1; case tc7_rpsubr: - if NULLP(args) return BOOL_T; + if (NULLP(args)) return BOOL_T; while NIMP(args) { ASRTER(CONSP(args), args, ARG2, s_apply); - if FALSEP(SUBRF(proc)(arg1, CAR(args))) return BOOL_F; + if (FALSEP(SUBRF(proc)(arg1, CAR(args)))) return BOOL_F; arg1 = CAR(args); args = CDR(args); } @@ -2978,14 +2978,14 @@ SCM scm_cvapply(proc, n, argv) return SUBRF(proc)(argv[0]); case tc7_cxr: #ifdef FLOATS - if SUBRF(proc) { - if INUMP(argv[0]) + 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]) + if (REALP(argv[0])) return makdbl(DSUBRF(proc)(REALPART(argv[0])), 0.0); # ifdef BIGDIG - if BIGP(argv[0]) + if (BIGP(argv[0])) return makdbl(DSUBRF(proc)(big2dbl(argv[0])), 0.0); # endif floerr: @@ -3019,7 +3019,7 @@ SCM scm_cvapply(proc, n, argv) case tc7_rpsubr: if (1 >= n) return BOOL_T; for (i = 0; i < n-1; i++) - if FALSEP(SUBRF(proc)(argv[i], argv[i+1])) return BOOL_F; + if (FALSEP(SUBRF(proc)(argv[i], argv[i+1]))) return BOOL_F; return BOOL_T; case tcs_closures: { SCM p = proc; @@ -3070,7 +3070,7 @@ SCM map(proc, arg1, args) SCM *ve = auto_ve, *ave = auto_ave; long i, n = ilength(args) + 1; scm_protect_temp(&heap_ve); /* Keep heap_ve from being optimized away. */ - if NULLP(arg1) return res; + if (NULLP(arg1)) return res; #ifndef RECKLESS scm_arity_check(proc, n, s_map); #endif @@ -3099,7 +3099,7 @@ SCM map(proc, arg1, args) while (1) { arg1 = EOL; for (i = n-1;i >= 0;i--) { - if IMP(ve[i]) { + if (IMP(ve[i])) { /* We could check for lists the same length here. */ return res; } @@ -3118,7 +3118,7 @@ SCM for_each(proc, arg1, args) SCM *ve = auto_ve, *ave = auto_ave; long i, n = ilength(args) + 1; scm_protect_temp(&heap_ve); /* Keep heap_ve from being optimized away. */ - if NULLP(arg1) return UNSPECIFIED; + if (NULLP(arg1)) return UNSPECIFIED; #ifndef RECKLESS scm_arity_check(proc, n, s_for_each); #endif @@ -3147,7 +3147,7 @@ SCM for_each(proc, arg1, args) while (1) { arg1 = EOL; for (i = n-1;i >= 0;i--) { - if IMP(ve[i]) { + if (IMP(ve[i])) { return UNSPECIFIED; } ASRTER(CONSP(ve[i]), ve[i], 0==i ? ARG2 : ARGn, s_for_each); @@ -3205,7 +3205,7 @@ static int prinprom(exp, port, writing) static SCM makro(code, flags, what) SCM code; long flags; - char *what; + const char *what; { register SCM z; ASRTER(scm_arity_check(code, (MAC_PRIMITIVE & flags ? 3L : 2L), @@ -3371,14 +3371,14 @@ SCM copytree(obj) SCM obj; { SCM ans, tl; - if IMP(obj) return obj; - if VECTORP(obj) { + if (IMP(obj)) return obj; + if (VECTORP(obj)) { sizet i = LENGTH(obj); ans = make_vector(MAKINUM(i), UNSPECIFIED); while(i--) VELTS(ans)[i] = copytree(VELTS(obj)[i]); return ans; } - if NCONSP(obj) return obj; + if (NCONSP(obj)) return obj; /* return cons(copytree(CAR(obj)), copytree(CDR(obj))); */ ans = tl = cons(copytree(CAR(obj)), UNSPECIFIED); while(NIMP(obj = CDR(obj)) && CONSP(obj)) @@ -3425,9 +3425,9 @@ SCM ident_eqp(id1, id2, env) { SCM s1 = id1, s2 = id2; # ifndef RECKLESS - if IMP(id1) + if (IMP(id1)) badarg1: wta(id1, (char *)ARG1, s_ident_eqp); - if IMP(id1) + if (IMP(id1)) badarg2: wta(id2, (char *)ARG2, s_ident_eqp); # endif if (id1==id2) return BOOL_T; diff --git a/grtest.scm b/grtest.scm new file mode 100644 index 0000000..7401308 --- /dev/null +++ b/grtest.scm @@ -0,0 +1,82 @@ + +; This is a quick hack to test the graphics primitives. +; The SLIB scheme library is needed for random. +; IMHO, the syntax of `do' in scheme is horrible! +; - sjm + +(define (grtest) + (require 'random) ; needs SLIB + (graphics-mode!) + + (display "testing draw-to") (newline) + (clear-graphics!) + (goto-center!) + (do ((x 0 (+ x 3))) + ((> x (max-x)) 0) + (set-color! (remainder (/ x 3) (max-color))) + (draw-to x 0) + (draw-to x (max-y)) + ) + + (do ((y 0 (+ y 3))) + ((> y (max-y)) 0) + (set-color! (remainder (/ y 3) (max-color))) + (goto-center!) + (draw-to! 0 y) + (goto-center!) + (draw-to! (max-x) y) + ) + + (goto-nw!) + (do ((x 0 (+ x 2))) + ((> x (max-x)) 0) + (set-color! (remainder (/ x 2) (max-color))) + (draw-to x (max-y)) + ) + (do ((y (+ (max-y) 1) (- y 2))) + ((< y 0) 0) + (set-color! (remainder (/ y 2) (max-color))) + (draw-to (max-x) y) + ) + + (display "testing set-dot!") (newline) + (clear-graphics!) + (do ((x 0 (+ x 1))) + ((= x 100) 0) + (set-dot! (+ (random (max-x)) 1) (+ (random (max-y)) 1) + (+ (random (max-color)) 1)) + ) + + (display "testing draw with turn-to!") (newline) + (clear-graphics!) + (goto-center!) + (do ((x 0 (+ x 1))) + ((= x 100) 0) + (set-color! (+ (random (max-color)) 1)) + (turn-to! (random 360)) + (draw (random 50)) + ) + + (display "testing draw with turn-right") (newline) + (clear-graphics!) + (goto-center!) + (do ((x 0 (+ x 1))) + ((= x 100) 0) + (set-color! (+ (random (max-color)) 1)) + (turn-right (random 90)) + (draw (random 50)) + ) + + (display "testing draw with turn-left") (newline) + (clear-graphics!) + (goto-center!) + (do ((x 0 (+ x 1))) + ((= x 100) 0) + (set-color! (+ (random (max-color)) 1)) + (turn-left (random 90)) + (draw (random 50)) + ) + + (text-mode!) +) + @@ -96,21 +96,21 @@ SCM gsubr_apply(args) args = CDR(args); for (i = 0; i < GSUBR_REQ(typ); i++) { #ifndef RECKLESS - if IMP(args) + if (IMP(args)) wnargs: wta(UNDEFINED, (char *)WNA, SNAME(GSUBR_PROC(self))); #endif v[i] = CAR(args); args = CDR(args); } for (; i < GSUBR_REQ(typ) + GSUBR_OPT(typ); i++) { - if NIMP(args) { + if (NIMP(args)) { v[i] = CAR(args); args = CDR(args); } else v[i] = UNDEFINED; } - if GSUBR_REST(typ) + if (GSUBR_REST(typ)) v[i] = args; else ASRTGO(NULLP(args), wnargs); diff --git a/hobbit.info b/hobbit.info index d775565..9f124f3 100644 --- a/hobbit.info +++ b/hobbit.info @@ -138,7 +138,7 @@ File: hobbit.info, Node: Compiling And Linking, Next: Error Detection, Prev: (lambda (fp) (for-each (lambda (string) (write-line string fp)) - '("#define IMPLINIT \"Init5e1.scm\"" + '("#define IMPLINIT \"Init5e2.scm\"" "#define BIGNUMS" "#define FLOATS" "#define ARRAYS" @@ -190,7 +190,7 @@ File: hobbit.info, Node: Compiling And Linking, Next: Error Detection, Prev: (lambda (fp) (for-each (lambda (string) (write-line string fp)) - '("#define IMPLINIT \"Init5e1.scm\"" + '("#define IMPLINIT \"Init5e2.scm\"" "#define COMPILED_INITS init_example();" "#define CCLO" "#define FLOATS")))) @@ -242,7 +242,7 @@ setcar setcdr listp list length append reverse list-ref memq memv
member assq assv assoc symbolp symbol2string string2symbol numberp exactp
inexactp eqp lessp zerop positivep negativep oddp evenp lmax lmin sum
- product difference lquotient absval remainder lremainder modulo lgcd llcm
+ product difference lquotient scm_abs remainder lremainder modulo lgcd llcm
number2string
;;; string2number
makdbl istr2flo mkbig long2big dbl2big
@@ -2492,7 +2492,7 @@ (@copy-tree "copytree" 1)
(exact? "exactp" 1) (inexact? "inexactp" 1)
- (odd? "oddp" 1) (even? "evenp" 1) (max "lmax" 2) (min "lmin" 2) (abs "absval" 1)
+ (odd? "oddp" 1) (even? "evenp" 1) (max "lmax" 2) (min "lmin" 2) (abs "scm_abs" 1)
(quotient "lquotient" 2) (remainder "lremainder" 2)
(modulo "modulo" 2) (gcd "lgcd" 2) (lcm "llcm" 2)
@@ -2511,7 +2511,7 @@ (inexact->exact "in2ex" 1)
(make-rectangular "makrect" 2) (make-polar "makpolar" 2)
(real-part "real_part" 1) (imag-part "imag_part" 1)
- (magnitude "magnitude" 1) (angle "angle" 1)
+ (magnitude "scm_magnitude" 1) (angle "angle" 1)
(number->string "number2string" 2) (string->number "string2number" 1)
@@ -93,6 +93,9 @@ SCM stat2scm P((struct stat *stat_temp)); #ifdef __MACH__ # include <unistd.h> #endif +#ifdef __CYGWIN__ +# include <unistd.h> +#endif #ifndef STDC_HEADERS int chdir P((const char *path)); @@ -136,7 +139,7 @@ SCM read_line(port) sizet len = 30; SCM tok_buf = makstr((long) len); register char *p = CHARS(tok_buf); - if UNBNDP(port) port = cur_inp; + if (UNBNDP(port)) port = cur_inp; else ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_line); if (EOF==(c = lgetc(port))) return EOF_VAL; while(1) { @@ -167,7 +170,7 @@ SCM read_line1(str, port) ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_read_line1); p = CHARS(str); len = LENGTH(str); - if UNBNDP(port) port = cur_inp; + if (UNBNDP(port)) port = cur_inp; else ASRTER(NIMP(port) && OPINPORTP(port), port, ARG2, s_read_line1); c = lgetc(port); if (EOF==c) return EOF_VAL; @@ -202,7 +205,7 @@ SCM file_position(port) long ans; ASRTER(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_position); SYSCALL(ans = ftell(STREAM(port));); - if CRDYP(port) ans--; + if (CRDYP(port)) ans--; return MAKINUM(ans); } SCM file_set_position(port, pos) @@ -367,7 +370,7 @@ SCM l_closedir(port) int sts; ASRTER(DIRP(port), port, ARG1, s_closedir); DEFER_INTS; - if CLOSEDP(port) {ALLOW_INTS;return BOOL_F;} + if (CLOSEDP(port)) {ALLOW_INTS;return BOOL_F;} SYSCALL(sts = closedir((DIR *)CDR(port));); if (sts) {ALLOW_INTS; return BOOL_F;} CAR(port) = tc16_dir; @@ -384,10 +387,10 @@ int dir_print(sexp, port, writing) sizet dir_free(p) CELLPTR p; { - if OPENP((SCM)p) closedir((DIR *)CDR((SCM)p)); + if (OPENP((SCM)p)) closedir((DIR *)CDR((SCM)p)); return 0; } -# define dir_mark mark0 +# define dir_mark mark0 # else /* _WIN32 */ struct WDIR { long handle; //-1 if at end of list. @@ -464,7 +467,7 @@ SCM l_closedir(port) ASRTER(DIRP(port), port, ARG1, s_closedir); wdir = (struct WDIR*)CHARS(port); DEFER_INTS; - if CLOSEDP(port) {ALLOW_INTS;return BOOL_F;} + if (CLOSEDP(port)) {ALLOW_INTS;return BOOL_F;} if (-1 != wdir->handle) { SYSCALL(_findclose(wdir->handle);); wdir->handle = -1; @@ -624,7 +627,7 @@ SCM ren_fil(oldname, newname) SYSCALL(ans = link(CHARS(oldname), CHARS(newname)) ? BOOL_F : BOOL_T;); if (!FALSEP(ans)) { SYSCALL(ans = unlink(CHARS(oldname)) ? BOOL_F : BOOL_T;); - if FALSEP(ans) + if (FALSEP(ans)) SYSCALL(unlink(CHARS(newname));); /* unlink failed. remove new name */ } ALLOW_INTS; @@ -654,7 +657,7 @@ SCM l_access(pathname, mode) int val; int imodes; ASRTER(NIMP(pathname) && STRINGP(pathname), pathname, ARG1, s_access); - if INUMP(mode) imodes = INUM(mode); + if (INUMP(mode)) imodes = INUM(mode); else { ASRTER(NIMP(mode) && STRINGP(mode), mode, ARG2, s_access); imodes = F_OK | (strchr(CHARS(mode), 'r') ? R_OK : 0) @@ -674,9 +677,9 @@ SCM l_stat(str) { int i; struct stat stat_temp; - if IMP(str) + if (IMP(str)) badarg1: wta(str, (char *)ARG1, s_stat); - if STRINGP(str) {SYSCALL(i = stat(CHARS(str), &stat_temp););} + if (STRINGP(str)) {SYSCALL(i = stat(CHARS(str), &stat_temp););} else { # ifndef MCH_AMIGA if (!OPFPORTP(str)) goto badarg1; @@ -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=5e1 +VERSION=5e2 #endif #ifndef SCMVERSION -# define SCMVERSION "5e1" +# define SCMVERSION "5e2" #endif #ifdef nosve # define INIT_FILE_NAME "Init"SCMVERSION"_scm"; @@ -178,8 +178,8 @@ SCM l_pwinfo(user) struct passwd *entry; SCM *ve = VELTS(ans); DEFER_INTS; - if UNBNDP(user) SYSCALL(entry = getpwent();); - else if INUMP(user) SYSCALL(entry = getpwuid(INUM(user));); + if (UNBNDP(user)) SYSCALL(entry = getpwent();); + else if (INUMP(user)) SYSCALL(entry = getpwuid(INUM(user));); else { ASRTER(NIMP(user) && STRINGP(user), user, ARG1, s_pwinfo); SYSCALL(entry = getpwnam(CHARS(user));); @@ -204,8 +204,8 @@ SCM l_grinfo(name) struct group *entry; SCM *ve = VELTS(ans); DEFER_INTS; - if UNBNDP(name) SYSCALL(entry = getgrent();); - else if INUMP(name) SYSCALL(entry = getgrgid(INUM(name));); + if (UNBNDP(name)) SYSCALL(entry = getgrent();); + else if (INUMP(name)) SYSCALL(entry = getgrgid(INUM(name));); else { ASRTER(NIMP(name) && STRINGP(name), name, ARG1, s_grinfo); SYSCALL(entry = getgrnam(CHARS(name));); diff --git a/r4rstest.scm b/r4rstest.scm index 7768f03..d0842c5 100644 --- a/r4rstest.scm +++ b/r4rstest.scm @@ -482,7 +482,7 @@ (test #t exact? 3) (test #f inexact? 3) -;;(test 1 expt 0 0) +(test 1 expt 0 0) (test 0 expt 0 1) (test 0 expt 0 256) ;;(test 0 expt 0 -255) @@ -97,7 +97,7 @@ int ra_matchp(ra0, ras) sizet bas0 = 0; int i, ndim = 1; int exact = 2 /* 4 */; /* Don't care about values >2 (yet?) */ - if IMP(ra0) return 0; + if (IMP(ra0)) return 0; switch TYP7(ra0) { default: return 0; case tc7_vector: @@ -163,7 +163,7 @@ static char s_ra_mismatch[] = "array shape mismatch"; int ramapc(cproc, data, ra0, lra, what) int (*cproc)(); SCM data, ra0, lra; - char *what; + const char *what; { SCM z, vra0, ra1, vra1; SCM lvra, *plvra; @@ -174,7 +174,7 @@ int ramapc(cproc, data, ra0, lra, what) case 2: case 3: case 4: /* Try unrolling arrays */ if (kmax < 0) goto gencase; vra0 = (0==kmax ? ra0 : array_contents(ra0, UNDEFINED)); - if IMP(vra0) goto gencase; + if (IMP(vra0)) goto gencase; if (!ARRAYP(vra0)) { vra1 = make_ra(1); ARRAY_BASE(vra1) = 0; @@ -188,7 +188,7 @@ int ramapc(cproc, data, ra0, lra, what) plvra = &lvra; for (z = lra; NIMP(z); z = CDR(z)) { vra1 = ra1 = (0==kmax ? CAR(z) : array_contents(CAR(z), UNDEFINED)); - if FALSEP(ra1) goto gencase; + if (FALSEP(ra1)) goto gencase; if (!ARRAYP(ra1)) { vra1 = make_ra(1); ARRAY_DIMS(vra1)->lbnd = ARRAY_DIMS(vra0)->lbnd; @@ -212,7 +212,7 @@ int ramapc(cproc, data, ra0, lra, what) indv = (long *)VELTS(hp_indv); } vra0 = make_ra(1); - if ARRAYP(ra0) { + if (ARRAYP(ra0)) { if (kmax < 0) { ARRAY_DIMS(vra0)->lbnd = 0; ARRAY_DIMS(vra0)->ubnd = 0; @@ -241,7 +241,7 @@ int ramapc(cproc, data, ra0, lra, what) vra1 = make_ra(1); ARRAY_DIMS(vra1)->lbnd = ARRAY_DIMS(vra0)->lbnd; ARRAY_DIMS(vra1)->ubnd = ARRAY_DIMS(vra0)->ubnd; - if ARRAYP(ra1) { + if (ARRAYP(ra1)) { if (kmax >= 0) ARRAY_DIMS(vra1)->inc = ARRAY_DIMS(ra1)[kmax].inc; ARRAY_V(vra1) = ARRAY_V(ra1); @@ -514,7 +514,7 @@ SCM sc2array(s, ra, prot) { SCM res; ASRTER(NIMP(ra), ra, ARG2, s_sc2array); - if ARRAYP(ra) { + if (ARRAYP(ra)) { int k = ARRAY_NDIM(ra); res = make_ra(k); while (k--) { @@ -545,7 +545,7 @@ SCM sc2array(s, ra, prot) if (BOOL_T==s || BOOL_F==s) break; goto mismatch; case tc7_string: - if ICHRP(s) break; + if (ICHRP(s)) break; goto mismatch; case tc7_uvect: if (INUMP(s) && INUM(s)>=0) break; @@ -554,7 +554,7 @@ SCM sc2array(s, ra, prot) #endif goto mismatch; case tc7_ivect: - if INUMP(s) break; + if (INUMP(s)) break; #ifdef BIGDIG if (NIMP(s) && BIGP(s) && NUMDIGS(s)<=DIGSPERLONG) break; #endif @@ -565,7 +565,7 @@ SCM sc2array(s, ra, prot) if (NUMBERP(s) && !(NIMP(s) && CPLXP(s))) break; goto mismatch; case tc7_cvect: - if NUMBERP(s) break; + if (NUMBERP(s)) break; goto mismatch; #endif mismatch: ARRAY_V(res) = make_vector(MAKINUM(1), s); @@ -592,33 +592,33 @@ int ra_eqp(ra0, ras) default: { SCM e1 = UNDEFINED, e2 = UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if BVE_REF(ra0, i0) - if FALSEP(eqp(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2))) + if (BVE_REF(ra0, i0)) + if (FALSEP(eqp(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2)))) BVE_CLR(ra0, i0); break; } case tc7_uvect: case tc7_ivect: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if BVE_REF(ra0, i0) + if (BVE_REF(ra0, i0)) if (VELTS(ra1)[i1] != VELTS(ra2)[i2]) BVE_CLR(ra0, i0); break; # ifdef FLOATS case tc7_fvect: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if BVE_REF(ra0, i0) + if (BVE_REF(ra0, i0)) if (((float *)VELTS(ra1))[i1] != ((float *)VELTS(ra2))[i2]) BVE_CLR(ra0, i0); break; case tc7_dvect: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if BVE_REF(ra0, i0) + if (BVE_REF(ra0, i0)) if (((double *)VELTS(ra1))[i1] != ((double *)VELTS(ra2))[i2]) BVE_CLR(ra0, i0); break; case tc7_cvect: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if BVE_REF(ra0, i0) + if (BVE_REF(ra0, i0)) if (((double *)VELTS(ra1))[2*i1] != ((double *)VELTS(ra2))[2*i2] || ((double *)VELTS(ra1))[2*i1+1] != ((double *)VELTS(ra2))[2*i2+1]) BVE_CLR(ra0, i0); @@ -644,7 +644,7 @@ static int ra_compare(ra0, ra1, ra2, opt) default: { SCM e1 = UNDEFINED, e2 = UNDEFINED; for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if BVE_REF(ra0, i0) + if (BVE_REF(ra0, i0)) if (opt ? NFALSEP(lessp(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2))) : FALSEP(lessp(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2))) ) @@ -653,7 +653,7 @@ static int ra_compare(ra0, ra1, ra2, opt) } case tc7_uvect: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) { - if BVE_REF(ra0, i0) + if (BVE_REF(ra0, i0)) if (opt ? ((unsigned long*)VELTS(ra1))[i1] < ((unsigned long*)VELTS(ra2))[i2] : ((unsigned long*)VELTS(ra1))[i1] >= ((unsigned long*)VELTS(ra2))[i2]) @@ -662,7 +662,7 @@ static int ra_compare(ra0, ra1, ra2, opt) break; case tc7_ivect: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) { - if BVE_REF(ra0, i0) + if (BVE_REF(ra0, i0)) if (opt ? VELTS(ra1)[i1] < VELTS(ra2)[i2] : VELTS(ra1)[i1] >= VELTS(ra2)[i2]) @@ -672,7 +672,7 @@ static int ra_compare(ra0, ra1, ra2, opt) # ifdef FLOATS case tc7_fvect: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if BVE_REF(ra0, i0) + if (BVE_REF(ra0, i0)) if (opt ? ((float *)VELTS(ra1))[i1] < ((float *)VELTS(ra2))[i2] : ((float *)VELTS(ra1))[i1] >= ((float *)VELTS(ra2))[i2]) @@ -680,7 +680,7 @@ static int ra_compare(ra0, ra1, ra2, opt) break; case tc7_dvect: for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if BVE_REF(ra0, i0) + if (BVE_REF(ra0, i0)) if (opt ? ((double *)VELTS(ra1))[i1] < ((double *)VELTS(ra2))[i2] : ((double *)VELTS(ra1))[i1] >= ((double *)VELTS(ra2))[i2]) @@ -718,7 +718,7 @@ int ra_sum(ra0, ras) sizet i0 = ARRAY_BASE(ra0); long inc0 = ARRAY_DIMS(ra0)->inc; ra0 = ARRAY_V(ra0); - if NNULLP(ras) { + if (NNULLP(ras)) { SCM ra1 = CAR(ras); sizet i1 = ARRAY_BASE(ra1); long inc1 = ARRAY_DIMS(ra1)->inc; @@ -794,7 +794,7 @@ int ra_difference(ra0, ras) sizet i0 = ARRAY_BASE(ra0); long inc0 = ARRAY_DIMS(ra0)->inc; ra0 = ARRAY_V(ra0); - if NULLP(ras) { + if (NULLP(ras)) { switch TYP7(ra0) { default: { SCM e0 = UNDEFINED; @@ -907,7 +907,7 @@ int ra_product(ra0, ras) sizet i0 = ARRAY_BASE(ra0); long inc0 = ARRAY_DIMS(ra0)->inc; ra0 = ARRAY_V(ra0); - if NNULLP(ras) { + if (NNULLP(ras)) { SCM ra1 = CAR(ras); sizet i1 = ARRAY_BASE(ra1); long inc1 = ARRAY_DIMS(ra1)->inc; @@ -984,7 +984,7 @@ int ra_divide(ra0, ras) sizet i0 = ARRAY_BASE(ra0); long inc0 = ARRAY_DIMS(ra0)->inc; ra0 = ARRAY_V(ra0); - if NULLP(ras) { + if (NULLP(ras)) { switch TYP7(ra0) { default: { SCM e0 = UNDEFINED; @@ -1168,8 +1168,8 @@ static int ramap_rp(ra0, proc, ras) ra1 = ARRAY_V(ra1); ra2 = ARRAY_V(ra2); for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if BVE_REF(ra0, i0) - if FALSEP(SUBRF(proc)(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2))) + if (BVE_REF(ra0, i0)) + if (FALSEP(SUBRF(proc)(RVREF(ra1, i1, e1), RVREF(ra2, i2, e2)))) BVE_CLR(ra0, i0); return 1; } @@ -1202,7 +1202,7 @@ static int ramap_2o(ra0, proc, ras) ra0 = ARRAY_V(ra0); ra1 = ARRAY_V(ra1); ras = CDR(ras); - if NULLP(ras) { + if (NULLP(ras)) { if (tc7_vector==TYP7(ra0)) for (; n-- > 0; i0 += inc0, i1 += inc1) VELTS(ra0)[i0] = SUBRF(proc)(cvref(ra1, i1, UNDEFINED), UNDEFINED); @@ -1237,7 +1237,7 @@ static int ramap_a(ra0, proc, ras) sizet i0 = ARRAY_BASE(ra0); long inc0 = ARRAY_DIMS(ra0)->inc; ra0 = ARRAY_V(ra0); - if NULLP(ras) + if (NULLP(ras)) for (; n-- > 0; i0 += inc0) aset(ra0, SUBRF(proc)(RVREF(ra0, i0, e0), UNDEFINED), MAKINUM(i0)); else { @@ -1314,9 +1314,9 @@ SCM array_map(ra0, proc, lra) return UNSPECIFIED; } case tc7_asubr: - if NULLP(lra) { + if (NULLP(lra)) { SCM prot, fill = SUBRF(proc)(UNDEFINED, UNDEFINED); - if INUMP(fill) { + if (INUMP(fill)) { prot = array_prot(ra0); # ifdef FLOATS if (NIMP(prot) && INEXP(prot)) @@ -1353,7 +1353,7 @@ SCM array_map(ra0, proc, lra) } ramapc(ramap_2o, proc, ra0, lra, s_array_map); lra = CDR(lra); - if NIMP(lra) + if (NIMP(lra)) for (lra = CDR(lra); NIMP(lra); lra = CDR(lra)) ramapc(ramap_a, proc, ra0, lra, s_array_map); } @@ -1506,13 +1506,13 @@ static int raeql_1(ra0, as_equal, ra1) long inc0 = 1, inc1 = 1; sizet n = LENGTH(ra0); ra1 = CAR(ra1); - if ARRAYP(ra0) { + if (ARRAYP(ra0)) { n = ARRAY_DIMS(ra0)->ubnd - ARRAY_DIMS(ra0)->lbnd + 1; i0 = ARRAY_BASE(ra0); inc0 = ARRAY_DIMS(ra0)->inc; ra0 = ARRAY_V(ra0); } - if ARRAYP(ra1) { + if (ARRAYP(ra1)) { i1 = ARRAY_BASE(ra1); inc1 = ARRAY_DIMS(ra1)->inc; ra1 = ARRAY_V(ra1); @@ -1520,12 +1520,12 @@ static int raeql_1(ra0, as_equal, ra1) switch TYP7(ra0) { case tc7_vector: default: for (; n--; i0+=inc0, i1+=inc1) { - if FALSEP(as_equal) { - if FALSEP(array_equal(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1))) + if (FALSEP(as_equal)) { + if (FALSEP(array_equal(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)))) return 0; } else - if FALSEP(equal(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1))) + if (FALSEP(equal(RVREF(ra0, i0, e0), RVREF(ra1, i1, e1)))) return 0; } return 1; @@ -1582,7 +1582,7 @@ static int raeql(ra0, as_equal, ra1) array_dim *s0 = &dim0, *s1 = &dim1; sizet bas0 = 0, bas1 = 0; int k, unroll = 1, ndim = 1; - if ARRAYP(ra0) { + if (ARRAYP(ra0)) { ndim = ARRAY_NDIM(ra0); s0 = ARRAY_DIMS(ra0); bas0 = ARRAY_BASE(ra0); @@ -1591,7 +1591,7 @@ static int raeql(ra0, as_equal, ra1) else { s0->inc = 1; s0->lbnd = 0; s0->ubnd = LENGTH(v0) - 1; } - if ARRAYP(ra1) { + if (ARRAYP(ra1)) { if (ndim != ARRAY_NDIM(ra1)) return 0; s1 = ARRAY_DIMS(ra1); bas1 = ARRAY_BASE(ra1); @@ -125,7 +125,7 @@ SCM rec_constr(rtd, flds) RCLO_RTD(cclo) = rtd; i = ilength(RTD_FIELDS(rtd)); RCONSTR_SIZE(cclo) = MAKINUM(i); - if UNBNDP(flds) { + if (UNBNDP(flds)) { indices = MAKE_REC_INDS(i); while (i--) REC_IND_SET(indices, i, i+1); } @@ -199,7 +199,7 @@ SCM rec_constr1(args) A cclo with 2 env elts -- rtd and field-number. */ static SCM makrecclo(proc, rtd, field, what) SCM proc, rtd, field; - char *what; + const char *what; { SCM flst; SCM cclo = makcclo(proc, 3L); @@ -286,7 +286,7 @@ static SCM markrec(ptr) { sizet i; for (i = NUMDIGS(ptr); --i;) - if NIMP(VELTS(ptr)[i]) gc_mark(VELTS(ptr)[i]); + if (NIMP(VELTS(ptr)[i])) gc_mark(VELTS(ptr)[i]); return REC_RTD(ptr); } static sizet freerec(ptr) @@ -302,7 +302,7 @@ static int recprin1(exp, port, writing) SCM names, printer = RTD_PRINTER(REC_RTD(exp)); SCM argv[3]; sizet i; - if NIMP(printer) { + if (NIMP(printer)) { argv[0] = exp; argv[1] = port; argv[2] = writing ? BOOL_T : BOOL_F; @@ -369,7 +369,7 @@ SCM recequal(rec0, rec1) if (i != NUMDIGS(rec1)) return BOOL_F; if (REC_RTD(rec0) != REC_RTD(rec1)) return BOOL_F; while(--i) - if FALSEP(equal(VELTS(rec0)[i], VELTS(rec1)[i])) + if (FALSEP(equal(VELTS(rec0)[i], VELTS(rec1)[i]))) return BOOL_F; return BOOL_T; } @@ -44,12 +44,12 @@ #include "scm.h" #include "setjump.h" -void igc P((char *what, STACKITEM *stackbase)); +void igc P((const char *what, STACKITEM *stackbase)); void unexec P((char *new_name, char *a_name, unsigned data_start, unsigned bss_start, unsigned entry_address)); void scm_fill_freelist P((void)); -#ifdef __CYGWIN32__ +#ifdef __CYGWIN__ # include <sys/types.h> #endif @@ -155,7 +155,7 @@ static char s_freshline[] = "freshline"; static char s_eofin[] = "end of file in "; static char s_unknown_sharp[] = "unknown # object"; -static SCM lread1 P((SCM port, int flgs, char *what)); +static SCM lread1 P((SCM port, int flgs, const char *what)); static SCM lreadr P((SCM tok_buf, SCM port, int flgs)); static SCM lreadpr P((SCM tok_buf, SCM port, int flgs)); static SCM lreadparen P((SCM tok_buf, SCM port, int flgs, char *name)); @@ -203,12 +203,12 @@ void iprlist(hdr, exp, tlr, port, writing) exp = GCCDR(exp); /* CDR(exp); */ for(;NIMP(exp);exp = GCCDR(exp) /* CDR(exp)*/) { if (!scm_cell_p(~1L & exp)) break; - if NECONSP(exp) break; + if (NECONSP(exp)) break; lputc(' ', port); /* CHECK_INTS; */ iprin1(CAR(exp), port, writing); } - if NNULLP(exp) { + if (NNULLP(exp)) { lputs(" . ", port); iprin1(exp, port, writing); } @@ -227,7 +227,7 @@ taloop: intprint(INUM(exp), 10, port); break; case 4: - if ICHRP(exp) { + if (ICHRP(exp)) { i = ICHR(exp); if (writing) lputs("#\\", port); if (!writing) lputc((int)i, port); @@ -247,7 +247,7 @@ taloop: } else if (IFLAGP(exp) && (ISYMNUM(exp)<(sizeof isymnames/sizeof(char *)))) lputs(ISYMCHARS(exp), port); - else if ILOCP(exp) { + else if (ILOCP(exp)) { lputs("#@", port); intprint((long)IFRAME(exp), -10, port); lputc(ICDRP(exp)?'-':'+', port); @@ -470,7 +470,7 @@ static int input_waiting(f) SCM char_readyp(port) SCM port; { - if UNBNDP(port) port = cur_inp; + if (UNBNDP(port)) port = cur_inp; ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_char_readyp); if (CRDYP(port) || !(BUF0 & SCM_PORTFLAGS(port))) return BOOL_T; return input_waiting(STREAM(port)) ? BOOL_T : BOOL_F; @@ -500,7 +500,7 @@ SCM wait_for_input(args) ASRTER(!NULLP(args), INUM0, WNA, s_wfi); how_long = CAR(args); args = CDR(args); - if NULLP(args) port1 = cur_inp; + if (NULLP(args)) port1 = cur_inp; else { port1 = CAR(args); args = CDR(args); @@ -595,7 +595,7 @@ static SCM *loc_broken_pipe = 0; /* returning non-zero means try again. */ int scm_io_error(port, what) SCM port; - char *what; + const char *what; { #ifdef HAVE_PIPE # ifdef EPIPE @@ -636,7 +636,7 @@ static char s_flush[] = "force-output"; SCM lflush(port) /* user accessible as force-output */ SCM port; { - if UNBNDP(port) port = cur_outp; + if (UNBNDP(port)) port = cur_outp; else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_flush); { sizet i = PTOBNUM(port); @@ -650,7 +650,7 @@ SCM lflush(port) /* user accessible as force-output */ SCM lwrite(obj, port) SCM obj, port; { - if UNBNDP(port) port = cur_outp; + if (UNBNDP(port)) port = cur_outp; else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write); iprin1(obj, port, 1); return UNSPECIFIED; @@ -658,7 +658,7 @@ SCM lwrite(obj, port) SCM display(obj, port) SCM obj, port; { - if UNBNDP(port) port = cur_outp; + if (UNBNDP(port)) port = cur_outp; else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_display); iprin1(obj, port, 0); return UNSPECIFIED; @@ -666,7 +666,7 @@ SCM display(obj, port) SCM newline(port) SCM port; { - if UNBNDP(port) port = cur_outp; + if (UNBNDP(port)) port = cur_outp; else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_newline); lputc('\n', port); if (port==cur_outp) lfflush(port); @@ -675,7 +675,7 @@ SCM newline(port) SCM write_char(chr, port) SCM chr, port; { - if UNBNDP(port) port = cur_outp; + if (UNBNDP(port)) port = cur_outp; else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write_char); ASRTER(ICHRP(chr), chr, ARG1, s_write_char); lputc((int)ICHR(chr), port); @@ -684,7 +684,7 @@ SCM write_char(chr, port) SCM scm_freshline(port) SCM port; { - if UNBNDP(port) port = cur_outp; + if (UNBNDP(port)) port = cur_outp; else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_freshline); if (INUM0==scm_port_col(port)) return UNSPECIFIED; lputc('\n', port); @@ -713,7 +713,7 @@ void lputc(c, port) } } void lputs(s, port) - char *s; + const char *s; SCM port; { sizet i = PTOBNUM(port); @@ -817,7 +817,7 @@ SCM scm_read_char(port) SCM port; { int c; - if UNBNDP(port) port = cur_inp; + if (UNBNDP(port)) port = cur_inp; ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_char); c = lgetc(port); if (EOF==c) return EOF_VAL; @@ -827,7 +827,7 @@ SCM peek_char(port) SCM port; { int c; - if UNBNDP(port) port = cur_inp; + if (UNBNDP(port)) port = cur_inp; else ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_peek_char); c = lgetc(port); if (EOF==c) return EOF_VAL; @@ -888,11 +888,11 @@ SCM scm_read_numbered(port) static SCM lread1(port, flgs, what) SCM port; int flgs; - char *what; + const char *what; { int c; SCM tok_buf; - if UNBNDP(port) port = cur_inp; + if (UNBNDP(port)) port = cur_inp; ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, what); do { c = flush_ws(port); @@ -972,7 +972,7 @@ static SCM lreadpr(tok_buf, port, flgs) if (loc_charsharp && NIMP(*loc_charsharp)) { resizuve(tok_buf, MAKINUM(j)); p = apply(*loc_charsharp, tok_buf, listofnull); - if ICHRP(p) return p; + if (ICHRP(p)) return p; } wta(UNDEFINED, "unknown # object: #\\", CHARS(tok_buf)); case '|': @@ -1040,7 +1040,7 @@ static SCM lreadpr(tok_buf, port, flgs) num: j = read_token(c, tok_buf, port); p = istring2number(CHARS(tok_buf), (long)j, 10L); - if NFALSEP(p) return p; + if (NFALSEP(p)) return p; if (c=='#') { if ((j==2) && (lgetc(port)=='(')) { lungetc('(', port); @@ -1297,7 +1297,7 @@ int handle_it(i) ALLOW_INTS; /* discarding was necessary here because intern() may do NEWCELL */ proc = CDR(intern(name, (sizet)strlen(name))); - if NIMP(proc) { /* Save environment stack, in case it moves + if (NIMP(proc)) { /* Save environment stack, in case it moves when applying proc. Do an ecache gc to protect contents of stack. */ SCM estk, *estk_ptr, env, env_tmp; @@ -1357,7 +1357,7 @@ SCM scm_top_level(initpath, toplvl_fun) char *name = errmsgs[i-WNA].s_response; if (name) { SCM proc = CDR(intern(name, (sizet)strlen(name))); - if NIMP(proc) apply(proc, EOL, EOL); + if (NIMP(proc)) apply(proc, EOL, EOL); }} i = errmsgs[i-WNA].parent_err; if (i) goto drloop; @@ -1388,7 +1388,7 @@ SCM scm_top_level(initpath, toplvl_fun) { SCM boot_tail = scm_evstr("boot-tail"); /* initialization tail-call */ - if NIMP(boot_tail) + if (NIMP(boot_tail)) apply(boot_tail, (dumped ? makfrom0str(initpath) : BOOL_F), listofnull); } case -2: /* abrt */ @@ -1420,7 +1420,7 @@ SCM scm_top_level(initpath, toplvl_fun) ints_disabled = 0; dowinds(EOL); ret = toplvl_fun(); /* typically repl() */ - if INUMP(ret) exitval = ret; + if (INUMP(ret)) exitval = ret; err_pos = (char *)EXIT; i = EXIT; goto drloop; /* encountered EOF on stdin */ @@ -1536,7 +1536,7 @@ void growth_mon(obj, size, units, grewp) } void gc_start(what) - char *what; + const char *what; { if (verbose > 4) { lputs(";GC(", sys_errp); @@ -1686,7 +1686,7 @@ SCM prolixity(arg) { int old = verbose; if (!UNBNDP(arg)) { - if FALSEP(arg) scm_verbose = 1; + if (FALSEP(arg)) scm_verbose = 1; else scm_verbose = INUM(arg); } return MAKINUM(old); @@ -1701,7 +1701,7 @@ SCM repl() if (OPINPORTP(cur_inp) && OPOUTPORTP(cur_outp)) { repl_report(); while(1) { - if OPOUTPORTP(cur_inp) { /* This case for curses window */ + if (OPOUTPORTP(cur_inp)) { /* This case for curses window */ lfflush(cur_outp); if (verbose) lputs(PROMPT, cur_inp); lfflush(cur_inp); @@ -1728,7 +1728,7 @@ SCM repl() #endif #ifdef __MSDOS__ if ('\n' != CGETUN(cur_inp)) - if OPOUTPORTP(cur_inp) /* This case for curses window */ + if (OPOUTPORTP(cur_inp)) /* This case for curses window */ {lfflush(cur_outp); newline(cur_inp);} else newline(cur_outp); #endif @@ -1761,7 +1761,7 @@ SCM quit(n) SCM n; { if (UNBNDP(n) || BOOL_T==n) n = MAKINUM(EXIT_SUCCESS); - if INUMP(n) exitval = n; + if (INUMP(n)) exitval = n; else exitval = MAKINUM(EXIT_FAILURE); if (errjmp_bad) exit(INUM(exitval)); longjump(CONT(rootcont)->jmpbuf, COOKIE(-1)); @@ -1852,7 +1852,7 @@ SCM tryload(filename, reader) SCM form, port; SCM env = EOL; port = open_file(filename, makfromstr("r?", (sizet)2*sizeof(char))); - if FALSEP(port) return port; + if (FALSEP(port)) return port; *loc_loadpath = filename; loadports = cons(port, loadports); #ifdef SCM_ENV_FILENAME @@ -1918,7 +1918,7 @@ void scm_line_msg(file, linum, port) lputs(": ", port); } void scm_err_line(what, file, linum, port) - char *what; + const char *what; SCM file, linum, port; { lputs(what, port); @@ -1983,7 +1983,7 @@ SCM lerrno(arg) { int old = errno; if (!UNBNDP(arg)) { - if FALSEP(arg) errno = 0; + if (FALSEP(arg)) errno = 0; else errno = INUM(arg); } return MAKINUM(old); @@ -2055,8 +2055,8 @@ static void def_err_response() if (codep) scm_princode(obj, EOL, sys_safep, writing); else iprin1(obj, sys_safep, writing); } - if UNBNDP(err_exp) goto getout; - if NIMP(err_exp) { + if (UNBNDP(err_exp)) goto getout; + if (NIMP(err_exp)) { if (reset_safeport(sys_safep, 55, cur_errp)) if (0==setjmp(SAFEP_JMPBUF(sys_safep))) { lputs("\n; in expression: ", cur_errp); @@ -2093,7 +2093,7 @@ static void def_err_response() } void everr(exp, env, arg, pos, s_subr, codep) SCM exp, env, arg; - char *pos, *s_subr; + const char *pos, *s_subr; int codep; { err_exp = exp; @@ -2110,7 +2110,7 @@ void everr(exp, env, arg, pos, s_subr, codep) } void wta(arg, pos, s_subr) SCM arg; - char *pos, *s_subr; + const char *pos, *s_subr; { #ifndef RECKLESS everr(scm_trace, scm_trace_env, arg, pos, s_subr, 0); @@ -2120,7 +2120,7 @@ void wta(arg, pos, s_subr) } void scm_experr(arg, pos, s_subr) SCM arg; - char *pos, *s_subr; + const char *pos, *s_subr; { #ifndef RECKLESS everr(scm_trace, scm_trace_env, arg, pos, s_subr, !0); @@ -101,14 +101,14 @@ unsigned long num2ulong(num, pos, s_caller) char *pos, *s_caller; { unsigned long res; - if INUMP(num) { + if (INUMP(num)) { ASRTGO(0 < num, errout); res = INUM((unsigned long)num); return res; } ASRTGO(NIMP(num), errout); #ifdef FLOATS - if REALP(num) { + if (REALP(num)) { double u = REALPART(num); if ((0 <= u) && (u <= (unsigned long)~0L)) { res = u; @@ -132,13 +132,13 @@ long num2long(num, pos, s_caller) char *pos, *s_caller; { long res; - if INUMP(num) { + if (INUMP(num)) { res = INUM((long)num); return res; } ASRTGO(NIMP(num), errout); # ifdef FLOATS - if REALP(num) { + if (REALP(num)) { double u = REALPART(num); if (((MOST_NEGATIVE_FIXNUM * 4) <= u) && (u <= (MOST_POSITIVE_FIXNUM * 4 + 3))) { @@ -148,7 +148,7 @@ long num2long(num, pos, s_caller) } # endif # ifdef BIGDIG - if BIGP(num) { + if (BIGP(num)) { sizet l = NUMDIGS(num); ASRTGO(DIGSPERLONG >= l, errout); res = 0; @@ -173,11 +173,12 @@ double num2dbl(num, pos, s_caller) SCM num; char *pos, *s_caller; { - if INUMP(num) return (double)INUM(num); + if (INUMP(num)) return (double)INUM(num); ASRTGO(NIMP(num), errout); - if REALP(num) return REALPART(num); + if (REALP(num)) return REALPART(num); + if (scm_narn==num) return REALPART(num); #ifdef BIGDIG - if BIGP(num) return big2dbl(num); + if (BIGP(num)) return big2dbl(num); #endif errout: wta(num, pos, s_caller); } @@ -185,7 +186,7 @@ double num2dbl(num, pos, s_caller) /* Convert (arrays of) strings to SCM */ SCM makfromstr(src, len) - char *src; + const char *src; sizet len; { SCM s; @@ -196,7 +197,7 @@ SCM makfromstr(src, len) return s; } SCM makfrom0str(src) - char *src; + const char *src; { if (!src) return BOOL_F; return makfromstr(src, (sizet) strlen(src)); @@ -205,7 +206,7 @@ SCM makfrom0str(src) /* If argc < 0, a null terminated array is assumed. */ SCM makfromstrs(argc, argv) int argc; - char **argv; + const char * const *argv; { int i = argc; SCM lst = EOL; @@ -217,9 +218,9 @@ SCM makfromstrs(argc, argv) /* INTS must be DEFERed around this call and the use of the returned array. */ char **makargvfrmstrs(args, s_name) SCM args; - char *s_name; + const char *s_name; { - char **argv; + char ** argv; int argc = ilength(args); argv = (char **)must_malloc((1L+argc)*sizeof(char *), s_vector); for(argc = 0; NNULLP(args); args=CDR(args), ++argc) { @@ -236,7 +237,7 @@ char **makargvfrmstrs(args, s_name) return argv; } void must_free_argv(argv) - char **argv; + const char * const *argv; { sizet i; for(i = 0; argv[i]; i++) { @@ -282,7 +283,7 @@ int scm_ldprog(path) /* Get byte address of SCM array */ #ifdef ARRAYS -long aind P((SCM ra, SCM args, char *what)); +long aind P((SCM ra, SCM args, const char *what)); unsigned long scm_addr(args, s_name) SCM args; char *s_name; @@ -293,18 +294,18 @@ unsigned long scm_addr(args, s_name) ASRTGO(NIMP(args), wna); v = CAR(args); args = CDR(args); - if IMP(v) {goto badarg;} - else if ARRAYP(v) { + if (IMP(v)) {goto badarg;} + else if (ARRAYP(v)) { pos = aind(v, args, s_name); v = ARRAY_V(v); } else { - if NIMP(args) { + if (NIMP(args)) { ASRTER(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_name); pos = INUM(CAR(args)); ASRTGO(NULLP(CDR(args)), wna); } - else if NULLP(args) pos = 0; + else if (NULLP(args)) pos = 0; else { ASRTER(INUMP(args), args, ARG2, s_name); pos = INUM(args); @@ -346,8 +347,8 @@ unsigned long scm_base_addr(v, s_name) { long pos = 0; unsigned long ptr = 0; /* gratuitous assignment squelches cc warn. */ - if IMP(v) {goto badarg;} - else if ARRAYP(v) { + if (IMP(v)) {goto badarg;} + else if (ARRAYP(v)) { pos = ARRAY_BASE(v); v = ARRAY_V(v); } @@ -394,13 +395,13 @@ int scm_cell_p(x) { register int i, j; register CELLPTR ptr; - if NCELLP(x) return 0; + if (NCELLP(x)) return 0; ptr = (CELLPTR)SCM2PTR(x); i = 0; j = hplim_ind; do { - if PTR_GT(hplims[i++], ptr) break; - if PTR_LE(hplims[--j], ptr) break; + if (PTR_GT(hplims[i++], ptr)) break; + if (PTR_LE(hplims[--j], ptr)) break; if ((i != j) && PTR_LE(hplims[i++], ptr) && PTR_GT(hplims[--j], ptr)) continue; @@ -419,7 +420,7 @@ SCM scm_gc_protect(obj) { long len; ASRTER(NIMP(scm_uprotects), MAKINUM(20), NALLOC, "protects"); - if IMP(obj) return obj; + if (IMP(obj)) return obj; for (len = LENGTH(scm_uprotects);len--;) { if (obj==VELTS(scm_uprotects)[len]) return obj; } diff --git a/rwb-isam.scm b/rwb-isam.scm new file mode 100644 index 0000000..962a97b --- /dev/null +++ b/rwb-isam.scm @@ -0,0 +1,616 @@ +;;; "rwb-isam.scm" Relational WB database with sequential indexes. +; Copyright 1996, 2000, 2001, 2003 Aubrey Jaffer +; +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, and to use it for any purpose is +;granted, subject to the following restrictions and understandings. +; +;1. Any copy made of this software must include this copyright notice +;in full. +; +;2. I have made no warranty or representation that the operation of +;this software will be error-free, and I am under no obligation to +;provide any services, by way of maintenance, update, or otherwise. +; +;3. In conjunction with products arising from the use of this +;material, there shall be no use of my name in any advertising, +;promotional, or sales literature without prior written consent in +;each case. + +;;;; *catalog* is informed of 'rwb-isam binding by "scm/mkimpcat.scm". +(require 'wb) +(require 'byte) +(require 'byte-number) +(require 'relational-database) ;for make-relational-system + +;;; WB-SEG:LOCKS has one extra location at end for loop end test +(defvar wb-seg:locks (let ((locks (make-vector (+ 1 wb:num-segs) #f))) + (do ((i (+ -2 (vector-length locks)) (+ -1 i))) + ((negative? i) locks) + (vector-set! locks i (make-arbiter i))))) +(defvar wb-seg:files (make-vector (+ 1 wb:num-segs) #f)) +(defvar wb-seg:roots (make-vector (+ 1 wb:num-segs) #f)) +(defvar wb-seg:mut?s (make-vector (+ 1 wb:num-segs) #f)) +;@ +(define rwb-isam + ;; foiled indentation so etags will recognize definitions + (let ((make-handle list) + (handle->base-id car) + (handle->bt cadr) + (catalog-id 0) + (free-id "") + (root-name "rwb") + (key:s255 (bytes 255)) + (key:col1 (bytes 1)) + (key:col0 (bytes 0)) + (key:null (bytes 0)) + + (key:col-field bytes)) + +;;;The least-upper-bound of a composite key. +(define (key:incr key) + (string-append key key:s255)) + +;;;Return key sans prefix and column suffix if first column. +(define (key:match-prefix? prefix ckey) + (define sdx (+ -1 (string-length ckey))) + (define prelen (string-length prefix)) + (and (<= prelen sdx) + (string=? prefix (substring ckey 0 prelen)) + (substring ckey prelen sdx))) + +;;;Detects when all match-keys given are false. +(define (list-all-false? lst) + (cond ((null? lst) #t) + ((car lst) #f) + (else (list-all-false? (cdr lst))))) + +;;; These two NTHCDR procedures replicate those in "comlist.scm". +(define (nthcdr k list) + (do ((i k (+ -1 i)) + (lst list (cdr lst))) + ((<= i 0) lst))) + +(define (butnthcdr k lst) + (cond ((or (zero? k) (null? lst)) '()) + (else (let ((ans (list (car lst)))) + (do ((lst (cdr lst) (cdr lst)) + (tail ans (cdr tail)) + (k (+ -2 k) (+ -1 k))) + ((or (negative? k) (null? lst)) ans) + (set-cdr! tail (list (car lst)))))))) + +;;;; Segments + +(define (find-free-seg) + (do ((i 0 (+ 1 i)) + (arb (vector-ref wb-seg:locks 0) + (vector-ref wb-seg:locks (+ 1 i)))) + ((or (not arb) (try-arbiter arb)) + (and arb i)))) +(define (release-seg seg) + (and seg + (release-arbiter (vector-ref wb-seg:locks seg)) + #f)) + +;;;; Create, open, write, sync, or close database. + +(define (seg-open-base seg filename writable?) + (vector-set! wb-seg:files seg filename) + (vector-set! wb-seg:mut?s seg writable?) + (vector-set! wb-seg:roots seg (open-db seg root-name)) + (cond ((wb:err? (vector-ref wb-seg:roots seg)) + (close-base seg) + #f) + (else seg))) + +;;; Because B-trees grow in depth only very slowly, we might as well +;;; put everything into one B-tree named "rwb". + +(define (make-base filename dim types) + (define seg (find-free-seg)) + (cond ((not seg) #f) + ((wb:err? (make-seg seg filename 2048)) (release-seg seg) #f) + ((wb:err? (open-seg seg filename 2)) (release-seg seg) #f) + ((or (wb:err? (bt:put! (create-db seg #\T root-name) free-id "1")) + (wb:err? (bt:put! (open-bt seg 0 1) "base-table" "rwb-isam"))) + (release-seg seg) + (slib:error 'make-base "couldn't modify new base" filename) + #f) + (else (seg-open-base seg filename #t)))) + +(define (open-base filename writable?) + (define seg (find-free-seg)) + (cond ((wb:err? (open-seg seg filename (if writable? 2 0))) + (release-seg seg) #f) + (else (seg-open-base seg filename writable?)))) + +(define (write-base seg filename) + (cond ((and filename + (equal? filename (vector-ref wb-seg:files seg))) + (let ((status (close-seg seg #f))) + (cond ((wb:err? status) #f) + ((wb:err? (open-seg seg filename 2)) #f) + (else #t)))) + (else + ;;(slib:error 'write-base "WB can't change database filename" filename) + #f))) + +(define (sync-base seg) + (and seg (write-base seg (vector-ref wb-seg:files seg)))) + +(define (close-base seg) + (cond ((wb:err? (close-seg seg #f)) + (let ((status (close-seg seg #t))) + (release-seg seg) + (not (wb:err? status)))) + (else (release-seg seg) #t))) + +;;;; Make, open, and destroy tables. + +(define (make-table seg dim types) + (and (vector-ref wb-seg:mut?s seg) + (let* ((tns (bt:rem (vector-ref wb-seg:roots seg) free-id)) + (base-id (and (string? tns) (string->number tns)))) + (cond ((not tns) + (slib:error 'make-table 'free-id "in use?") + #f) + ((not base-id) + (bt:put (vector-ref wb-seg:roots seg) free-id tns) + (slib:error 'make-table "free-id corrupted" base-id) + #f) + ((not (bt:put (vector-ref wb-seg:roots seg) + free-id + (number->string (+ 1 base-id)))) + (slib:error 'make-table "free-id lock broken") + #f) + (else base-id))))) + +;;; OPEN-TABLE allocates a new handle (in call to open-db) so each +;;; table handle will have its own last-block-used + +(define (open-table seg base-id dim types) + (define (base-id->prefix base-id) + (define nstr (number->string base-id)) + (string-append (string #\T (integer->char (string-length nstr))) + nstr + (string (integer->char 1) #\D))) + (make-handle (base-id->prefix base-id) + (open-db seg root-name))) + +(define (kill-table seg base-id dim types) + (let* ((handle (open-table seg base-id dim types)) + (prefix (handle->base-id handle))) + (not (wb:err? (bt:rem* (handle->bt handle) + prefix + (key:incr prefix)))))) + +;;;; Conversions from Scheme objects into and from strings. + +(define (object->wb-string type) + (case type + ((string) identity) + ((symbol) symbol->string) + ((integer number ordinal) number->string) + ((boolean) (lambda (b) (if b "T" "F"))) + ((c64) (lambda (x) (string-append (ieee-double->bytes (real-part x)) + (ieee-double->bytes (imag-part x))))) + ((c32) (lambda (x) (string-append (ieee-float->bytes (real-part x)) + (ieee-float->bytes (imag-part x))))) + ((r64) (lambda (x) (ieee-double->bytes x))) + ((r32) (lambda (x) (ieee-float->bytes x))) + ((s64) (lambda (n) (integer->bytes n -8))) + ((s32) (lambda (n) (integer->bytes n -4))) + ((s16) (lambda (n) (integer->bytes n -2))) + (( s8) (lambda (n) (integer->bytes n -1))) + ((u64) (lambda (n) (integer->bytes n 8))) + ((u32) (lambda (n) (integer->bytes n 4))) + ((u16) (lambda (n) (integer->bytes n 2))) + (( u8) (lambda (n) (integer->bytes n 1))) + ((atom) (lambda (obj) (if (not obj) "#f" (symbol->string obj)))) + ((expression) (lambda (obj) (call-with-output-string + (lambda (port) (write obj port))))) + (else #f))) + +(define (wb-string->object type) + (case type + ((string) identity) + ((symbol) string->symbol) + ((integer number ordinal) string->number) + ((boolean) (lambda (str) (not (equal? str "F")))) + ((c64) (lambda (str) (make-rectangular + (bytes->ieee-double (substring str 0 8)) + (bytes->ieee-double (substring str 8 16))))) + ((c32) (lambda (str) (make-rectangular + (bytes->ieee-float (substring str 0 4)) + (bytes->ieee-float (substring str 4 8))))) + ((r64) (lambda (str) (bytes->ieee-double str))) + ((r32) (lambda (str) (bytes->ieee-float str))) + ((s64) (lambda (str) (bytes->integer str -8))) + ((s32) (lambda (str) (bytes->integer str -4))) + ((s16) (lambda (str) (bytes->integer str -2))) + (( s8) (lambda (str) (bytes->integer str -1))) + ((u64) (lambda (str) (bytes->integer str 8))) + ((u32) (lambda (str) (bytes->integer str 4))) + ((u16) (lambda (str) (bytes->integer str 2))) + (( u8) (lambda (str) (bytes->integer str 1))) + ((atom) (lambda (str) (if (string-ci=? "#f" str) #f (string->symbol str)))) + ((expression) (lambda (str) (call-with-input-string str read))) + (else #f))) + +(define (supported-type? type) + (case type + ((ordinal atom integer number boolean string symbol expression + c64 c32 r64 r32 s64 s32 s16 s8 u64 u32 u16 u8) #t) + (else #f))) + +(define (supported-key-type? type) + (case type + ((atom ordinal integer number symbol string boolean + r64 r32 s64 s32 s16 s8 u64 u32 u16 u8) #t) + (else #f))) + +;;;; Keys + +;;;Keys are composed of one to many fields. +;;; +;;;* The binary number formats r64, r32, s64, s32, s16, s8, u64, u32, +;;; u16, and u8 have fixed widths and are encoded so that the key +;;; sort order is the same as numerical order. +;;; +;;;* Booleans occupy one byte: 'T' or 'F'. +;;; +;;;* Strings, symbols, and atoms (symbol or #f) are variable width +;;; fields terminated by a null byte. They sort in lexicographic +;;; (dictionary) order. A #f atom is represented by the null string. +;;; +;;;* The integer, number, and ordinal formats are strings of decimal +;;; digits preceeded by a length byte. Nonnegative integers sort +;;; correctly. +;;; +;;;Use of null bytes in string, symbol, or atom key-fields will break +;;;this encoding. + +(define (string-number-keyifier n) + (define str (number->string n)) + (string-append (bytes (string-length str)) str)) + +(define (string-keyifier str) + (string-append str key:null)) + +(define (key:shorten-1 str) + (substring str 0 (+ -1 (string-length str)))) + +;;; unitary composite-key maker +(define (make-keyifier-1 type) + (case type + ((string) string-keyifier) + ((symbol) (lambda (s) (string-keyifier (symbol->string s)))) + ((atom) (lambda (obj) (string-keyifier (if obj (symbol->string obj) "")))) + ((boolean) (lambda (b) (if b "T" "F"))) + ((integer number ordinal) string-number-keyifier) + ;; binary number formats + ((r64) (lambda (x) (ieee-byte-collate! (ieee-double->bytes x)))) + ((r32) (lambda (x) (ieee-byte-collate! (ieee-float->bytes x)))) + ((s64) (lambda (n) (integer-byte-collate! (integer->bytes n -8)))) + ((s32) (lambda (n) (integer-byte-collate! (integer->bytes n -4)))) + ((s16) (lambda (n) (integer-byte-collate! (integer->bytes n -2)))) + (( s8) (lambda (n) (integer->bytes n -1))) + ((u64) (lambda (n) (integer-byte-collate! (integer->bytes n 8)))) + ((u32) (lambda (n) (integer-byte-collate! (integer->bytes n 4)))) + ((u16) (lambda (n) (integer-byte-collate! (integer->bytes n 2)))) + (( u8) (lambda (n) (integer->bytes n 1))) + (else (slib:error 'make-keyifier-1 'unsupported-type type)))) + +;;; composite-key maker +(define (key-polymerase prinum types) + (set! types (butnthcdr prinum types)) + ;; Special case when there is just one primary key. + (if (= 1 prinum) + (let ((proc (make-keyifier-1 (car types)))) + (lambda (lst) (proc (car lst)))) + (let ((procs (map make-keyifier-1 types))) + (lambda (lst) + (apply string-append (map (lambda (p v) (p v)) procs lst)))))) + +(define (key:width type) + (case type + ((r64 s64 u64) 8) + ((r32 s32 u32) 4) + ((s16 u16) 2) + ((s8 u8 boolean) 1) + ((integer number ordinal) + (lambda (key pos) (+ 1 (byte-ref key pos)))) + ((string symbol atom) ;null terminated + (lambda (key pos) + (do ((i pos (+ 1 i))) + ((zero? (byte-ref key i)) (- i pos -1))))) + (else #f))) + +(define (exokeyase type) + (case type + ((string) key:shorten-1) + ((symbol) (lambda (str) (string->symbol (key:shorten-1 str)))) + ((atom) (lambda (str) (if (string=? "" str) #f + (string->symbol (key:shorten-1 str))))) + ((boolean) (lambda (str) (not (string=? "F" str)))) + ((integer number ordinal) + (lambda (str) (string->number (substring str 1 (string-length str))))) + ;; binary number formats + ((r64) (lambda (str) (bytes->ieee-double (ieee-byte-decollate! str)))) + ((r32) (lambda (str) (bytes->ieee-float (ieee-byte-decollate! str)))) + ((s64) (lambda (str) (bytes->integer (integer-byte-collate! str) -8))) + ((s32) (lambda (str) (bytes->integer (integer-byte-collate! str) -4))) + ((s16) (lambda (str) (bytes->integer (integer-byte-collate! str) -2))) + (( s8) (lambda (str) (bytes->integer str -1))) + ((u64) (lambda (str) (bytes->integer (integer-byte-collate! str) 8))) + ((u32) (lambda (str) (bytes->integer (integer-byte-collate! str) 4))) + ((u16) (lambda (str) (bytes->integer (integer-byte-collate! str) 2))) + (( u8) (lambda (str) (bytes->integer str 1))) + (else #f))) + +;;; extracts one key-field from composite-key +(define (make-key-extractor primary-limit types index) + (define (wither type) + (or (key:width type) + (slib:error 'make-key-extractor 'unsupported-type type))) + (let ((proc (exokeyase (list-ref types (+ -1 index)))) + (skips (map wither (butnthcdr index types)))) + (lambda (key) + (let loop ((pos 0) (skips skips)) + (define flen (car skips)) + (if (procedure? flen) (set! flen (flen key pos))) + (if (null? (cdr skips)) + (proc (substring key pos (+ pos flen))) + (loop (+ pos flen) (cdr skips))))))) + +;;; composite-key to list +(define (make-key->list primary-limit types) + (define (wither type) + (or (key:width type) + (slib:error 'make-key->list 'unsupported-type type))) + (define typs (butnthcdr primary-limit types)) + (let ((procs (map exokeyase typs)) + (skips (map wither typs))) + (lambda (key) + (let loop ((pos 0) (skips skips) (procs procs)) + (define flen (car skips)) + (if (procedure? flen) (set! flen (flen key pos))) + ;;(print 'key->list pos flen typs key) + (cons ((car procs) (substring key pos (+ pos flen))) + (if (null? (cdr skips)) + '() + (loop (+ pos flen) (cdr skips) (cdr procs)))))))) + +;;;; for-each-key, ordered-for-each-key, and map-key + +(define (make-key-match? key-dimension column-types match-keys) + (if (list-all-false? match-keys) + (lambda (ckey) #t) + (let ((keyploder (make-key->list key-dimension column-types))) + (lambda (ckey) + (define (key-match? match-keys keys) + (cond ((null? match-keys) #t) + ((not (car match-keys)) + (key-match? (cdr match-keys) (cdr keys))) + ((equal? (car match-keys) (car keys)) + (key-match? (cdr match-keys) (cdr keys))) + ((not (procedure? (car match-keys))) + #f) + (((car match-keys) (car keys)) + (key-match? (cdr match-keys) (cdr keys))) + (else #f))) + (key-match? match-keys (keyploder ckey)))))) + +(define (map-key handle operation key-dimension column-types match-keys) + (define lst (list 'dummy)) + (let ((tail lst)) + (ordered-for-each-key handle + (lambda (k) + (set-cdr! tail (list (operation k))) + (set! tail (cdr tail))) + key-dimension column-types match-keys) + (cdr lst))) + +;;;; Indexed Sequential Access Methods + +(define (ordered-for-each-key handle operation key-dimension column-types match-keys) + (let ((bt (handle->bt handle)) + (prefix (handle->base-id handle)) + (key-match? (make-key-match? key-dimension column-types match-keys))) + (case (- (length column-types) key-dimension) + ((0) (let ((prefix+ (key:incr prefix)) + (maproc (lambda (ckey val) + (define fkey (key:match-prefix? prefix ckey)) + ;;(print 'ordered-for-each-key ckey fkey) + (and fkey (key-match? fkey) (operation fkey)) + #f))) + (do ((res (bt:scan bt 0 prefix prefix+ maproc 1) + (bt:scan bt 0 (caddr res) prefix+ maproc 1))) + ((not (= -1 (car res))))))) + (else (let ((prelen (string-length prefix))) + (do ((nkey (bt:next bt prefix) + (bt:next bt (key:incr (key:shorten-1 nkey))))) + ((or (not nkey) + (not (string=? prefix (substring nkey 0 prelen)))) + #f) + ;;(print 'ordered-for-each-key nkey (key:match-prefix? prefix nkey)) + (let ((fkey (key:match-prefix? prefix nkey))) + (and fkey (key-match? fkey) (operation fkey))))))))) + +(define (make-nexter handle key-dimension column-types index) + (define bt (handle->bt handle)) + (define prefix (handle->base-id handle)) + (define key->list (make-key->list key-dimension column-types)) + (define list->key (key-polymerase key-dimension column-types)) + (lambda keys + (define nkey + (bt:next bt (string-append prefix + (list->key (butnthcdr index keys)) + key:s255))) + (and nkey (let ((ckey (key:match-prefix? prefix nkey))) + (and ckey (key->list ckey)))))) + +(define (make-prever handle key-dimension column-types index) + (define bt (handle->bt handle)) + (define ldx (- (length column-types) key-dimension)) + (define prefix (handle->base-id handle)) + (define key->list (make-key->list key-dimension column-types)) + (define list->key (key-polymerase key-dimension column-types)) + (lambda keys + (define pkey + (bt:prev bt (string-append prefix + (list->key (butnthcdr index keys))))) + (and pkey (let ((ckey (key:match-prefix? prefix pkey))) + (and ckey (key->list ckey)))))) + +;;;; getters and putters + +;;;Records are stored as multiple copies of the key to which a +;;;one-byte code is appended, identifying the field. If all fields +;;;are primary keys, then KEY:COL0 (a 0 byte) is appended. + +(define (make-getter-1 prinum types index) + (define type (list-ref types (- index prinum))) + (let ((proc (or (wb-string->object type) + (slib:error 'make-getter-1 'unsupported-type type))) + (ci (key:col-field (- index prinum)))) + (lambda (handle key) + (define val + (db:get + (handle->bt handle) + (string-append (handle->base-id handle) key ci))) ; (print 'ckey ) + (and val (proc val))))) + +;;;If more than one non-primary value is stored, then use SCAN to +;;;extract the values. + +(define (make-getter prinum types) + (define (wbstr->obj type) + (or (wb-string->object type) + (slib:error 'make-getter 'unsupported-type type))) + (case (- (length types) prinum) + ((0) (lambda (handle key) + (and (db:get (handle->bt handle) + (string-append (handle->base-id handle) key key:col0)) + '()))) + ((1) (let ((proc (wbstr->obj (list-ref types prinum)))) + (lambda (handle key) + (define val + (db:get + (handle->bt handle) + (string-append (handle->base-id handle) key key:col1))) + (and val (list (proc val)))))) + (else (let ((procs (map wbstr->obj (nthcdr prinum types)))) + (lambda (handle key) + (define lst (list 'dummy)) + (define idx 1) + (let ((bt (handle->bt handle)) + (prefix (string-append (handle->base-id handle) key)) + (tail lst)) + (define (loop procs) + (define val (db:get bt (string-append prefix (bytes idx)))) + (cond (val (set-cdr! tail (list ((car procs) val))) + (set! tail (cdr tail)) + (set! idx (+ 1 idx)) + (if (null? (cdr procs)) + (cdr lst) + (loop (cdr procs)))) + (else #f))) + (loop procs))))))) + +(define (make-putter prinum types) + (define (obj->wbstr type) + (or (object->wb-string type) + (slib:error 'make-putter 'unsupported-type type))) + (case (- (length types) prinum) + ((0) (lambda (handle ckey restcols) + (bt:put! (handle->bt handle) + (string-append (handle->base-id handle) ckey key:col0) + ""))) + ((1) (let ((proc (obj->wbstr (list-ref types prinum)))) + (lambda (handle ckey restcols) + (db:put! (handle->bt handle) + (string-append (handle->base-id handle) ckey key:col1) + (proc (car restcols)))))) + (else (let ((procs (map obj->wbstr (nthcdr prinum types)))) + (lambda (handle ckey restcols) + (define i 0) + (for-each + (lambda (proc val) + (set! i (+ 1 i)) + (db:put! (handle->bt handle) + (string-append (handle->base-id handle) + ckey + (key:col-field i)) + (proc val))) + procs restcols)))))) + +;;;; other table methods. + +(define (present? handle key) + (let* ((kc (string-append (handle->base-id handle) key)) + (kcl (string-length kc)) + (n (bt:next (handle->bt handle) kc))) + (and n + (<= (+ 1 kcl) (string-length n) (+ 2 kcl)) + (string=? kc (substring n 0 kcl))))) + +(define (delete handle key) + (let ((prefix (string-append (handle->base-id handle) key))) + (not (wb:err? (bt:rem* (handle->bt handle) + prefix + (key:incr prefix)))))) + +(define (delete* handle key-dimension column-types match-keys) + (let ((prefix (string-append (handle->base-id handle) match-keys))) + (not (wb:err? (bt:rem* (handle->bt handle) + prefix + (key:incr prefix)))))) + + (lambda (operation-name) + ;;(require 'trace) + #+foo ; To trace methods use this wrapper: + ((lambda (proc) + (if (procedure? proc) + (lambda args + (let ((ans (apply proc args))) + (if (procedure? ans) + (tracef ans operation-name) + ans))) + proc)) + ) + (case operation-name + ((make-base) make-base) + ((open-base) open-base) + ((write-base) write-base) + ((sync-base) sync-base) + ((close-base) close-base) + ((make-table) make-table) + ((open-table) open-table) + ((kill-table) kill-table) + ((make-keyifier-1) make-keyifier-1) + ((make-list-keyifier) key-polymerase) + ((make-key->list) make-key->list) + ((make-key-extractor) make-key-extractor) + ((supported-type?) supported-type?) + ((supported-key-type?) supported-key-type?) + ((present?) present?) + ((make-putter) make-putter) + ((make-getter) make-getter) + ((make-getter-1) make-getter-1) + ((delete) delete) + ((delete*) delete*) + ((for-each-key) ordered-for-each-key) + ((map-key) map-key) + ((ordered-for-each-key) ordered-for-each-key) + ((make-nexter) make-nexter) + ((make-prever) make-prever) + ((catalog-id) catalog-id) + (else #f)) + ))) + +(set! *base-table-implementations* + (cons (list 'rwb-isam (make-relational-system rwb-isam)) + *base-table-implementations*)) +;;(trace bt:scan bt:get make-getter map-key ordered-for-each-key make-key-extractor make-key->list) (set! *qp-width* 333) ;;(trace-all "rwb-isam.scm") @@ -135,7 +135,7 @@ SCM strnullp(str) SCM str; { ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_strnullp); - if LENGTH(str) return BOOL_F; + if (LENGTH(str)) return BOOL_F; else return BOOL_T; } @@ -145,11 +145,11 @@ SCM appendb(args) { SCM arg; tail: - if NULLP(args) return EOL; + if (NULLP(args)) return EOL; arg = CAR(args); args = CDR(args); - if NULLP(args) return arg; - if NULLP(arg) goto tail; + if (NULLP(args)) return arg; + if (NULLP(arg)) goto tail; ASRTER(NIMP(arg) && CONSP(arg), arg, ARG1, s_appendb); CDR(last_pair(arg)) = appendb(args); return arg; @@ -56,7 +56,7 @@ static int apx_log10 P((double x)); static double lpow10 P((double x, int n)); static sizet idbl2str P((double f, char *a)); static sizet iflo2str P((SCM flt, char *str)); -static void add1 P((double f, double *fsum)); +static void safe_add_1 P((double f, double *fsum)); static long scm_twos_power P((SCM n)); static char s_makrect[] = "make-rectangular", s_makpolar[] = "make-polar", @@ -72,7 +72,7 @@ SCM sys_protects[NUM_PROTECTS]; sizet num_protects = NUM_PROTECTS; char s_inexactp[] = "inexact?"; -static char s_zerop[] = "zero?", +static char s_zerop[] = "zero?", s_abs[] = "abs", s_positivep[] = "positive?", s_negativep[] = "negative?"; static char s_lessp[] = "<", s_grp[] = ">"; static char s_leqp[] = "<=", s_greqp[] = ">="; @@ -88,7 +88,7 @@ static char s_str2list[] = "string->list"; static char s_st_copy[] = "string-copy", s_st_fill[] = "string-fill!"; static char s_vect2list[] = "vector->list", s_ve_fill[] = "vector-fill!"; static char s_intexpt[] = "integer-expt"; - +static char str_inf0[] = "inf.0"; /*** NUMBERS -> STRINGS ***/ #ifdef FLOATS @@ -114,11 +114,11 @@ static int apx_log10(x) double x; { int expt; - double frac = frexp(x, &expt); + frexp(x, &expt); expt -= 1; if (expt >= 0) return (int)(expt * llog2); - return -((int)( -expt * llog2)); + return -((int)(-expt * llog2)); } static double p10[] = {1.0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7}; @@ -146,8 +146,21 @@ int inf2str(f, a) { sizet ch = 0; if (f < 0.0) a[ch++] = '-'; - a[ch++] = (f != f) ? '0' : '1'; - a[ch++] = '/'; a[ch++] = '0'; + else if (f > 0.0) a[ch++] = '+'; + else { + a[ch++] = '0'; a[ch++] = '/'; a[ch++] = '0'; + return ch; + } + while (str_inf0[ch - 1]) { + a[ch] = str_inf0[ch - 1]; + ch++; + } +/* # ifdef COMPACT_INFINITY_NOTATION */ +/* else a[ch++] = '0'; */ +/* # else */ +/* a[ch++] = (f != f) ? '0' : '1'; */ +/* # endif */ +/* a[ch++] = '/'; a[ch++] = '0'; */ return ch; } @@ -260,12 +273,12 @@ static sizet iflo2str(flt, str) { sizet i; # ifdef SINGLES - if SINGP(flt) i = idbl2str(FLO(flt), str); + if (SINGP(flt)) i = idbl2str(FLO(flt), str); else # endif i = idbl2str(REAL(flt), str); if (scm_narn==flt) return i; - if CPLXP(flt) { + if (CPLXP(flt)) { if (!(0 > IMAG(flt))) str[i++] = '+'; i += idbl2str(IMAG(flt), &str[i]); str[i++] = 'i'; @@ -313,10 +326,10 @@ static SCM big2str(b, radix) sizet i = NUMDIGS(t); sizet j = radix==16 ? (BITSPERDIG*i)/4+2 : radix >= 10 ? (BITSPERDIG*i*241L)/800+2 - : (BITSPERDIG*i)+2; + : (BITSPERDIG*i)+2; sizet k = 0; sizet radct = 0; - sizet ch; /* jeh */ + sizet ch; /* jeh */ BIGDIG radpow = 1, radmod = 0; SCM ss = makstr((long)j); char *s = CHARS(ss), c; @@ -335,7 +348,7 @@ static SCM big2str(b, radix) c = radmod % radix; radmod /= radix; k--; s[--j] = c < 10 ? c + '0' : c + 'a' - 10; } - ch = s[0]=='-' ? 1 : 0; /* jeh */ + ch = s[0]=='-' ? 1 : 0; /* jeh */ if (ch < j) { /* jeh */ for(i = j;j < LENGTH(ss);j++) s[ch+j-i] = s[j]; /* jeh */ resizuve(ss, (SCM)MAKINUM(ch+LENGTH(ss)-i)); /* jeh */ @@ -346,17 +359,17 @@ static SCM big2str(b, radix) SCM number2string(x, radix) SCM x, radix; { - if UNBNDP(radix) radix=MAKINUM(10L); + if (UNBNDP(radix)) radix=MAKINUM(10L); else ASRTER(INUMP(radix), radix, ARG2, s_number2string); #ifdef FLOATS - if NINUMP(x) { + if (NINUMP(x)) { char num_buf[FLOBUFLEN]; # ifdef BIGDIG ASRTGO(NIMP(x), badx); - if BIGP(x) return big2str(x, (unsigned int)INUM(radix)); + if (BIGP(x)) return big2str(x, (unsigned int)INUM(radix)); # ifndef RECKLESS if (!(INEXP(x))) - badx: wta(x, (char *)ARG1, s_number2string); + badx: wta(x, (char *)ARG1, s_number2string); # endif # else ASRTER(NIMP(x) && INEXP(x), x, ARG1, s_number2string); @@ -365,7 +378,7 @@ SCM number2string(x, radix) } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_number2string); return big2str(x, (unsigned int)INUM(radix)); } @@ -453,7 +466,7 @@ SCM istr2int(str, len, radix) t2 = c; moretodo: while(k < blen) { -/* printf("k = %d, blen = %d, t2 = %ld, ds[k] = %d\n", k, blen, t2, ds[k]);*/ +/* printf("k = %d, blen = %d, t2 = %ld, ds[k] = %d\n", k, blen, t2, ds[k]);*/ t2 += ds[k]*radix; ds[k++] = BIGLO(t2); t2 = BIGDN(t2); @@ -466,7 +479,7 @@ SCM istr2int(str, len, radix) } } while (i < len); if (blen * BITSPERDIG/CHAR_BIT <= sizeof(SCM)) - if INUMP(res = big2inum(res, blen)) return res; + if (INUMP(res = big2inum(res, blen))) return res; if (j==blen) return res; return adjbig(res, blen); } @@ -532,7 +545,7 @@ static long scm_twos_power(n) long d, c = 0; int d4; # ifdef BIGDIG - if NINUMP(n) { + if (NINUMP(n)) { BIGDIG *ds; int i = 0; ds = BDIGITS(n); @@ -558,7 +571,7 @@ SCM istr2flo(str, len, radix) register long radix; { register int c, i = 0; - double lead_sgn; + double lead_sgn = 0.0; double res = 0.0, tmp = 0.0; int flg = 0; int point = 0; @@ -569,15 +582,27 @@ SCM istr2flo(str, len, radix) switch (*str) { /* leading sign */ case '-': lead_sgn = -1.0; i++; break; case '+': lead_sgn = 1.0; i++; break; - default : lead_sgn = 0.0; } 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 */ if (++i < len) return BOOL_F; /* `i' not last character */ return makdbl(0.0, lead_sgn); } + /* # ifdef COMPACT_INFINITY_NOTATION */ + if (0.0 != lead_sgn && str[i]=='/') { + res = 1; + flg = 1; + goto out1; + } + /* # endif */ do { /* check initial digits */ switch (c = str[i]) { case DIGITS: @@ -637,7 +662,7 @@ SCM istr2flo(str, len, radix) } } out2: -/* if (tmp==0.0) return BOOL_F; /\* `slash zero' not allowed *\/ */ + /* if (tmp==0.0) return BOOL_F; /\* `slash zero' not allowed *\/ */ if (i < len) while (str[i]=='#') { /* optional sharps */ tmp *= radix; @@ -686,9 +711,9 @@ SCM istr2flo(str, len, radix) switch (c = str[i]) { case DIGITS: expon = expon*10 + c-'0'; -/* if (expon > MAXEXP) */ -/* if (1==expsgn || expon > (MAXEXP + dblprec + 1)) */ -/* return BOOL_F; /\* exponent too large *\/ */ + /* if (expon > MAXEXP) */ + /* if (1==expsgn || expon > (MAXEXP + dblprec + 1)) */ + /* return BOOL_F; /\* exponent too large *\/ */ break; default: goto out4; @@ -706,7 +731,7 @@ SCM istr2flo(str, len, radix) # ifdef _UNICOS while (point++) res *= 0.1; # else - while (point++) res /= 10.0; + while (point++) res /= 10.0; # endif done: @@ -726,7 +751,7 @@ SCM istr2flo(str, len, radix) case '@': { /* polar input for complex number */ /* get a `real' for angle */ second = istr2flo(&str[i], (long)(len-i), radix); - if IMP(second) return BOOL_F; + if (IMP(second)) return BOOL_F; if (!(INEXP(second))) return BOOL_F; /* not `real' */ if (CPLXP(second)) return BOOL_F; /* not `real' */ tmp = REALPART(second); @@ -741,7 +766,7 @@ SCM istr2flo(str, len, radix) if (i==(len-1)) return makdbl(res, lead_sgn); /* get a `ureal' for complex part */ second = istr2flo(&str[i], (long)((len-i)-1), radix); - if IMP(second) return BOOL_F; + if (IMP(second)) return BOOL_F; if (!(INEXP(second))) return BOOL_F; /* not `ureal' */ if (CPLXP(second)) return BOOL_F; /* not `ureal' */ tmp = REALPART(second); @@ -780,7 +805,7 @@ SCM istring2number(str, len, radix) return istr2int(&str[i], len-i, radix); case 0: res = istr2int(&str[i], len-i, radix); - if NFALSEP(res) return res; + if (NFALSEP(res)) return res; #ifdef FLOATS case 2: return istr2flo(&str[i], len-i, radix); #endif @@ -792,7 +817,7 @@ SCM istring2number(str, len, radix) SCM string2number(str, radix) SCM str, radix; { - if UNBNDP(radix) radix=MAKINUM(10L); + if (UNBNDP(radix)) radix=MAKINUM(10L); else ASRTER(INUMP(radix), radix, ARG2, s_str2number); ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_str2number); return istring2number(CHARS(str), LENGTH(str), INUM(radix)); @@ -807,8 +832,8 @@ SCM makdbl (x, y) if ((y==0.0) && (x==0.0)) return flo0; # ifndef _MSC_VER # ifndef SINGLESONLY - if ((y != y) || (x != x) || (y==(2 * y) && y != 0.0)) return scm_narn; - if ((x==(2 * x)) && (x != 0.0) && (y != 0.0)) return scm_narn; + if ((y != y) || (x != x) || (y==(2 * y) && (y != 0.0))) return scm_narn; + if ((x==(2 * x)) && (x != 0.0)) y = 0.0; # endif # endif DEFER_INTS; @@ -844,13 +869,13 @@ SCM eqv(x, y) SCM x, y; { if (x==y) return BOOL_T; - if IMP(x) return BOOL_F; - if IMP(y) return BOOL_F; + if (IMP(x)) return BOOL_F; + if (IMP(y)) return BOOL_F; /* this ensures that types and length are the same. */ if (CAR(x) != CAR(y)) return BOOL_F; - if NUMP(x) { + if (NUMP(x)) { # ifdef BIGDIG - if BIGP(x) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F; + if (BIGP(x)) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F; # endif # ifdef FLOATS return floequal(x, y); @@ -863,7 +888,7 @@ SCM x, lst; { for(;NIMP(lst);lst = CDR(lst)) { ASRTGO(CONSP(lst), badlst); - if NFALSEP(eqv(CAR(lst), x)) return lst; + if (NFALSEP(eqv(CAR(lst), x))) return lst; } # ifndef RECKLESS if (!(NULLP(lst))) @@ -879,7 +904,7 @@ SCM x, alist; ASRTGO(CONSP(alist), badlst); tmp = CAR(alist); ASRTGO(NIMP(tmp) && CONSP(tmp), badlst); - if NFALSEP(eqv(CAR(tmp), x)) return tmp; + if (NFALSEP(eqv(CAR(tmp), x))) return tmp; } # ifndef RECKLESS if (!(NULLP(alist))) @@ -957,7 +982,7 @@ static SCM vector_equal(x, y) { long i; for(i = LENGTH(x)-1;i >= 0;i--) - if FALSEP(equal(VELTS(x)[i], VELTS(y)[i])) return BOOL_F; + if (FALSEP(equal(VELTS(x)[i], VELTS(y)[i]))) return BOOL_F; return BOOL_T; } #ifdef BIGDIG @@ -983,41 +1008,41 @@ SCM equal(x, y) { CHECK_STACK; tailrecurse: POLL; - if (x==y) return BOOL_T; - if IMP(x) return BOOL_F; - if IMP(y) return BOOL_F; - if (CONSP(x) && CONSP(y)) { - if FALSEP(equal(CAR(x), CAR(y))) return BOOL_F; - x = CDR(x); - y = CDR(y); - goto tailrecurse; - } - /* this ensures that types and length are the same. */ - if (CAR(x) != CAR(y)) return BOOL_F; - switch (TYP7(x)) { - default: return BOOL_F; - case tc7_string: return st_equal(x, y); - case tc7_vector: return vector_equal(x, y); - case tc7_smob: { - int i = SMOBNUM(x); - if (!(i < numsmob)) return BOOL_F; - 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: { - SCM (*pred)() = smobs[0x0ff & (tc16_array>>8)].equalp; - if (pred) return (*pred)(x, y); - else return BOOL_F; - } - } + if (x==y) return BOOL_T; + if (IMP(x)) return BOOL_F; + if (IMP(y)) return BOOL_F; + if (CONSP(x) && CONSP(y)) { + if (FALSEP(equal(CAR(x), CAR(y)))) return BOOL_F; + x = CDR(x); + y = CDR(y); + goto tailrecurse; + } + /* this ensures that types and length are the same. */ + if (CAR(x) != CAR(y)) return BOOL_F; + switch (TYP7(x)) { + default: return BOOL_F; + case tc7_string: return st_equal(x, y); + case tc7_vector: return vector_equal(x, y); + case tc7_smob: { + int i = SMOBNUM(x); + if (!(i < numsmob)) return BOOL_F; + 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: { + SCM (*pred)() = smobs[0x0ff & (tc16_array>>8)].equalp; + if (pred) return (*pred)(x, y); + else return BOOL_F; + } + } } SCM numberp(obj) SCM obj; { - if INUMP(obj) return BOOL_T; + if (INUMP(obj)) return BOOL_T; #ifdef FLOATS if (NIMP(obj) && NUMP(obj)) return BOOL_T; #else @@ -1061,26 +1086,26 @@ int scm_bigdblcomp(b, d) SCM realp(x) SCM x; { - if INUMP(x) return BOOL_T; - if IMP(x) return BOOL_F; - if REALP(x) return BOOL_T; + if (INUMP(x)) return BOOL_T; + if (IMP(x)) return BOOL_F; + if (REALP(x)) return BOOL_T; # ifdef BIGDIG - if BIGP(x) return BOOL_T; + if (BIGP(x)) return BOOL_T; # endif return BOOL_F; } SCM scm_rationalp(x) SCM x; { - if INUMP(x) return BOOL_T; - if IMP(x) return BOOL_F; - if REALP(x) { + if (INUMP(x)) return BOOL_T; + if (IMP(x)) return BOOL_F; + if (REALP(x)) { float y = REALPART(x); if (y==2*y && y != 0.0) return BOOL_F; return BOOL_T; } # ifdef BIGDIG - if BIGP(x) return BOOL_T; + if (BIGP(x)) return BOOL_T; # endif return BOOL_F; } @@ -1088,13 +1113,13 @@ SCM intp(x) SCM x; { double r; - if INUMP(x) return BOOL_T; - if IMP(x) return BOOL_F; + if (INUMP(x)) return BOOL_T; + if (IMP(x)) return BOOL_F; # ifdef BIGDIG - if BIGP(x) return BOOL_T; + if (BIGP(x)) return BOOL_T; # endif if (!INEXP(x)) return BOOL_F; - if CPLXP(x) return BOOL_F; + if (CPLXP(x)) return BOOL_F; r = REALPART(x); if (r != floor(r)) return BOOL_F; if (r==2*r && r != 0.0) return BOOL_F; @@ -1116,16 +1141,16 @@ SCM eqp(x, y) { #ifdef FLOATS SCM t; - if NINUMP(x) { + if (NINUMP(x)) { # ifdef BIGDIG # ifndef RECKLESS if (!(NIMP(x))) - badx: wta(x, (char *)ARG1, s_eqp); + badx: wta(x, (char *)ARG1, s_eqp); # endif - if BIGP(x) { - if INUMP(y) return BOOL_F; + if (BIGP(x)) { + if (INUMP(y)) return BOOL_F; ASRTGO(NIMP(y), bady); - if BIGP(y) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F; + if (BIGP(y)) return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F; ASRTGO(INEXP(y), bady); bigreal: return (REALP(y) && (0==scm_bigdblcomp(x, REALPART(y)))) ? @@ -1135,10 +1160,10 @@ SCM eqp(x, y) # else ASRTER(NIMP(x) && INEXP(x), x, ARG1, s_eqp); # endif - if INUMP(y) {t = x; x = y; y = t; goto realint;} + if (INUMP(y)) {t = x; x = y; y = t; goto realint;} # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) {t = x; x = y; y = t; goto bigreal;} + if (BIGP(y)) {t = x; x = y; y = t; goto bigreal;} ASRTGO(INEXP(y), bady); # else ASRTGO(NIMP(y) && INEXP(y), bady); @@ -1146,18 +1171,18 @@ SCM eqp(x, y) if (x==y) return BOOL_T; return floequal(x, y); } - if NINUMP(y) { + if (NINUMP(y)) { # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) return BOOL_F; + if (BIGP(y)) return BOOL_F; # ifndef RECKLESS if (!(INEXP(y))) - bady: wta(y, (char *)ARG2, s_eqp); + bady: wta(y, (char *)ARG2, s_eqp); # endif # else # ifndef RECKLESS if (!(NIMP(y) && INEXP(y))) - bady: wta(y, (char *)ARG2, s_eqp); + bady: wta(y, (char *)ARG2, s_eqp); # endif # endif realint: @@ -1165,16 +1190,16 @@ SCM eqp(x, y) } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_eqp); - if INUMP(y) return BOOL_F; + if (INUMP(y)) return BOOL_F; ASRTGO(NIMP(y) && BIGP(y), bady); return (0==bigcomp(x, y)) ? BOOL_T : BOOL_F; } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) - bady: wta(y, (char *)ARG2, s_eqp); + bady: wta(y, (char *)ARG2, s_eqp); # endif return BOOL_F; } @@ -1189,16 +1214,16 @@ SCM lessp(x, y) SCM x, y; { #ifdef FLOATS - if NINUMP(x) { + if (NINUMP(x)) { # ifdef BIGDIG # ifndef RECKLESS if (!(NIMP(x))) - badx: wta(x, (char *)ARG1, s_lessp); + badx: wta(x, (char *)ARG1, s_lessp); # endif - if BIGP(x) { - if INUMP(y) return BIGSIGN(x) ? BOOL_T : BOOL_F; + if (BIGP(x)) { + if (INUMP(y)) return BIGSIGN(x) ? BOOL_T : BOOL_F; ASRTGO(NIMP(y), bady); - if BIGP(y) return (1==bigcomp(x, y)) ? BOOL_T : BOOL_F; + if (BIGP(y)) return (1==bigcomp(x, y)) ? BOOL_T : BOOL_F; ASRTGO(REALP(y), bady); return (1==scm_bigdblcomp(x, REALPART(y))) ? BOOL_T : BOOL_F; } @@ -1206,44 +1231,44 @@ SCM lessp(x, y) # else ASRTER(NIMP(x) && REALP(x), x, ARG1, s_lessp); # endif - if INUMP(y) return (REALPART(x) < ((double)INUM(y))) ? BOOL_T : BOOL_F; + if (INUMP(y)) return (REALPART(x) < ((double)INUM(y))) ? BOOL_T : BOOL_F; # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) return (-1==scm_bigdblcomp(y, REALPART(x))) ? BOOL_T : BOOL_F; + if (BIGP(y)) return (-1==scm_bigdblcomp(y, REALPART(x))) ? BOOL_T : BOOL_F; ASRTGO(REALP(y), bady); # else ASRTGO(NIMP(y) && REALP(y), bady); # endif return (REALPART(x) < REALPART(y)) ? BOOL_T : BOOL_F; } - if NINUMP(y) { + if (NINUMP(y)) { # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) return BIGSIGN(y) ? BOOL_F : BOOL_T; + if (BIGP(y)) return BIGSIGN(y) ? BOOL_F : BOOL_T; # ifndef RECKLESS if (!(REALP(y))) - bady: wta(y, (char *)ARG2, s_lessp); + bady: wta(y, (char *)ARG2, s_lessp); # endif # else # ifndef RECKLESS if (!(NIMP(y) && REALP(y))) - bady: wta(y, (char *)ARG2, s_lessp); + bady: wta(y, (char *)ARG2, s_lessp); # endif # endif return (((double)INUM(x)) < REALPART(y)) ? BOOL_T : BOOL_F; } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_lessp); - if INUMP(y) return BIGSIGN(x) ? BOOL_T : BOOL_F; + if (INUMP(y)) return BIGSIGN(x) ? BOOL_T : BOOL_F; ASRTGO(NIMP(y) && BIGP(y), bady); return (1==bigcomp(x, y)) ? BOOL_T : BOOL_F; } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) - bady: wta(y, (char *)ARG2, s_lessp); + bady: wta(y, (char *)ARG2, s_lessp); # endif return BIGSIGN(y) ? BOOL_F : BOOL_T; } @@ -1273,10 +1298,10 @@ SCM zerop(z) SCM z; { #ifdef FLOATS - if NINUMP(z) { + if (NINUMP(z)) { # ifdef BIGDIG ASRTGO(NIMP(z), badz); - if BIGP(z) return BOOL_F; + if (BIGP(z)) return BOOL_F; # ifndef RECKLESS if (!(INEXP(z))) badz: wta(z, (char *)ARG1, s_zerop); @@ -1288,7 +1313,7 @@ SCM zerop(z) } #else # ifdef BIGDIG - if NINUMP(z) { + if (NINUMP(z)) { ASRTER(NIMP(z) && BIGP(z), z, ARG1, s_zerop); return BOOL_F; } @@ -1302,10 +1327,10 @@ SCM positivep(x) SCM x; { #ifdef FLOATS - if NINUMP(x) { + if (NINUMP(x)) { # ifdef BIGDIG ASRTGO(NIMP(x), badx); - if BIGP(x) return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F; + if (BIGP(x)) return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F; # ifndef RECKLESS if (!(REALP(x))) badx: wta(x, (char *)ARG1, s_positivep); @@ -1317,7 +1342,7 @@ SCM positivep(x) } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_positivep); return TYP16(x)==tc16_bigpos ? BOOL_T : BOOL_F; } @@ -1331,10 +1356,10 @@ SCM negativep(x) SCM x; { #ifdef FLOATS - if NINUMP(x) { + if (NINUMP(x)) { # ifdef BIGDIG ASRTGO(NIMP(x), badx); - if BIGP(x) return TYP16(x)==tc16_bigpos ? BOOL_F : BOOL_T; + if (BIGP(x)) return TYP16(x)==tc16_bigpos ? BOOL_F : BOOL_T; # ifndef RECKLESS if (!(REALP(x))) badx: wta(x, (char *)ARG1, s_negativep); @@ -1346,7 +1371,7 @@ SCM negativep(x) } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_negativep); return (TYP16(x)==tc16_bigneg) ? BOOL_T : BOOL_F; } @@ -1365,21 +1390,21 @@ SCM lmax(x, y) SCM t; double z; #endif - if UNBNDP(y) { + if (UNBNDP(y)) { #ifndef RECKLESS if (!(NUMBERP(x))) - badx: wta(x, (char *)ARG1, s_max); + badx: wta(x, (char *)ARG1, s_max); #endif return x; } #ifdef FLOATS - if NINUMP(x) { + if (NINUMP(x)) { # ifdef BIGDIG ASRTGO(NIMP(x), badx); - if BIGP(x) { - if INUMP(y) return BIGSIGN(x) ? y : x; + if (BIGP(x)) { + if (INUMP(y)) return BIGSIGN(x) ? y : x; ASRTGO(NIMP(y), bady); - if BIGP(y) return (1==bigcomp(x, y)) ? y : x; + if (BIGP(y)) return (1==bigcomp(x, y)) ? y : x; ASRTGO(REALP(y), bady); big_dbl: if (-1 != scm_bigdblcomp(x, REALPART(y))) return y; @@ -1391,10 +1416,10 @@ SCM lmax(x, y) # else ASRTER(NIMP(x) && REALP(x), x, ARG1, s_max); # endif - if INUMP(y) return (REALPART(x) < (z = INUM(y))) ? makdbl(z, 0.0) : x; + if (INUMP(y)) return (REALPART(x) < (z = INUM(y))) ? makdbl(z, 0.0) : x; # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) { + if (BIGP(y)) { t = y; y = x; x = t; goto big_dbl; } ASRTGO(REALP(y), bady); @@ -1403,34 +1428,34 @@ SCM lmax(x, y) # endif return (REALPART(x) < REALPART(y)) ? y : x; } - if NINUMP(y) { + if (NINUMP(y)) { # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) return BIGSIGN(y) ? x : y; + if (BIGP(y)) return BIGSIGN(y) ? x : y; # ifndef RECKLESS if (!(REALP(y))) - bady: wta(y, (char *)ARG2, s_max); + bady: wta(y, (char *)ARG2, s_max); # endif # else # ifndef RECKLESS if (!(NIMP(y) && REALP(y))) - bady: wta(y, (char *)ARG2, s_max); + bady: wta(y, (char *)ARG2, s_max); # endif # endif return ((z = INUM(x)) < REALPART(y)) ? y : makdbl(z, 0.0); } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_max); - if INUMP(y) return BIGSIGN(x) ? y : x; + if (INUMP(y)) return BIGSIGN(x) ? y : x; ASRTGO(NIMP(y) && BIGP(y), bady); return (1==bigcomp(x, y)) ? y : x; } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) - bady: wta(y, (char *)ARG2, s_max); + bady: wta(y, (char *)ARG2, s_max); # endif return BIGSIGN(y) ? x : y; } @@ -1449,21 +1474,21 @@ SCM lmin(x, y) SCM t; double z; #endif - if UNBNDP(y) { + if (UNBNDP(y)) { #ifndef RECKLESS if (!(NUMBERP(x))) - badx: wta(x, (char *)ARG1, s_min); + badx: wta(x, (char *)ARG1, s_min); #endif return x; } #ifdef FLOATS - if NINUMP(x) { + if (NINUMP(x)) { # ifdef BIGDIG ASRTGO(NIMP(x), badx); - if BIGP(x) { - if INUMP(y) return BIGSIGN(x) ? x : y; + if (BIGP(x)) { + if (INUMP(y)) return BIGSIGN(x) ? x : y; ASRTGO(NIMP(y), bady); - if BIGP(y) return (-1==bigcomp(x, y)) ? y : x; + if (BIGP(y)) return (-1==bigcomp(x, y)) ? y : x; ASRTGO(REALP(y), bady); big_dbl: if (1 != scm_bigdblcomp(x, REALPART(y))) return y; @@ -1475,10 +1500,10 @@ SCM lmin(x, y) # else ASRTER(NIMP(x) && REALP(x), x, ARG1, s_min); # endif - if INUMP(y) return (REALPART(x) > (z = INUM(y))) ? makdbl(z, 0.0) : x; + if (INUMP(y)) return (REALPART(x) > (z = INUM(y))) ? makdbl(z, 0.0) : x; # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) { + if (BIGP(y)) { t = y; y = x; x = t; goto big_dbl; } ASRTGO(REALP(y), bady); @@ -1487,34 +1512,34 @@ SCM lmin(x, y) # endif return (REALPART(x) > REALPART(y)) ? y : x; } - if NINUMP(y) { + if (NINUMP(y)) { # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) return BIGSIGN(y) ? y : x; + if (BIGP(y)) return BIGSIGN(y) ? y : x; # ifndef RECKLESS if (!(REALP(y))) - bady: wta(y, (char *)ARG2, s_min); + bady: wta(y, (char *)ARG2, s_min); # endif # else # ifndef RECKLESS if (!(NIMP(y) && REALP(y))) - bady: wta(y, (char *)ARG2, s_min); + bady: wta(y, (char *)ARG2, s_min); # endif # endif return ((z = INUM(x)) > REALPART(y)) ? y : makdbl(z, 0.0); } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_min); - if INUMP(y) return BIGSIGN(x) ? x : y; + if (INUMP(y)) return BIGSIGN(x) ? x : y; ASRTGO(NIMP(y) && BIGP(y), bady); return (-1==bigcomp(x, y)) ? y : x; } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) - bady: wta(y, (char *)ARG2, s_min); + bady: wta(y, (char *)ARG2, s_min); # endif return BIGSIGN(y) ? y : x; } @@ -1529,23 +1554,23 @@ SCM lmin(x, y) SCM sum(x, y) SCM x, y; { - if UNBNDP(y) { - if UNBNDP(x) return INUM0; + if (UNBNDP(y)) { + if (UNBNDP(x)) return INUM0; #ifndef RECKLESS if (!(NUMBERP(x))) - badx: wta(x, (char *)ARG1, s_sum); + badx: wta(x, (char *)ARG1, s_sum); #endif return x; } #ifdef FLOATS - if NINUMP(x) { + if (NINUMP(x)) { SCM t; # ifdef BIGDIG ASRTGO(NIMP(x), badx); - if BIGP(x) { - if INUMP(y) {t = x; x = y; y = t; goto intbig;} + if (BIGP(x)) { + if (INUMP(y)) {t = x; x = y; y = t; goto intbig;} ASRTGO(NIMP(y), bady); - if BIGP(y) { + if (BIGP(y)) { if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;} return addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0); } @@ -1556,30 +1581,32 @@ SCM sum(x, y) # else ASRTGO(NIMP(x) && INEXP(x), badx); # endif - if INUMP(y) {t = x; x = y; y = t; goto intreal;} + if (INUMP(y)) {t = x; x = y; y = t; goto intreal;} # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) {t = x; x = y; y = t; goto bigreal;} + if (BIGP(y)) {t = x; x = y; y = t; goto bigreal;} # ifndef RECKLESS else if (!(INEXP(y))) - bady: wta(y, (char *)ARG2, s_sum); + bady: wta(y, (char *)ARG2, s_sum); # endif # else # ifndef RECKLESS if (!(NIMP(y) && INEXP(y))) - bady: wta(y, (char *)ARG2, s_sum); + bady: wta(y, (char *)ARG2, s_sum); # endif # endif - { double i = 0.0; - if CPLXP(x) i = IMAG(x); - if CPLXP(y) i += IMAG(y); - return makdbl(REALPART(x)+REALPART(y), i); } + { + double i = 0.0; + if (CPLXP(x)) i = IMAG(x); + if (CPLXP(y)) i += IMAG(y); + return makdbl(REALPART(x)+REALPART(y), i); + } } - if NINUMP(y) { + if (NINUMP(y)) { # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) - intbig: { + if (BIGP(y)) + intbig: { # ifndef DIGSTOOBIG long z = pseudolong(INUM(x)); return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0); @@ -1597,23 +1624,23 @@ SCM sum(x, y) } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { SCM t; ASRTGO(NIMP(x) && BIGP(x), badx); - if INUMP(y) {t = x; x = y; y = t; goto intbig;} + if (INUMP(y)) {t = x; x = y; y = t; goto intbig;} ASRTGO(NIMP(y) && BIGP(y), bady); if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;} return addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0); } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) - bady: wta(y, (char *)ARG2, s_sum); + bady: wta(y, (char *)ARG2, s_sum); # endif - intbig: { + intbig: { # ifndef DIGSTOOBIG long z = pseudolong(INUM(x)); - return addbig(&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0); + return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0); # else BIGDIG zdigs[DIGSPERLONG]; longdigs(INUM(x), zdigs); @@ -1627,7 +1654,7 @@ SCM sum(x, y) # endif #endif x = INUM(x)+INUM(y); - if FIXABLE(x) return MAKINUM(x); + if (FIXABLE(x)) return MAKINUM(x); #ifdef BIGDIG return long2big(x); #else @@ -1643,14 +1670,14 @@ SCM difference(x, y) SCM x, y; { #ifdef FLOATS - if NINUMP(x) { + if (NINUMP(x)) { # ifndef RECKLESS if (!(NIMP(x))) - badx: wta(x, (char *)ARG1, s_difference); + badx: wta(x, (char *)ARG1, s_difference); # endif - if UNBNDP(y) { + if (UNBNDP(y)) { # ifdef BIGDIG - if BIGP(x) { + if (BIGP(x)) { x = copybig(x, !BIGSIGN(x)); return NUMDIGS(x) * BITSPERDIG/CHAR_BIT <= sizeof(SCM) ? big2inum(x, NUMDIGS(x)) : x; @@ -1659,36 +1686,36 @@ SCM difference(x, y) ASRTGO(INEXP(x), badx); return makdbl(-REALPART(x), CPLXP(x)?-IMAG(x):0.0); } - if INUMP(y) return sum(x, MAKINUM(-INUM(y))); + if (INUMP(y)) return sum(x, MAKINUM(-INUM(y))); # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(x) { - if BIGP(y) return (NUMDIGS(x) < NUMDIGS(y)) ? - addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) : - addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0); + if (BIGP(x)) { + if (BIGP(y)) return (NUMDIGS(x) < NUMDIGS(y)) ? + addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) : + addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0); ASRTGO(INEXP(y), bady); return makdbl(big2dbl(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0); } ASRTGO(INEXP(x), badx); - if BIGP(y) return makdbl(REALPART(x)-big2dbl(y), CPLXP(x)?IMAG(x):0.0); + if (BIGP(y)) return makdbl(REALPART(x)-big2dbl(y), CPLXP(x)?IMAG(x):0.0); ASRTGO(INEXP(y), bady); # else ASRTGO(INEXP(x), badx); ASRTGO(NIMP(y) && INEXP(y), bady); # endif - if CPLXP(x) { - if CPLXP(y) + if (CPLXP(x)) { + if (CPLXP(y)) return makdbl(REAL(x)-REAL(y), IMAG(x)-IMAG(y)); else return makdbl(REAL(x)-REALPART(y), IMAG(x)); } return makdbl(REALPART(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0); } - if UNBNDP(y) {x = -INUM(x); goto checkx;} - if NINUMP(y) { + if (UNBNDP(y)) {x = -INUM(x); goto checkx;} + if (NINUMP(y)) { # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) { + if (BIGP(y)) { # ifndef DIGSTOOBIG long z = pseudolong(INUM(x)); return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100); @@ -1700,29 +1727,29 @@ SCM difference(x, y) } # ifndef RECKLESS if (!(INEXP(y))) - bady: wta(y, (char *)ARG2, s_difference); + bady: wta(y, (char *)ARG2, s_difference); # endif # else # ifndef RECKLESS if (!(NIMP(y) && INEXP(y))) - bady: wta(y, (char *)ARG2, s_difference); + bady: wta(y, (char *)ARG2, s_difference); # endif # endif return makdbl(INUM(x)-REALPART(y), CPLXP(y)?-IMAG(y):0.0); } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_difference); - if UNBNDP(y) { + if (UNBNDP(y)) { x = copybig(x, !BIGSIGN(x)); return NUMDIGS(x) * BITSPERDIG/CHAR_BIT <= sizeof(SCM) ? - big2inum(x, NUMDIGS(x)) : x; + big2inum(x, NUMDIGS(x)) : x; } - if INUMP(y) { + if (INUMP(y)) { # ifndef DIGSTOOBIG long z = pseudolong(INUM(y)); - return addbig(&z, DIGSPERLONG, (y < 0) ? 0 : 0x0100, x, 0); + return addbig((BIGDIG *)&z, DIGSPERLONG, (y < 0) ? 0 : 0x0100, x, 0); # else BIGDIG zdigs[DIGSPERLONG]; longdigs(INUM(x), zdigs); @@ -1731,19 +1758,19 @@ SCM difference(x, y) } ASRTGO(NIMP(y) && BIGP(y), bady); return (NUMDIGS(x) < NUMDIGS(y)) ? - addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) : - addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0); + addbig(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100) : + addbig(BDIGITS(y), NUMDIGS(y), BIGSIGN(y) ^ 0x0100, x, 0); } - if UNBNDP(y) {x = -INUM(x); goto checkx;} - if NINUMP(y) { + if (UNBNDP(y)) {x = -INUM(x); goto checkx;} + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) - bady: wta(y, (char *)ARG2, s_difference); + bady: wta(y, (char *)ARG2, s_difference); # endif { # ifndef DIGSTOOBIG long z = pseudolong(INUM(x)); - return addbig(&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100); + return addbig((BIGDIG *)&z, DIGSPERLONG, (x < 0) ? 0x0100 : 0, y, 0x0100); # else BIGDIG zdigs[DIGSPERLONG]; longdigs(INUM(x), zdigs); @@ -1753,13 +1780,13 @@ SCM difference(x, y) } # else ASRTER(INUMP(x), x, ARG1, s_difference); - if UNBNDP(y) {x = -INUM(x); goto checkx;} + if (UNBNDP(y)) {x = -INUM(x); goto checkx;} ASRTER(INUMP(y), y, ARG2, s_difference); # endif #endif x = INUM(x)-INUM(y); checkx: - if FIXABLE(x) return MAKINUM(x); + if (FIXABLE(x)) return MAKINUM(x); #ifdef BIGDIG return long2big(x); #else @@ -1774,24 +1801,24 @@ SCM difference(x, y) SCM product(x, y) SCM x, y; { - if UNBNDP(y) { - if UNBNDP(x) return MAKINUM(1L); + if (UNBNDP(y)) { + if (UNBNDP(x)) return MAKINUM(1L); #ifndef RECKLESS if (!(NUMBERP(x))) - badx: wta(x, (char *)ARG1, s_product); + badx: wta(x, (char *)ARG1, s_product); #endif return x; } #ifdef FLOATS - if NINUMP(x) { + if (NINUMP(x)) { SCM t; # ifdef BIGDIG ASRTGO(NIMP(x), badx); - if BIGP(x) { - if INUMP(y) {t = x; x = y; y = t; goto intbig;} + if (BIGP(x)) { + if (INUMP(y)) {t = x; x = y; y = t; goto intbig;} ASRTGO(NIMP(y), bady); - if BIGP(y) return mulbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), - BIGSIGN(x) ^ BIGSIGN(y)); + if (BIGP(y)) return mulbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), + BIGSIGN(x) ^ BIGSIGN(y)); ASRTGO(INEXP(y), bady); bigreal: return bigdblop('*', x, REALPART(y), CPLXP(y) ? IMAG(y) : 0.0); @@ -1800,22 +1827,22 @@ SCM product(x, y) # else ASRTGO(NIMP(x) && INEXP(x), badx); # endif - if INUMP(y) {t = x; x = y; y = t; goto intreal;} + if (INUMP(y)) {t = x; x = y; y = t; goto intreal;} # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) {t = x; x = y; y = t; goto bigreal;} + if (BIGP(y)) {t = x; x = y; y = t; goto bigreal;} # ifndef RECKLESS else if (!(INEXP(y))) - bady: wta(y, (char *)ARG2, s_product); + bady: wta(y, (char *)ARG2, s_product); # endif # else # ifndef RECKLESS if (!(NIMP(y) && INEXP(y))) - bady: wta(y, (char *)ARG2, s_product); + bady: wta(y, (char *)ARG2, s_product); # endif # endif - if CPLXP(x) { - if CPLXP(y) + if (CPLXP(x)) { + if (CPLXP(y)) return makdbl(REAL(x)*REAL(y)-IMAG(x)*IMAG(y), REAL(x)*IMAG(y)+IMAG(x)*REAL(y)); else @@ -1824,23 +1851,23 @@ SCM product(x, y) return makdbl(REALPART(x)*REALPART(y), CPLXP(y)?REALPART(x)*IMAG(y):0.0); } - if NINUMP(y) { + if (NINUMP(y)) { # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) { + if (BIGP(y)) { intbig: if (INUM0==x) return x; if (MAKINUM(1L)==x) return y; - { + { # ifndef DIGSTOOBIG - long z = pseudolong(INUM(x)); - return mulbig((BIGDIG *)&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y), - BIGSIGN(y) ? (x>0) : (x<0)); + long z = pseudolong(INUM(x)); + return mulbig((BIGDIG *)&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y), + BIGSIGN(y) ? (x>0) : (x<0)); # else - BIGDIG zdigs[DIGSPERLONG]; - longdigs(INUM(x), zdigs); - return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y), - BIGSIGN(y) ? (x>0) : (x<0)); + BIGDIG zdigs[DIGSPERLONG]; + longdigs(INUM(x), zdigs); + return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y), + BIGSIGN(y) ? (x>0) : (x<0)); # endif - } + } } ASRTGO(INEXP(y), bady); # else @@ -1850,31 +1877,31 @@ SCM product(x, y) } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTGO(NIMP(x) && BIGP(x), badx); - if INUMP(y) {SCM t = x; x = y; y = t; goto intbig;} + if (INUMP(y)) {SCM t = x; x = y; y = t; goto intbig;} ASRTGO(NIMP(y) && BIGP(y), bady); return mulbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), BIGSIGN(x) ^ BIGSIGN(y)); } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) - bady: wta(y, (char *)ARG2, s_product); + bady: wta(y, (char *)ARG2, s_product); # endif intbig: if (INUM0==x) return x; if (MAKINUM(1L)==x) return y; - { + { # ifndef DIGSTOOBIG - long z = pseudolong(INUM(x)); - return mulbig(&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y), - BIGSIGN(y) ? (x>0) : (x<0)); + long z = pseudolong(INUM(x)); + return mulbig((BIGDIG *)&z, DIGSPERLONG, BDIGITS(y), NUMDIGS(y), + BIGSIGN(y) ? (x>0) : (x<0)); # else - BIGDIG zdigs[DIGSPERLONG]; - longdigs(INUM(x), zdigs); - return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y), - BIGSIGN(y) ? (x>0) : (x<0)); + BIGDIG zdigs[DIGSPERLONG]; + longdigs(INUM(x), zdigs); + return mulbig(zdigs, DIGSPERLONG, BDIGITS(y), NUMDIGS(y), + BIGSIGN(y) ? (x>0) : (x<0)); # endif - } + } } # else ASRTGO(INUMP(x), badx); @@ -1890,7 +1917,8 @@ SCM product(x, y) y = MAKINUM(k); if (k != INUM(y) || k/i != j) #ifdef BIGDIG - { int sgn = (i < 0) ^ (j < 0); + { + int sgn = (i < 0) ^ (j < 0); # ifndef DIGSTOOBIG i = pseudolong(i); j = pseudolong(j); @@ -1919,24 +1947,24 @@ SCM divide(x, y) { #ifdef FLOATS double d, r, i, a; - if NINUMP(x) { + if (NINUMP(x)) { # ifndef RECKLESS if (!(NIMP(x))) - badx: wta(x, (char *)ARG1, s_divide); + badx: wta(x, (char *)ARG1, s_divide); # endif - if UNBNDP(y) { + if (UNBNDP(y)) { # ifdef BIGDIG - if BIGP(x) return makdbl(1.0/big2dbl(x), 0.0); + if (BIGP(x)) return makdbl(1.0/big2dbl(x), 0.0); # endif ASRTGO(INEXP(x), badx); - if REALP(x) return makdbl(1.0/REALPART(x), 0.0); + 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); } # ifdef BIGDIG - if BIGP(x) { + if (BIGP(x)) { SCM z; - if INUMP(y) { + if (INUMP(y)) { z = INUM(y); ASRTER(z, y, OVFLOW, s_divide); if (1==z) return x; @@ -1951,15 +1979,17 @@ SCM divide(x, y) z = divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&z, DIGSPERLONG, BIGSIGN(x) ? (y>0) : (y<0), 3); # else - { BIGDIG zdigs[DIGSPERLONG]; + { + BIGDIG zdigs[DIGSPERLONG]; longdigs(z, zdigs); z = divbigbig(BDIGITS(x), NUMDIGS(x), zdigs, DIGSPERLONG, - BIGSIGN(x) ? (y>0) : (y<0), 3);} + BIGSIGN(x) ? (y>0) : (y<0), 3); + } # endif return z ? z : bigdblop('/', x, INUM(y), 0.0); } ASRTGO(NIMP(y), bady); - if BIGP(y) { + if (BIGP(y)) { z = divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), BIGSIGN(x) ^ BIGSIGN(y), 3); return z ? z : inex_divbigbig(x, y); @@ -1969,42 +1999,42 @@ SCM divide(x, y) } # endif ASRTGO(INEXP(x), badx); - if INUMP(y) {d = INUM(y); goto basic_div;} + if (INUMP(y)) {d = 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); + if (BIGP(y)) return bigdblop('\\', y, REALPART(x), CPLXP(x) ? IMAG(x) : 0.0); ASRTGO(INEXP(y), bady); # else ASRTGO(NIMP(y) && INEXP(y), bady); # endif - if REALP(y) { + if (REALP(y)) { d = REALPART(y); basic_div: return makdbl(REALPART(x)/d, CPLXP(x)?IMAG(x)/d:0.0); } a = REALPART(x); - if REALP(x) goto complex_div; + 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 UNBNDP(y) { + if (UNBNDP(y)) { if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x; return makdbl(1.0/((double)INUM(x)), 0.0); } - if NINUMP(y) { + if (NINUMP(y)) { # ifdef BIGDIG ASRTGO(NIMP(y), bady); - if BIGP(y) return bigdblop('\\', y, INUM(x), 0.0); + if (BIGP(y)) return bigdblop('\\', y, INUM(x), 0.0); # ifndef RECKLESS if (!(INEXP(y))) - bady: wta(y, (char *)ARG2, s_divide); + bady: wta(y, (char *)ARG2, s_divide); # endif # else # ifndef RECKLESS if (!(NIMP(y) && INEXP(y))) - bady: wta(y, (char *)ARG2, s_divide); + bady: wta(y, (char *)ARG2, s_divide); # endif # endif - if REALP(y) return makdbl(INUM(x)/REALPART(y), 0.0); + 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; @@ -2012,11 +2042,11 @@ SCM divide(x, y) } #else # ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { SCM z; ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_divide); - if UNBNDP(y) goto ov; - if INUMP(y) { + if (UNBNDP(y)) goto ov; + if (INUMP(y)) { z = INUM(y); if (!z) goto ov; if (1==z) return x; @@ -2028,13 +2058,15 @@ SCM divide(x, y) } # ifndef DIGSTOOBIG z = pseudolong(z); - z = divbigbig(BDIGITS(x), NUMDIGS(x), &z, DIGSPERLONG, + z = divbigbig(BDIGITS(x), NUMDIGS(x), (BIGDIG *)&z, DIGSPERLONG, BIGSIGN(x) ? (y>0) : (y<0), 3); # else - { BIGDIG zdigs[DIGSPERLONG]; + { + BIGDIG zdigs[DIGSPERLONG]; longdigs(z, zdigs); z = divbigbig(BDIGITS(x), NUMDIGS(x), zdigs, DIGSPERLONG, - BIGSIGN(x) ? (y>0) : (y<0), 3);} + BIGSIGN(x) ? (y>0) : (y<0), 3); + } # endif } else { ASRTGO(NIMP(y) && BIGP(y), bady); @@ -2044,20 +2076,20 @@ SCM divide(x, y) if (!z) goto ov; return z; } - if UNBNDP(y) { + if (UNBNDP(y)) { if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x; goto ov; } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) - bady: wta(y, (char *)ARG2, s_divide); + bady: wta(y, (char *)ARG2, s_divide); # endif goto ov; } # else ASRTER(INUMP(x), x, ARG1, s_divide); - if UNBNDP(y) { + if (UNBNDP(y)) { if ((MAKINUM(1L)==x) || (MAKINUM(-1L)==x)) return x; goto ov; } @@ -2068,7 +2100,7 @@ SCM divide(x, y) long z = INUM(y); if ((0==z) || INUM(x)%z) goto ov; z = INUM(x)/z; - if FIXABLE(z) return MAKINUM(z); + if (FIXABLE(z)) return MAKINUM(z); #ifdef BIGDIG return long2big(z); #endif @@ -2088,17 +2120,16 @@ SCM scm_intexpt(z1, z2) #ifdef FLOATS double dacc, dz1; #endif -#ifdef BIGDIG - if (INUM0==z1 || acc==z1) return z1; - else if (MAKINUM(-1L)==z1) return BOOL_F==evenp(z2)?z1:acc; -#endif + if (INUM0==z2) return sum(acc, product(z1, INUM0)); ASRTER(INUMP(z2), z2, ARG2, s_intexpt); + if (acc==z1) return z1; + if (MAKINUM(-1L)==z1) return BOOL_F==evenp(z2)?z1:acc; z2 = INUM(z2); if (z2 < 0) { z2 = -z2; recip = 1; /* z1 = divide(z1, UNDEFINED); */ } - if INUMP(z1) { + if (INUMP(z1)) { long tmp, iacc = 1, iz1 = INUM(z1); #ifdef FLOATS if (recip) { dz1 = iz1; goto flocase; } @@ -2142,7 +2173,7 @@ SCM scm_intexpt(z1, z2) } ASRTER(NIMP(z1), z1, ARG1, s_intexpt); #ifdef FLOATS - if REALP(z1) { + if (REALP(z1)) { dz1 = REALPART(z1); flocase: dacc = 1.0; @@ -2168,25 +2199,27 @@ SCM scm_intexpt(z1, z2) } #ifdef FLOATS -double lasinh(x) +# ifndef HAVE_ATANH +double asinh(x) double x; { return log(x+sqrt(x*x+1)); } -double lacosh(x) +double acosh(x) double x; { return log(x+sqrt(x*x-1)); } -double latanh(x) +double atanh(x) double x; { return 0.5*log((1+x)/(1-x)); } +# endif -double ltrunc(x) +double scm_truncate(x) double x; { if (x < 0.0) return -floor(-x); @@ -2210,36 +2243,38 @@ void two_doubles(z1, z2, sstring, xy) char *sstring; struct dpair *xy; { - if INUMP(z1) xy->x = INUM(z1); + if (INUMP(z1)) xy->x = INUM(z1); else { # ifdef BIGDIG ASRTGO(NIMP(z1), badz1); - if BIGP(z1) xy->x = big2dbl(z1); + if (BIGP(z1)) xy->x = big2dbl(z1); else { # ifndef RECKLESS if (!(REALP(z1))) - badz1: wta(z1, (char *)ARG1, sstring); + badz1: wta(z1, (char *)ARG1, sstring); # endif xy->x = REALPART(z1);} # else {ASRTER(NIMP(z1) && REALP(z1), z1, ARG1, sstring); - xy->x = REALPART(z1);} + xy->x = REALPART(z1);} # endif } - if INUMP(z2) xy->y = INUM(z2); + if (INUMP(z2)) xy->y = INUM(z2); else { # ifdef BIGDIG ASRTGO(NIMP(z2), badz2); - if BIGP(z2) xy->y = big2dbl(z2); + if (BIGP(z2)) xy->y = big2dbl(z2); else { # ifndef RECKLESS if (!(REALP(z2))) - badz2: wta(z2, (char *)ARG2, sstring); + badz2: wta(z2, (char *)ARG2, sstring); # endif xy->y = REALPART(z2);} # else - {ASRTER(NIMP(z2) && REALP(z2), z2, ARG2, sstring); - xy->y = REALPART(z2);} + { + ASRTER(NIMP(z2) && REALP(z2), z2, ARG2, sstring); + xy->y = REALPART(z2); + } # endif } } @@ -2276,53 +2311,63 @@ SCM makpolar(z1, z2) SCM real_part(z) SCM z; { - if NINUMP(z) { + if (NINUMP(z)) { # ifdef BIGDIG ASRTGO(NIMP(z), badz); - if BIGP(z) return z; + if (BIGP(z)) return z; # ifndef RECKLESS if (!(INEXP(z))) - badz: wta(z, (char *)ARG1, s_real_part); + badz: wta(z, (char *)ARG1, s_real_part); # endif # else ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_real_part); # endif - if CPLXP(z) return makdbl(REAL(z), 0.0); + if (CPLXP(z)) return makdbl(REAL(z), 0.0); } return z; } SCM imag_part(z) SCM z; { - if INUMP(z) return INUM0; + if (INUMP(z)) return INUM0; # ifdef BIGDIG ASRTGO(NIMP(z), badz); - if BIGP(z) return INUM0; + if (BIGP(z)) return INUM0; # ifndef RECKLESS if (!(INEXP(z))) - badz: wta(z, (char *)ARG1, s_imag_part); + badz: wta(z, (char *)ARG1, s_imag_part); # endif # else ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_imag_part); # endif - if CPLXP(z) return makdbl(IMAG(z), 0.0); + if (CPLXP(z)) return makdbl(IMAG(z), 0.0); return flo0; } -SCM magnitude(z) + +SCM scm_abs(z) SCM z; { - if INUMP(z) return absval(z); + if (INUMP(z)) return scm_iabs(z); + ASRTGO(NIMP(z), badz); # ifdef BIGDIG + if (BIGP(z)) return scm_iabs(z); +# endif + if (!REALP(z)) + badz: wta(z, (char *)ARG1, s_abs); + return makdbl(fabs(REALPART(z)), 0.0); +} + +SCM scm_magnitude(z) + SCM z; +{ + if (INUMP(z)) return scm_iabs(z); ASRTGO(NIMP(z), badz); - if BIGP(z) return absval(z); -# ifndef RECKLESS - if (!(INEXP(z))) - badz: wta(z, (char *)ARG1, s_magnitude); -# endif -# else - ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_magnitude); +# ifdef BIGDIG + if (BIGP(z)) return scm_iabs(z); # endif - if CPLXP(z) + if (!INEXP(z)) + badz: wta(z, (char *)ARG1, s_magnitude); + if (CPLXP(z)) { double i = IMAG(z), r = REAL(z); return makdbl(sqrt(i*i+r*r), 0.0); @@ -2334,10 +2379,10 @@ SCM angle(z) SCM z; { double x, y = 0.0; - if INUMP(z) {x = (z>=INUM0) ? 1.0 : -1.0; goto do_angle;} + if (INUMP(z)) {x = (z>=INUM0) ? 1.0 : -1.0; goto do_angle;} # ifdef BIGDIG ASRTGO(NIMP(z), badz); - if BIGP(z) {x = (TYP16(z)==tc16_bigpos) ? 1.0 : -1.0; goto do_angle;} + if (BIGP(z)) {x = (TYP16(z)==tc16_bigpos) ? 1.0 : -1.0; goto do_angle;} # ifndef RECKLESS if (!(INEXP(z))) { badz: wta(z, (char *)ARG1, s_angle);} @@ -2345,7 +2390,7 @@ SCM angle(z) # else ASRTER(NIMP(z) && INEXP(z), z, ARG1, s_angle); # endif - if REALP(z) {x = REALPART(z); goto do_angle;} + if (REALP(z)) {x = REALPART(z); goto do_angle;} x = REAL(z); y = IMAG(z); do_angle: return makdbl(atan2(y, x), 0.0); @@ -2355,21 +2400,21 @@ do_angle: SCM ex2in(z) SCM z; { - if INUMP(z) return makdbl((double)INUM(z), 0.0); + if (INUMP(z)) return makdbl((double)INUM(z), 0.0); ASRTGO(NIMP(z), badz); - if INEXP(z) return z; + if (INEXP(z)) return z; # ifdef BIGDIG - if BIGP(z) return makdbl(big2dbl(z), 0.0); + if (BIGP(z)) return makdbl(big2dbl(z), 0.0); # endif badz: wta(z, (char *)ARG1, s_ex2in); } SCM in2ex(z) SCM z; { - if INUMP(z) return z; + if (INUMP(z)) return z; # ifdef BIGDIG ASRTGO(NIMP(z), badz); - if BIGP(z) return z; + if (BIGP(z)) return z; # ifndef RECKLESS if (!(REALP(z))) badz: wta(z, (char *)ARG1, s_in2ex); @@ -2400,11 +2445,38 @@ static char s_trunc[] = "truncate"; SCM numident(x) SCM x; { +# ifdef BIGDIG + ASRTER(INUMP(x) || (NIMP(x) && BIGP(x)), x, ARG1, s_trunc); +# else ASRTER(INUMP(x), x, ARG1, s_trunc); +# endif return x; } #endif /* FLOATS */ +SCM scm_iabs(x) + SCM x; +{ +#ifdef BIGDIG + if (NINUMP(x)) { + ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_abs); + if (TYP16(x)==tc16_bigpos) return x; + return copybig(x, 0); + } +#else + ASRTER(INUMP(x), x, ARG1, s_abs); +#endif + if (INUM(x) >= 0) return x; + x = -INUM(x); + if (!POSFIXABLE(x)) +#ifdef BIGDIG + return long2big(x); +#else + wta(MAKINUM(-x), (char *)OVFLOW, s_abs); +#endif + return MAKINUM(x); +} + #ifdef BIGDIG # ifdef FLOATS SCM dbl2big(d) @@ -2584,7 +2656,7 @@ unsigned long hasher(obj, n, d) case 2: case 6: /* INUMP(obj) */ return INUM(obj) % n; case 4: - if ICHRP(obj) + if (ICHRP(obj)) return (unsigned)(downcase[ICHR(obj)]) % n; switch ((int) obj) { #ifndef SICP @@ -2607,11 +2679,11 @@ unsigned long hasher(obj, n, d) default: return 263 % n; #ifdef FLOATS case tc16_flo: - if REALP(obj) { + if (REALP(obj)) { double r = REALPART(obj); if (floor(r)==r) { obj = in2ex(obj); - if IMP(obj) return INUM(obj) % n; + if (IMP(obj)) return INUM(obj) % n; goto bighash; } } @@ -2664,7 +2736,7 @@ SCM hashv(obj, n) SCM n; { ASRTER(INUMP(n) && 0 <= n, n, ARG2, s_hashv); - if ICHRP(obj) return MAKINUM((unsigned)(downcase[ICHR(obj)]) % INUM(n)); + if (ICHRP(obj)) return MAKINUM((unsigned)(downcase[ICHR(obj)]) % INUM(n)); if (NIMP(obj) && NUMP(obj)) return MAKINUM(hasher(obj, INUM(n), 10)); else return MAKINUM(obj % INUM(n)); } @@ -2687,10 +2759,11 @@ static iproc subr1s[] = { {"integer?", intp}, {s_real_part, real_part}, {s_imag_part, imag_part}, - {s_magnitude, magnitude}, + {s_magnitude, scm_magnitude}, {s_angle, angle}, {s_in2ex, in2ex}, {s_ex2in, ex2in}, + {s_abs, scm_abs}, # ifdef BIGDIG {s_dfloat_parts, scm_dfloat_parts}, # endif @@ -2703,6 +2776,7 @@ static iproc subr1s[] = { {"ceiling", numident}, {s_trunc, numident}, {"round", numident}, + {s_abs, scm_iabs}, #endif {s_zerop, zerop}, {s_positivep, positivep}, @@ -2772,7 +2846,7 @@ static iproc rpsubrs[] = { static dblproc cxrs[] = { {"floor", floor}, {"ceiling", ceil}, - {"truncate", ltrunc}, + {"truncate", scm_truncate}, {"round", scm_round}, {"$sqrt", sqrt}, {"$abs", fabs}, @@ -2788,14 +2862,14 @@ static dblproc cxrs[] = { {"$sinh", sinh}, {"$cosh", cosh}, {"$tanh", tanh}, - {"$asinh", lasinh}, - {"$acosh", lacosh}, - {"$atanh", latanh}, + {"$asinh", asinh}, + {"$acosh", acosh}, + {"$atanh", atanh}, {0, 0}}; #endif #ifdef FLOATS -static void add1(f, fsum) +static void safe_add_1(f, fsum) double f, *fsum; { *fsum = f + 1.0; @@ -2836,11 +2910,11 @@ void init_scl() # else { /* determine floating point precision */ double f = 0.1; - double fsum = 1.0+f; + volatile double fsum = 1.0+f; while (fsum != 1.0) { f /= 10.0; if (++dblprec > 20) break; - add1(f, &fsum); + safe_add_1(f, &fsum); } dblprec = dblprec-1; } @@ -2849,11 +2923,12 @@ void init_scl() dbl_mant_dig = DBL_MANT_DIG; # else { /* means we #defined it. */ - double fsum = 0.0, eps = 1.0; + volatile double fsum = 0.0; + double eps = 1.0; int i = 0; while (fsum != 1.0) { eps = 0.5 * eps; - add1(eps, &fsum); + safe_add_1(eps, &fsum); i++; } dbl_mant_dig = i; @@ -92,7 +92,7 @@ and .I sh respectively. On Amiga systems the entire option and argument need to be enclosed in -qoutes. For instance "-e(newline)". +quotes. For instance "-e(newline)". .TP .BI -r feature requires @@ -103,7 +103,7 @@ is not already supported. If .I feature is 2, 3, 4, or 5 .I scm -will require the features neccessary to support R2RS, R3RS, R4RS, or +will require the features necessary to support R2RS, R3RS, R4RS, or R5RS, respectively. .TP .BI -h feature @@ -117,7 +117,7 @@ loads .I filename. .I Scm will load the first (unoptioned) file named on the command line if no --c, -e, -f, -l, or -s option preceeds it. +-c, -e, -f, -l, or -s option precedes it. .TP .BI -d filename opens (read-only) the extended relational database @@ -144,7 +144,7 @@ sets the prolixity (verboseness) to .I level. This is the same as the .I scm -command (verobse +command (verbose .I level ). .TP @@ -207,7 +207,7 @@ errors. .B -s specifies, by analogy with .I sh, -that further options are to be treated as program aguments. +that further options are to be treated as program arguments. .TP .BI - .BI -- @@ -302,7 +302,7 @@ Arrays and bit-vectors. String ports and software emulation ports. I/O extensions providing most of ANSI C and POSIX.1 facilities. .PP User definable responses to interrupts and errors, -Process-syncronization primitives, String regular expression matching, +Process-synchronization primitives, String regular expression matching, and the CURSES screen management package. .PP Available add-on packages including an interactive debugger, database, @@ -236,11 +236,11 @@ SIGRETTYPE win32_sigint(int sig) CONTEXT ctx; DWORD *Stack; - if(-1 == SuspendThread(scm_hMainThread)) + if (-1 == SuspendThread(scm_hMainThread)) return; ctx.ContextFlags = CONTEXT_FULL; - if(0 == GetThreadContext(scm_hMainThread, &ctx)) + if (0 == GetThreadContext(scm_hMainThread, &ctx)) { ResumeThread(scm_hMainThread); return; @@ -289,7 +289,7 @@ static SIGRETTYPE scmable_signal(sig) if (sig == sigdesc[i].signo) break; ASRTER(i >= 0, MAKINUM(sig), s_unksig, ""); #ifdef WINSIGNALS - if(SIGINT == sig) + if (SIGINT == sig) signal(sig, win32_sigint); else #endif @@ -385,13 +385,11 @@ SCM scm_setitimer(which, value, interval) } # endif # ifndef AMIGA -# ifndef __CYGWIN32__ SCM l_pause() { pause(); return UNSPECIFIED; } -# endif # endif #endif /* SIGALRM */ @@ -680,14 +678,14 @@ void restore_signals() void scm_init_from_argv(argc, argv, script_arg, iverbose, buf0stdin) int argc; - char **argv; + const char * const *argv; char *script_arg; int iverbose; int buf0stdin; { long i = 0L; if ((2 <= argc) && argv[1] && (0==strncmp("-a", argv[1], 2))) { - char *str = (0==argv[1][2] && 3 <= argc && argv[2]) ?argv[2]:&argv[1][2]; + const char *str = (0==argv[1][2] && 3 <= argc && argv[2]) ?argv[2]:&argv[1][2]; do { switch (*str) { case DIGITS: @@ -731,7 +729,7 @@ void final_scm(freeall) # define SYSTNAME "unix" # define DIRSEP "/" #endif -#ifdef __CYGWIN32__ +#ifdef __CYGWIN__ # define SYSTNAME "unix" # define DIRSEP "/" #endif @@ -885,8 +883,8 @@ SCM scm_execpath(newpath) } char *scm_find_execpath(argc, argv, script_arg) int argc; - char **argv; - char *script_arg; + const char * const *argv; + const char *script_arg; { char *exepath = 0; #ifndef macintosh @@ -985,9 +983,7 @@ static iproc subr0s[] = { #endif #ifdef SIGALRM # ifndef AMIGA -# ifndef __CYGWIN32__ {"pause", l_pause}, -# endif # endif #endif {0, 0}}; @@ -1,9 +1,7 @@ +SCM(Jan 4 2000) SCM(Jan 4 2000) -SCM(Jan 4 2000) SCM(Jan 4 2000) - - NAME scm - a Scheme Language Interpreter @@ -17,63 +15,44 @@ SYNOPSIS DESCRIPTION Scm is a Scheme interpreter. - Upon startup scm loads the file specified by by the envi- - ronment variable SCM_INIT_PATH or by the parameter - IMPLINIT in the makefile (or scmfig.h) if SCM_INIT_PATH is - not defined. The makefiles attempt to set IMPLINIT to - "Init.scm" in the source directory. + Upon startup scm loads the file specified by by the environment vari- + able SCM_INIT_PATH or by the parameter IMPLINIT in the makefile (or + scmfig.h) if SCM_INIT_PATH is not defined. The makefiles attempt to + set IMPLINIT to "Init.scm" in the source directory. - 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 environ- - ment variable HOME (or in the current directory if HOME is - undefined). If it finds such a file it is loaded. + 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. - "Init.scm" then looks for command input from one of three - sources: From an option on the command line, from a file - named on the command line, or from standard input. + "Init.scm" then looks for command input from one of three sources: From + an option on the command line, from a file named on the command line, + or from standard input. OPTIONS - The options are processed in the order specified on the - command line. + The options are processed in the order specified on the command line. -akbytes - specifies that scm should allocate an initial heap- - size of kbytes. This option, if present, must be the - first on the command line. + specifies that scm should allocate an initial heapsize of kbytes. + This option, if present, must be the first on the command line. -no-init-file - Inhibits the loading of "ScmInit.scm" as described - above. + Inhibits the loading of "ScmInit.scm" as described above. -eexpression -cexpression - specifies that the scheme expression expression is to - be evaluated. These options are inspired by perl and - sh respectively. On Amiga systems the entire option - and argument need to be enclosed in qoutes. For - instance "-e(newline)". + specifies that the scheme expression expression is to be evalu- + ated. These options are inspired by perl and sh respectively. On + Amiga systems the entire option and argument need to be enclosed + in quotes. For instance "-e(newline)". -rfeature - requires feature. This will load a file from SLIB if - - - - 1 - - - - - -SCM(Jan 4 2000) SCM(Jan 4 2000) - - - that feature is not already supported. If feature is - 2, 3, 4, or 5 scm will require the features necces- - sary to support R2RS, R3RS, R4RS, or R5RS, respec- - tively. + requires feature. This will load a file from SLIB if that feature + is not already supported. If feature is 2, 3, 4, or 5 scm will + require the features necessary to support R2RS, R3RS, R4RS, or + R5RS, respectively. -hfeature provides feature. @@ -81,211 +60,153 @@ SCM(Jan 4 2000) SCM(Jan 4 2000) -lfilename -ffilename - loads filename. Scm will load the first (unoptioned) - file named on the command line if no -c, -e, -f, -l, - or -s option preceeds it. + loads filename. Scm will load the first (unoptioned) file named + on the command line if no -c, -e, -f, -l, or -s option precedes + it. -dfilename - opens (read-only) the extended relational database - filename. If filename contains initialization code, - it will be run when the database is opened. + opens (read-only) the extended relational database filename. If + filename contains initialization code, it will be run when the + database is opened. -odumpname - saves the current SCM session as the executable pro- - gram dumpname. This option works only in SCM builds - supporting dump. + saves the current SCM session as the executable program dumpname. + This option works only in SCM builds supporting dump. - If options appear on the command line after -o dump- - name, then the saved session will continue with pro- - cessing those options when it is invoked. Otherwise - the (new) command line is processed as usual when the - saved image is invoked. + If options appear on the command line after -o dumpname, then the + saved session will continue with processing those options when it + is invoked. Otherwise the (new) command line is processed as + usual when the saved image is invoked. -plevel - sets the prolixity (verboseness) to level. This is - the same as the scm command (verobse level ). - - -v (verbose mode) specifies that scm will print prompts, - evaluation times, notice of loading files, and - garbage collection statistics. This is the same as - -p3. - - -q (quiet mode) specifies that scm will print no extra - information. This is the same as -p0. + sets the prolixity (verboseness) to level. This is the same as + the scm command (verbose level ). - -m specifies that subsequent loads, evaluations, and - user interactions will be with R4RS macro capability. - To use a specific R4RS macro implementation from SLIB - (instead of SLIB's default) put -r macropackage - before -m on the command line. + -v (verbose mode) specifies that scm will print prompts, evaluation + times, notice of loading files, and garbage collection statistics. + This is the same as -p3. - -u specifies that subsequent loads, evaluations, and - user interactions will be without R4RS macro capabil- - ity. R4RS macro capability can be restored by a sub- - sequent -m on the command line or from Scheme code. + -q (quiet mode) specifies that scm will print no extra information. + This is the same as -p0. + -m specifies that subsequent loads, evaluations, and user interac- + tions will be with R4RS macro capability. To use a specific R4RS + macro implementation from SLIB (instead of SLIB’s default) put -r + macropackage before -m on the command line. + -u specifies that subsequent loads, evaluations, and user interac- + tions will be without R4RS macro capability. R4RS macro capabil- + ity can be restored by a subsequent -m on the command line or from + Scheme code. + -i specifies that scm should run interactively. That means that scm + will not terminate until the (quit) or (exit) command is given, + even if there are errors. It also sets the prolixity level to 2 + if it is less than 2. This will print prompts, evaluation times, + and notice of loading files. The prolixity level can be set by + subsequent options. If scm is started from a tty, it will assume + that it should be interactive unless given a subsequent -b option. - 2 + -b specifies that scm should run non-interactively. That means that + scm will terminate after processing the command line or if there + are errors. + -s specifies, by analogy with sh, that further options are to be + treated as program arguments. - - - -SCM(Jan 4 2000) SCM(Jan 4 2000) - - - -i specifies that scm should run interactively. That - means that scm will not terminate until the (quit) or - (exit) command is given, even if there are errors. - It also sets the prolixity level to 2 if it is less - than 2. This will print prompts, evaluation times, - and notice of loading files. The prolixity level can - be set by subsequent options. If scm is started from - a tty, it will assume that it should be interactive - unless given a subsequent -b option. - - -b specifies that scm should run non-interactively. - That means that scm will terminate after processing - the command line or if there are errors. - - -s specifies, by analogy with sh, that further options - are to be treated as program aguments. - - - -- specifies that there are no more options on the - command line. + - -- specifies that there are no more options on the command line. ENVIRONMENT VARIABLES SCM_INIT_PATH - is the pathname where scm will look for its initial- - ization code. The default is the file "Init.scm" in - the source directory. + is the pathname where scm will look for its initialization code. + The default is the file "Init.scm" in the source directory. SCHEME_LIBRARY_PATH is the SLIB Scheme library directory. - HOME is the directory where "Init.scm" will look for the - user initialization file "ScmInit.scm". + HOME is the directory where "Init.scm" will look for the user initial- + ization file "ScmInit.scm". SCHEME VARIABLES *argv* - contains the list of arguments to the program. - *argv* can change during argument processing. This - list is suitable for use as an argument to SLIB - getopt. + contains the list of arguments to the program. *argv* can change + during argument processing. This list is suitable for use as an + argument to SLIB getopt. *R4RS-macro* - controls whether loading and interaction support R4RS - macros. Define this in "ScmInit.scm" or files speci- - fied on the command line. This can be overridden by - subsequent -m and -u options. + controls whether loading and interaction support R4RS macros. + Define this in "ScmInit.scm" or files specified on the command + line. This can be overridden by subsequent -m and -u options. *interactive* - controls interactivity as explained for the -i and -b - options. Define this in "ScmInit.scm" or files spec- - ified on the command line. This can be overridden by - subsequent -i and -b options. + controls interactivity as explained for the -i and -b options. + Define this in "ScmInit.scm" or files specified on the command + line. This can be overridden by subsequent -i and -b options. EXAMPLES - - - - - - 3 - - - - - -SCM(Jan 4 2000) SCM(Jan 4 2000) - - % scm foo.scm arg1 arg2 arg3 - Load and execute the contents of foo.scm. Parameters - arg1 arg2 and arg3 are stored in the global list - *argv*. + Load and execute the contents of foo.scm. Parameters arg1 arg2 + and arg3 are stored in the global list *argv*. % scm -f foo.scm arg1 arg2 arg3 The same. % scm -s foo.scm arg1 arg2 - Set *argv* to ("foo.scm" "arg1" "arg2") and enter - interactive session. + Set *argv* to ("foo.scm" "arg1" "arg2") and enter interactive ses- + sion. - % scm -e '(display (list-ref *argv* *optind*))' bar - Print ``bar'' + % scm -e ’(display (list-ref *argv* *optind*))’ bar + Print ‘‘bar’’ % scm -rpretty-print -r format -i - Load pretty-print and format and enter interactive - mode. + Load pretty-print and format and enter interactive mode. % scm -r5 - Load dynamic-wind, values, and R4RS macros and enter - interactive (with macros) mode. + Load dynamic-wind, values, and R4RS macros and enter interactive + (with macros) mode. % scm -r5 -r4 - Like above but rev4-optional-procedures are also - loaded. + Like above but rev4-optional-procedures are also loaded. FEATURES - Runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, - Unicos, VMS, Unix and similar systems. Support for ASCII - and EBCDIC character sets. + Runs under Amiga, Atari-ST, MacOS, MS-DOS, OS/2, NOS/VE, Unicos, VMS, + Unix and similar systems. Support for ASCII and EBCDIC character sets. - Conforms to Revised^5 Report on the Algorithmic Language - Scheme and the IEEE P1178 specification. + Conforms to Revised^5 Report on the Algorithmic Language Scheme and the + IEEE P1178 specification. Support for SICP, R2RS, R3RS, and R4RS scheme code. - Many Common Lisp functions: logand, logor, logxor, lognot, - ash, logcount, integer-length, bit-extract, defmacro, - macroexpand, macroexpand1, gentemp, defvar, force-output, - software-type, get-decoded-time, get-internal-run-time, - get-internal-real-time, delete-file, rename-file, copy- - tree, acons, and eval. - - Char-code-limit, most-positive-fixnum, most-negative- - fixnum, and internal-time-units-per-second constants. - *Features* and *load-pathname* variables. - - Arrays and bit-vectors. String ports and software emula- - tion ports. I/O extensions providing most of ANSI C and - POSIX.1 facilities. - - User definable responses to interrupts and errors, Pro- - cess-syncronization primitives, String regular expression - - - - 4 + Many Common Lisp functions: logand, logor, logxor, lognot, ash, log- + count, integer-length, bit-extract, defmacro, macroexpand, macroex- + pand1, gentemp, defvar, force-output, software-type, get-decoded-time, + get-internal-run-time, get-internal-real-time, delete-file, rename- + file, copy-tree, acons, and eval. + Char-code-limit, most-positive-fixnum, most-negative-fixnum, and inter- + nal-time-units-per-second constants. *Features* and *load-pathname* + variables. + Arrays and bit-vectors. String ports and software emulation ports. + I/O extensions providing most of ANSI C and POSIX.1 facilities. + User definable responses to interrupts and errors, Process-synchroniza- + tion primitives, String regular expression matching, and the CURSES + screen management package. + Available add-on packages including an interactive debugger, database, + X-window graphics, BGI graphics, Motif, and Open-Windows packages. -SCM(Jan 4 2000) SCM(Jan 4 2000) + A compiler (HOBBIT, available separately) and dynamic linking of + compiled modules. - - matching, and the CURSES screen management package. - - Available add-on packages including an interactive debug- - ger, database, X-window graphics, BGI graphics, Motif, and - Open-Windows packages. - - A compiler (HOBBIT, available separately) and dynamic - linking of compiled modules. - - Setable levels of monitoring and timing information - printed interactively (the `verbose' function). Restart, - quit, and exec. + Setable levels of monitoring and timing information printed interac- + tively (the ‘verbose’ function). Restart, quit, and exec. FILES scm.texi - Texinfo documentation of scm enhancements, internal - representations, and how to extend or include scm - in other programs. + Texinfo documentation of scm enhancements, internal representa- + tions, and how to extend or include scm in other programs. AUTHORS Aubrey Jaffer (jaffer @ alum.mit.edu) @@ -296,9 +217,8 @@ SEE ALSO The SCM home-page: http://swissnet.ai.mit.edu/~jaffer/SCM.html - The Scheme specifications for details on specific proce- - dures (http://swissnet.ai.mit.edu/ftpdir/scheme-reports/) - or + The Scheme specifications for details on specific procedures + (http://swissnet.ai.mit.edu/ftpdir/scheme-reports/) or IEEE Std 1178-1990, IEEE Standard for the Scheme Programming Language, @@ -318,13 +238,4 @@ SEE ALSO - - - - - - - - 5 - - +4th Berkeley Distribution SCM(Jan 4 2000) @@ -98,7 +98,7 @@ typedef struct { sizet len; sizet alloclen; sizet maxlen; - char *what; + const char *what; char *elts;} scm_gra; #ifdef USE_ANSI_PROTOTYPES @@ -167,10 +167,12 @@ typedef struct {SCM type;float num;} flo; typedef struct {SCM type;double *real;} dbl; #endif -#define IMP(x) (6 & (int)(x)) + /* Conditionals should always expect immediates */ + /* GCC __builtin_expect() is stubbed in scmfig.h */ +#define IMP(x) SCM_EXPECT_TRUE(6 & (int)(x)) #define NIMP(x) (!IMP(x)) -#define INUMP(x) (2 & (int)(x)) +#define INUMP(x) SCM_EXPECT_TRUE(2 & (int)(x)) #define NINUMP(x) (!INUMP(x)) #define INUM0 ((SCM) 2) #define ICHRP(x) ((0xff & (int)(x))==0xf4) @@ -405,7 +407,7 @@ SCM_EXPORT long tc16_env, tc16_ident; /* ((&REAL(x))[1]) */ # ifdef SINGLES # define REALP(x) ((~REAL_PART & CAR(x))==tc_flo) -# define SINGP(x) (CAR(x)==tc_flo) +# define SINGP(x) SCM_EXPECT_TRUE(CAR(x)==tc_flo) # define FLO(x) (((flo *)(SCM2PTR(x)))->num) # define REALPART(x) (SINGP(x)?0.0+FLO(x):REAL(x)) # else /* SINGLES */ @@ -702,10 +704,10 @@ SCM_EXPORT void (*init_user_scm) P((void)); SCM_EXPORT void (* deferred_proc) P((void)); SCM_EXPORT void process_signals P((void)); SCM_EXPORT int handle_it P((int i)); -SCM_EXPORT SCM must_malloc_cell P((long len, SCM c, char *what)); -SCM_EXPORT void must_realloc_cell P((SCM z, long olen, long len, char *what)); -SCM_EXPORT char *must_malloc P((long len, char *what)); -SCM_EXPORT char *must_realloc P((char *where, long olen, long len, char *what)); +SCM_EXPORT SCM must_malloc_cell P((long len, SCM c, const char *what)); +SCM_EXPORT void must_realloc_cell P((SCM z, long olen, long len, const char *what)); +SCM_EXPORT char *must_malloc P((long len, const char *what)); +SCM_EXPORT char *must_realloc P((char *where, long olen, long len, const char *what)); SCM_EXPORT void must_free P((char *obj, sizet len)); SCM_EXPORT void scm_protect_temp P((SCM *ptr)); SCM_EXPORT long ilength P((SCM sx)); @@ -719,7 +721,7 @@ SCM_EXPORT unsigned long hasher P((SCM obj, unsigned long n, sizet d)); SCM_EXPORT SCM lroom P((SCM args)); SCM_EXPORT SCM lflush P((SCM port)); SCM_EXPORT void scm_init_gra P((scm_gra *gra, sizet eltsize, sizet len, - sizet maxlen, char *what)); + sizet maxlen, const char *what)); SCM_EXPORT int scm_grow_gra P((scm_gra *gra, char *elt)); SCM_EXPORT void scm_trim_gra P((scm_gra *gra)); SCM_EXPORT void scm_free_gra P((scm_gra *gra)); @@ -731,7 +733,7 @@ SCM_EXPORT void prinport P((SCM exp, SCM port, char *type)); SCM_EXPORT SCM repl P((void)); SCM_EXPORT void repl_report P((void)); SCM_EXPORT void growth_mon P((char *obj, long size, char *units, int grewp)); -SCM_EXPORT void gc_start P((char *what)); +SCM_EXPORT void gc_start P((const char *what)); SCM_EXPORT void gc_end P((void)); SCM_EXPORT void gc_mark P((SCM p)); SCM_EXPORT void scm_gc_hook P((void)); @@ -753,7 +755,7 @@ SCM_EXPORT void iprin1 P((SCM exp, SCM port, int writing)); SCM_EXPORT void intprint P((long n, int radix, SCM port)); SCM_EXPORT void iprlist P((char *hdr, SCM exp, int tlr, SCM port, int writing)); SCM_EXPORT SCM scm_env_lookup P((SCM var, SCM stenv)); -SCM_EXPORT SCM scm_env_rlookup P((SCM addr, SCM stenv, char *what)); +SCM_EXPORT SCM scm_env_rlookup P((SCM addr, SCM stenv, const char *what)); SCM_EXPORT SCM scm_env_getprop P((SCM prop, SCM env)); SCM_EXPORT SCM scm_env_addprop P((SCM prop, SCM val, SCM env)); SCM_EXPORT long num_frames P((SCM estk, int i)); @@ -763,7 +765,7 @@ SCM_EXPORT SCM stacktrace1 P((SCM estk, int i)); SCM_EXPORT void scm_princode P((SCM code, SCM env, SCM port, int writing)); SCM_EXPORT void scm_princlosure P((SCM proc, SCM port, int writing)); SCM_EXPORT void lputc P((int c, SCM port)); -SCM_EXPORT void lputs P((char *s, SCM port)); +SCM_EXPORT void lputs P((const char *s, SCM port)); SCM_EXPORT sizet lfwrite P((char *ptr, sizet size, sizet nitems, SCM port)); SCM_EXPORT int lgetc P((SCM port)); SCM_EXPORT void lungetc P((int c, SCM port)); @@ -777,14 +779,14 @@ SCM_EXPORT void init_iprocs P((iproc *subra, int type)); SCM_EXPORT void final_scm P((int)); SCM_EXPORT void init_sbrk P((void)); SCM_EXPORT int init_buf0 P((FILE *inport)); -SCM_EXPORT void scm_init_from_argv P((int argc, char **argv, char *script_arg, +SCM_EXPORT void scm_init_from_argv P((int argc, const char * const *argv, char *script_arg, int iverbose, int buf0stdin)); SCM_EXPORT void init_signals P((void)); SCM_EXPORT SCM scm_top_level P((char *initpath, SCM (*toplvl_fun)())); SCM_EXPORT void restore_signals P((void)); SCM_EXPORT void free_storage P((void)); SCM_EXPORT char *dld_find_executable P((const char* command)); -SCM_EXPORT char *scm_find_execpath P((int argc, char **argv, char *script_arg)); +SCM_EXPORT char *scm_find_execpath P((int argc, const char * const *argv, const char *script_arg)); SCM_EXPORT void init_scm P((int iverbose, int buf0stdin, long init_heap_size)); SCM_EXPORT void scm_init_INITS P((void)); SCM_EXPORT SCM scm_init_extensions P((void)); @@ -798,9 +800,9 @@ SCM_EXPORT SCM markcdr P((SCM ptr)); SCM_EXPORT SCM equal0 P((SCM ptr1, SCM ptr2)); SCM_EXPORT sizet free0 P((CELLPTR ptr)); SCM_EXPORT void scm_warn P((char *str1, char *str2, SCM obj)); -SCM_EXPORT void everr P((SCM exp, SCM env, SCM arg, char *pos, char *s_subr, int codep)); -SCM_EXPORT void wta P((SCM arg, char *pos, char *s_subr)); -SCM_EXPORT void scm_experr P((SCM arg, char *pos, char *s_subr)); +SCM_EXPORT void everr P((SCM exp, SCM env, SCM arg, const char *pos, const char *s_subr, int codep)); +SCM_EXPORT void wta P((SCM arg, const char *pos, const char *s_subr)); +SCM_EXPORT void scm_experr P((SCM arg, const char *pos, const char *s_subr)); SCM_EXPORT SCM intern P((char *name, sizet len)); SCM_EXPORT SCM sysintern P((const char *name, SCM val)); SCM_EXPORT SCM sym2vcell P((SCM sym)); @@ -870,7 +872,8 @@ SCM_EXPORT SCM difference P((SCM x, SCM y)); SCM_EXPORT SCM product P((SCM x, SCM y)); SCM_EXPORT SCM divide P((SCM x, SCM y)); SCM_EXPORT SCM lquotient P((SCM x, SCM y)); -SCM_EXPORT SCM absval P((SCM x)); +SCM_EXPORT SCM scm_iabs P((SCM x)); +SCM_EXPORT SCM scm_abs P((SCM x)); SCM_EXPORT SCM lremainder P((SCM x, SCM y)); SCM_EXPORT SCM modulo P((SCM x, SCM y)); SCM_EXPORT SCM lgcd P((SCM x, SCM y)); @@ -942,12 +945,12 @@ SCM_EXPORT SCM for_each P((SCM proc, SCM arg1, SCM args)); SCM_EXPORT SCM procedurep P((SCM obj)); SCM_EXPORT SCM apply P((SCM proc, SCM arg1, SCM args)); SCM_EXPORT SCM scm_cvapply P((SCM proc, long n, SCM *argv)); -SCM_EXPORT int scm_arity_check P((SCM proc, long argc, char *what)); +SCM_EXPORT int scm_arity_check P((SCM proc, long argc, const char *what)); SCM_EXPORT SCM map P((SCM proc, SCM arg1, SCM args)); SCM_EXPORT SCM scm_make_cont P((void)); SCM_EXPORT SCM copytree P((SCM obj)); SCM_EXPORT SCM eval P((SCM obj)); -SCM_EXPORT SCM scm_values P((SCM arg1, SCM arg2, SCM rest, char *what)); +SCM_EXPORT SCM scm_values P((SCM arg1, SCM arg2, SCM rest, const char *what)); SCM_EXPORT SCM scm_eval_values P((SCM x, SCM static_env, SCM env)); SCM_EXPORT SCM identp P((SCM obj)); SCM_EXPORT SCM ident2sym P((SCM id)); @@ -970,7 +973,7 @@ SCM_EXPORT SCM scm_read P((SCM port)); SCM_EXPORT SCM scm_read_char P((SCM port)); SCM_EXPORT SCM peek_char P((SCM port)); SCM_EXPORT SCM eof_objectp P((SCM x)); -SCM_EXPORT int scm_io_error P((SCM port, char *what)); +SCM_EXPORT int scm_io_error P((SCM port, const char *what)); SCM_EXPORT SCM lwrite P((SCM obj, SCM port)); SCM_EXPORT SCM display P((SCM obj, SCM port)); SCM_EXPORT SCM newline P((SCM port)); @@ -978,7 +981,7 @@ SCM_EXPORT SCM write_char P((SCM chr, SCM port)); SCM_EXPORT SCM scm_port_line P((SCM port)); SCM_EXPORT SCM scm_port_col P((SCM port)); SCM_EXPORT void scm_line_msg P((SCM file, SCM linum, SCM port)); -SCM_EXPORT void scm_err_line P((char *what, SCM file, SCM linum, SCM port)); +SCM_EXPORT void scm_err_line P((const char *what, SCM file, SCM linum, SCM port)); SCM_EXPORT SCM lgetenv P((SCM nam)); SCM_EXPORT SCM prog_args P((void)); SCM_EXPORT SCM makacro P((SCM code)); @@ -1005,7 +1008,7 @@ SCM_EXPORT void add_final P((void (*final)(void))); SCM_EXPORT SCM makcclo P((SCM proc, long len)); SCM_EXPORT SCM make_uve P((long k, SCM prot)); SCM_EXPORT long scm_prot2type P((SCM prot)); -SCM_EXPORT long aind P((SCM ra, SCM args, char *what)); +SCM_EXPORT long aind P((SCM ra, SCM args, const char *what)); SCM_EXPORT SCM scm_eval_string P((SCM str)); SCM_EXPORT SCM scm_load_string P((SCM str)); SCM_EXPORT SCM scm_unexec P((const SCM pathname)); @@ -1033,11 +1036,11 @@ SCM_EXPORT unsigned long num2ulong P((SCM num, char *pos, char *s_caller)); SCM_EXPORT long num2long P((SCM num, char *pos, char *s_caller)); SCM_EXPORT short num2short P((SCM num, char *pos, char *s_caller)); SCM_EXPORT double num2dbl P((SCM num, char *pos, char *s_caller)); -SCM_EXPORT SCM makfromstr P((char *src, sizet len)); -SCM_EXPORT SCM makfromstrs P((int argc, char **argv)); -SCM_EXPORT SCM makfrom0str P((char *scr)); -SCM_EXPORT char **makargvfrmstrs P((SCM args, char *s_v)); -SCM_EXPORT void must_free_argv P((char **argv)); +SCM_EXPORT SCM makfromstr P((const char *src, sizet len)); +SCM_EXPORT SCM makfromstrs P((int argc, const char * const *argv)); +SCM_EXPORT SCM makfrom0str P((const char *scr)); +SCM_EXPORT char **makargvfrmstrs P((SCM args, const char *s_v)); +SCM_EXPORT void must_free_argv P((const char * const *argv)); SCM_EXPORT SCM scm_evstr P((char *str)); SCM_EXPORT void scm_ldstr P((char *str)); SCM_EXPORT int scm_ldfile P((char *path)); @@ -1050,10 +1053,7 @@ SCM_EXPORT int scm_cell_p P((SCM x)); SCM_EXPORT SCM makdbl P((double x, double y)); SCM_EXPORT SCM dbl2big P((double d)); SCM_EXPORT double big2dbl P((SCM b)); -SCM_EXPORT double lasinh P((double x)); -SCM_EXPORT double lacosh P((double x)); -SCM_EXPORT double latanh P((double x)); -SCM_EXPORT double ltrunc P((double x)); +SCM_EXPORT double scm_truncate P((double x)); SCM_EXPORT double scm_round P((double x)); SCM_EXPORT double floident P((double x)); #endif @@ -1079,9 +1079,9 @@ SCM_EXPORT int scm_bigdblcomp P((SCM b, double d)); SCM_EXPORT char * scm_cat_path P((char *str1, const char *str2, long n)); SCM_EXPORT char * scm_try_path P((char *path)); SCM_EXPORT char * script_find_executable P((const char *command)); -SCM_EXPORT char ** script_process_argv P((int argc, char **argv)); -SCM_EXPORT int script_count_argv P((char **argv)); -SCM_EXPORT char * find_impl_file P((char *exec_path, const char *generic_name, +SCM_EXPORT char ** script_process_argv P((int argc, const char **argv)); +SCM_EXPORT int script_count_argv P((const char **argv)); +SCM_EXPORT char * find_impl_file P((const char *exec_path, const char *generic_name, const char *initname, const char *sep)); /* environment cache functions */ @@ -1111,8 +1111,8 @@ SCM_EXPORT SCM scm_trace, scm_trace_env; # define ASRTER(_cond, _arg, _pos, _subr) ; # define ASRTGO(_cond, _label) ; #else -# define ASRTER(_cond, _arg, _pos, _subr) if(!(_cond))wta(_arg, (char *)(_pos), _subr); -# define ASRTGO(_cond, _label) if(!(_cond)) goto _label; +# define ASRTER(_cond, _arg, _pos, _subr) if (SCM_EXPECT_FALSE(!(_cond))) wta(_arg, (char *)(_pos), _subr); +# define ASRTGO(_cond, _label) if (SCM_EXPECT_FALSE(!(_cond))) goto _label; #endif #define ARGn 1 @@ -1138,12 +1138,12 @@ SCM_EXPORT SCM scm_trace, scm_trace_env; #define PROF_SIGNAL 20 #define EVAL(x, env, venv) (IMP(x)?(x):ceval((x), (SCM)(env), (SCM)(venv))) -#define SIDEVAL(x, env, venv) if NIMP(x) ceval((x), (SCM)(env), (SCM)(venv)) +#define SIDEVAL(x, env, venv) if (NIMP(x)) ceval((x), (SCM)(env), (SCM)(venv)) -#define NEWCELL(_into) {if IMP(freelist) _into = gc_for_newcell();\ +#define NEWCELL(_into) {if (IMP(freelist)) _into = gc_for_newcell();\ else {_into = freelist;freelist = CDR(freelist);++cells_allocated;}} /* -#define NEWCELL(_into) {DEFER_INTS;if IMP(freelist) _into = gc_for_newcell();\ +#define NEWCELL(_into) {DEFER_INTS;if (IMP(freelist)) _into = gc_for_newcell();\ else {_into = freelist;freelist = CDR(freelist);++cells_allocated;}\ ALLOW_INTS;} */ @@ -1,4 +1,4 @@ -This is scm.info, produced by makeinfo version 4.7 from scm.texi. | +This is scm.info, produced by makeinfo version 4.7 from scm.texi. INFO-DIR-SECTION The Algorithmic Language Scheme START-INFO-DIR-ENTRY @@ -9,10 +9,10 @@ END-INFO-DIR-ENTRY File: scm.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir) This manual documents the SCM Scheme implementation. SCM version -5e1 was released June 2005. The most recent information about SCM can | -be found on SCM's "WWW" home page: | +5e2 was released February 2006. The most recent information about SCM | +can be found on SCM's "WWW" home page: | - `http://swiss.csail.mit.edu/~jaffer/SCM' | + `http://swiss.csail.mit.edu/~jaffer/SCM' Copyright (C) 1990-1999 Free Software Foundation @@ -43,8 +43,8 @@ approved by the author. File: scm.info, Node: Overview, Next: Installing SCM, Prev: Top, Up: Top -1 Overview | -********** | +1 Overview +********** Scm is a portable Scheme implementation written in C. Scm provides a machine independent platform for [JACAL], a symbolic algebra system. @@ -59,8 +59,8 @@ machine independent platform for [JACAL], a symbolic algebra system. File: scm.info, Node: SCM Features, Next: SCM Authors, Prev: Overview, Up: Overview -1.1 Features | -============ | +1.1 Features +============ * Conforms to Revised^5 Report on the Algorithmic Language Scheme [R5RS] and the [IEEE] P1178 specification. @@ -109,8 +109,8 @@ File: scm.info, Node: SCM Features, Next: SCM Authors, Prev: Overview, Up: O File: scm.info, Node: SCM Authors, Next: Copying, Prev: SCM Features, Up: Overview -1.2 Authors | -=========== | +1.2 Authors +=========== Aubrey Jaffer (agj @ alum.mit.edu) Most of SCM. @@ -138,70 +138,70 @@ file `ChangeLog', a log of changes that have been made to scm. File: scm.info, Node: Copying, Next: Bibliography, Prev: SCM Authors, Up: Overview -1.3 Copyright | -============= | +1.3 Copyright +============= Authors have assigned their SCM copyrights to: Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111, USA -* Menu: | - | -* The SCM License:: | -* SIOD copyright:: | - | +* Menu: + +* The SCM License:: +* SIOD copyright:: + File: scm.info, Node: The SCM License, Next: SIOD copyright, Prev: Copying, Up: Copying - | -1.3.1 The SCM License | ---------------------- | - | -The license of SCM consists of the GNU GPL plus a special statement | -giving blanket permission to link with non-free software. This is the | -license statement as found in any individual file that it applies to: | - | - 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, Inc., 59 Temple Place, Suite 330, | - Boston, MA 02111-1307 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. | - | + +1.3.1 The SCM License +--------------------- + +The license of SCM consists of the GNU GPL plus a special statement +giving blanket permission to link with non-free software. This is the +license statement as found in any individual file that it applies to: + + 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, Inc., 59 Temple Place, Suite 330, + Boston, MA 02111-1307 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. + Permission to use, copy, modify, distribute, and sell this software and its documentation for any purpose is hereby granted without fee, provided that the above copyright notice appear in all copies and that @@ -232,9 +232,9 @@ OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. File: scm.info, Node: SIOD copyright, Prev: The SCM License, Up: Copying - | -1.3.2 SIOD copyright | --------------------- | + +1.3.2 SIOD copyright +-------------------- COPYRIGHT (c) 1989 BY @@ -267,8 +267,8 @@ Cambridge, MA 02138 File: scm.info, Node: Bibliography, Prev: Copying, Up: Overview -1.4 Bibliography | -================ | +1.4 Bibliography +================ [IEEE] `IEEE Standard 1178-1990. IEEE Standard for the Scheme @@ -331,8 +331,8 @@ File: scm.info, Node: Bibliography, Prev: Copying, Up: Overview File: scm.info, Node: Installing SCM, Next: Operational Features, Prev: Overview, Up: Top -2 Installing SCM | -**************** | +2 Installing SCM +**************** * Menu: @@ -352,8 +352,8 @@ File: scm.info, Node: Installing SCM, Next: Operational Features, Prev: Overv File: scm.info, Node: Making SCM, Next: SLIB, Prev: Installing SCM, Up: Installing SCM -2.1 Making SCM | -============== | +2.1 Making SCM +============== The SCM distribution has "Makefile" which contains rules for making "scmlit", a "bare-bones" version of SCM sufficient for running `build'. @@ -364,7 +364,7 @@ Makefiles are not portable to the majority of platforms. If `Makefile' works for you, good; If not, I don't want to hear about it. If you need to compile SCM without build, there are several ways to proceed: - * Use the build (http://swiss.csail.mit.edu/~jaffer/buildscm.html) | + * Use the build (http://swiss.csail.mit.edu/~jaffer/buildscm.html) web page to create custom batch scripts for compiling SCM. * Use SCM on a different platform to run `build' to create a script @@ -378,8 +378,8 @@ need to compile SCM without build, there are several ways to proceed: File: scm.info, Node: SLIB, Next: Building SCM, Prev: Making SCM, Up: Installing SCM -2.2 SLIB | -======== | +2.2 SLIB +======== [SLIB] is a portable Scheme library meant to provide compatibility and utility functions for all standard Scheme implementations. Although @@ -387,18 +387,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/slib3a2.tar.gz | + * swiss.csail.mit.edu:/pub/scm/slib3a3.tar.gz | - * ftp.gnu.org:/pub/gnu/jacal/slib3a2.tar.gz | + * ftp.gnu.org:/pub/gnu/jacal/slib3a3.tar.gz | - * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a2.tar.gz | + * ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a3.tar.gz | -Unpack SLIB (`tar xzf slib3a2.tar.gz' or `unzip -ao slib3a2.zip') in an | +Unpack SLIB (`tar xzf slib3a3.tar.gz' or `unzip -ao slib3a3.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 `Init5e1.scm' is | +(this is the same directory as where the file `Init5e2.scm' is | installed). `require.scm' should have the contents: (define (library-vicinity) "/usr/local/lib/slib/") @@ -422,8 +422,8 @@ overrides `require.scm'. Again, absolute pathnames are recommended. File: scm.info, Node: Building SCM, Next: Installing Dynamic Linking, Prev: SLIB, Up: Installing SCM -2.3 Building SCM | -================ | +2.3 Building SCM +================ The file "build" loads the file "build.scm", which constructs a relational database of how to compile and link SCM executables. @@ -441,8 +441,8 @@ ai.mit.edu. File: scm.info, Node: Invoking Build, Next: Build Options, Prev: Building SCM, Up: Building SCM -2.3.1 Invoking Build | --------------------- | +2.3.1 Invoking Build +-------------------- The _all_ method will also work for MS-DOS and unix. Use the _all_ method if you encounter problems with `build'. @@ -470,7 +470,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 "Init5e1.scm"'>>scmflags.h | + echo '#define IMPLINIT "Init5e2.scm"'>>scmflags.h | echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h echo '#define ARRAYS'>>scmflags.h @@ -489,7 +489,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 "Init5e1.scm"'>>scmflags.h | + echo '#define IMPLINIT "Init5e2.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 @@ -499,149 +499,149 @@ in the `-p' or `--platform=' option. File: scm.info, Node: Build Options, Next: Compiling and Linking Custom Files, Prev: Invoking Build, Up: Building SCM -2.3.2 Build Options | -------------------- | +2.3.2 Build Options +------------------- The options to "build" specify what, where, and how to build a SCM program or dynamically linked module. These options are unrelated to the SCM command line options. - -- Build Option: -p PLATFORM-NAME | - -- Build Option: --platform=PLATFORM-NAME | + -- Build Option: -p PLATFORM-NAME + -- Build Option: --platform=PLATFORM-NAME specifies that the compilation should be for a computer/operating-system combination called PLATFORM-NAME. - _Note_ The case of PLATFORM-NAME is distinguised. The current | + _Note_ The case of PLATFORM-NAME is distinguised. The current PLATFORM-NAMEs are all lower-case. The platforms defined by table "platform" in `build.scm' are: - Table: platform | - name processor operating-system compiler | - #f processor-family operating-system #f | - symbol processor-family operating-system symbol | - symbol symbol symbol symbol | - ================= ================= ================= ================= | - *unknown* *unknown* unix cc | - acorn-unixlib acorn *unknown* cc | - aix powerpc aix cc | - alpha-elf alpha unix cc | - alpha-linux alpha linux gcc | - amiga-aztec m68000 amiga cc | - amiga-dice-c m68000 amiga dcc | - amiga-gcc m68000 amiga gcc | - amiga-sas m68000 amiga lc | - atari-st-gcc m68000 atari.st gcc | - atari-st-turbo-c m68000 atari.st tcc | - borland-c i8086 ms-dos bcc | - darwin powerpc unix cc | - djgpp i386 ms-dos gcc | - freebsd i386 unix cc | - gcc *unknown* unix gcc | - gnu-win32 i386 unix gcc | - highc i386 ms-dos hc386 | - hp-ux hp-risc hp-ux cc | - irix mips irix gcc | - linux i386 linux gcc | - linux-aout i386 linux gcc | - microsoft-c i8086 ms-dos cl | - microsoft-c-nt i386 ms-dos cl | - microsoft-quick-c i8086 ms-dos qcl | - ms-dos i8086 ms-dos cc | - netbsd *unknown* unix gcc | - openbsd *unknown* unix gcc | - os/2-cset i386 os/2 icc | - os/2-emx i386 os/2 gcc | - osf1 alpha unix cc | - plan9-8 i386 plan9 8c | - sunos sparc sunos cc | - svr4 *unknown* unix cc | - svr4-gcc-sun-ld sparc sunos gcc | - turbo-c i8086 ms-dos tcc | - unicos cray unicos cc | - unix *unknown* unix cc | - vms vax vms cc | - vms-gcc vax vms gcc | - watcom-9.0 i386 ms-dos wcc386p | - - -- Build Option: -f PATHNAME | + Table: platform + name processor operating-system compiler + #f processor-family operating-system #f + symbol processor-family operating-system symbol + symbol symbol symbol symbol + ================= ================= ================= ================= + *unknown* *unknown* unix cc + acorn-unixlib acorn *unknown* cc + aix powerpc aix cc + alpha-elf alpha unix cc + alpha-linux alpha linux gcc + amiga-aztec m68000 amiga cc + amiga-dice-c m68000 amiga dcc + amiga-gcc m68000 amiga gcc + amiga-sas m68000 amiga lc + atari-st-gcc m68000 atari.st gcc + atari-st-turbo-c m68000 atari.st tcc + borland-c i8086 ms-dos bcc + darwin powerpc unix cc + djgpp i386 ms-dos gcc + freebsd i386 unix cc + gcc *unknown* unix gcc + gnu-win32 i386 unix gcc + highc i386 ms-dos hc386 + hp-ux hp-risc hp-ux cc + irix mips irix gcc + linux i386 linux gcc + linux-aout i386 linux gcc + microsoft-c i8086 ms-dos cl + microsoft-c-nt i386 ms-dos cl + microsoft-quick-c i8086 ms-dos qcl + ms-dos i8086 ms-dos cc + netbsd *unknown* unix gcc + openbsd *unknown* unix gcc + os/2-cset i386 os/2 icc + os/2-emx i386 os/2 gcc + osf1 alpha unix cc + plan9-8 i386 plan9 8c + sunos sparc sunos cc + svr4 *unknown* unix cc + svr4-gcc-sun-ld sparc sunos gcc + turbo-c i8086 ms-dos tcc + unicos cray unicos cc + unix *unknown* unix cc + vms vax vms cc + vms-gcc vax vms gcc + watcom-9.0 i386 ms-dos wcc386p + + -- Build Option: -f PATHNAME specifies that the build options contained in PATHNAME be spliced - into the argument list at this point. The use of option files can | - separate functional features from platform-specific ones. | - - The `Makefile' calls out builds with the options in `.opt' files: | - | - `dlls.opt' | - Options for Makefile targets mydlls, myturtle, and x.so. | - | - `gdb.opt' | - Options for udgdbscm and gdbscm. | - | - `libscm.opt' | - Options for libscm.a. | - | - `pg.opt' | - Options for pgscm, which instruments C functions. | - | - `udscm4.opt' | - Options for targets udscm4 and dscm4 (scm). | - | - `udscm5.opt' | - Options for targets udscm5 and dscm5 (scm). | - | - The Makefile creates options files it depends on only if they do | - not already exist. | - | - -- Build Option: -o FILENAME | - -- Build Option: --outname=FILENAME | + into the argument list at this point. The use of option files can + separate functional features from platform-specific ones. + + The `Makefile' calls out builds with the options in `.opt' files: + + `dlls.opt' + Options for Makefile targets mydlls, myturtle, and x.so. + + `gdb.opt' + Options for udgdbscm and gdbscm. + + `libscm.opt' + Options for libscm.a. + + `pg.opt' + Options for pgscm, which instruments C functions. + + `udscm4.opt' + Options for targets udscm4 and dscm4 (scm). + + `udscm5.opt' + Options for targets udscm5 and dscm5 (scm). + + The Makefile creates options files it depends on only if they do + not already exist. + + -- Build Option: -o FILENAME + -- Build Option: --outname=FILENAME specifies that the compilation should produce an executable or object name of FILENAME. The default is `scm'. Executable suffixes will be added if neccessary, e.g. `scm' => `scm.exe'. - -- Build Option: -l LIBNAME ... | - -- Build Option: --libraries=LIBNAME | + -- Build Option: -l LIBNAME ... + -- Build Option: --libraries=LIBNAME specifies that the LIBNAME should be linked with the executable produced. If compile flags or include directories (`-I') are needed, they are automatically supplied for compilations. The `c' library is always included. SCM "features" specify any libraries they need; so you shouldn't need this option often. - -- Build Option: -D DEFINITION ... | - -- Build Option: --defines=DEFINITION | + -- Build Option: -D DEFINITION ... + -- Build Option: --defines=DEFINITION specifies that the DEFINITION should be made in any C source compilations. If compile flags or include directories (`-I') are needed, they are automatically supplied for compilations. SCM "features" specify any flags they need; so you shouldn't need this option often. - -- Build Option: --compiler-options=FLAG | + -- Build Option: --compiler-options=FLAG specifies that that FLAG will be put on compiler command-lines. - -- Build Option: --linker-options=FLAG | + -- Build Option: --linker-options=FLAG specifies that that FLAG will be put on linker command-lines. - -- Build Option: -s PATHNAME | - -- Build Option: --scheme-initial=PATHNAME | + -- Build Option: -s PATHNAME + -- Build Option: --scheme-initial=PATHNAME specifies that PATHNAME should be the default location of the SCM - initialization file `Init5e1.scm'. SCM tries several likely | + initialization file `Init5e2.scm'. SCM tries several likely | locations before resorting to PATHNAME (*note File-System Habitat::). If not specified, the current directory (where build is building) is used. - -- Build Option: -c PATHNAME ... | - -- Build Option: --c-source-files=PATHNAME | + -- Build Option: -c PATHNAME ... + -- Build Option: --c-source-files=PATHNAME specifies that the C source files PATHNAME ... are to be compiled. - -- Build Option: -j PATHNAME ... | - -- Build Option: --object-files=PATHNAME | + -- Build Option: -j PATHNAME ... + -- Build Option: --object-files=PATHNAME specifies that the object files PATHNAME ... are to be linked. - -- Build Option: -i CALL ... | - -- Build Option: --initialization=CALL | + -- Build Option: -i CALL ... + -- Build Option: --initialization=CALL specifies that the C functions CALL ... are to be invoked during initialization. - -- Build Option: -t BUILD-WHAT | - -- Build Option: --type=BUILD-WHAT | + -- Build Option: -t BUILD-WHAT + -- Build Option: --type=BUILD-WHAT specifies in general terms what sort of thing to build. The choices are: `exe' @@ -658,8 +658,8 @@ the SCM command line options. The default is to build an executable. - -- Build Option: -h BATCH-SYNTAX | - -- Build Option: -batch-dialect=BATCH-SYNTAX | + -- Build Option: -h BATCH-SYNTAX + -- Build Option: -batch-dialect=BATCH-SYNTAX specifies how to build. The default is to create a batch file for the host system. The SLIB file `batch.scm' knows how to create batch files for: @@ -680,13 +680,13 @@ the SCM command line options. This option outputs Scheme code. - -- Build Option: -w BATCH-FILENAME | - -- Build Option: -script-name=BATCH-FILENAME | + -- Build Option: -w BATCH-FILENAME + -- Build Option: -script-name=BATCH-FILENAME specifies where to write the build script. The default is to display it on `(current-output-port)'. - -- Build Option: -F FEATURE ... | - -- Build Option: --features=FEATURE | + -- Build Option: -F FEATURE ... + -- Build Option: --features=FEATURE specifies to build the given features into the executable. The defined features are: @@ -702,9 +702,9 @@ the SCM command line options. "bignums" Large precision integers. - "byte" | - Treating strings as byte-vectors. | - | + "byte" + Treating strings as byte-vectors. + "careful-interrupt-masking" Define this for extra checking of interrupt masking and some simple checks for proper use of malloc and free. This is for @@ -740,9 +740,9 @@ the SCM command line options. `careful-interrupt-masking', and `stack-limit'; uses `-g' flags for debugging SCM source code. - "differ" | - Sequence comparison | - | + "differ" + Sequence comparison + "dump" Convert a running scheme program into an executable file. @@ -827,8 +827,8 @@ the SCM command line options. numbers. "socket" - BSD "socket" interface. Socket addr functions require | - inexacts or bignums for 32-bit precision. | + 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 @@ -848,9 +848,9 @@ the SCM command line options. Those unix features which have not made it into the Posix specs: nice, acct, lstat, readlink, symlink, mknod and sync. - "wb" | - WB database with relational wrapper. | - | + "wb" + WB database with relational wrapper. + "windows" Microsoft Windows executable. @@ -864,8 +864,8 @@ the SCM command line options. File: scm.info, Node: Compiling and Linking Custom Files, Prev: Build Options, Up: Building SCM -2.3.3 Compiling and Linking Custom Files | ----------------------------------------- | +2.3.3 Compiling and Linking Custom Files +---------------------------------------- A correspondent asks: @@ -875,14 +875,14 @@ A correspondent asks: build.scm or the Makefile or both? (*note Changing Scm:: has instructions describing the C code format). Suppose -a C file "foo.c" has functions you wish to add to SCM. To compile and | -link your file at compile time, use the `-c' and `-i' options to build: | +a C file "foo.c" has functions you wish to add to SCM. To compile and +link your file at compile time, use the `-c' and `-i' options to build: bash$ ./build -c foo.c -i init_foo -| #! /bin/sh rm -f scmflags.h - echo '#define IMPLINIT "/home/jaffer/scm/Init5e1.scm"'>>scmflags.h | + echo '#define IMPLINIT "/home/jaffer/scm/Init5e2.scm"'>>scmflags.h | echo '#define COMPILED_INITS init_foo();'>>scmflags.h echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h @@ -898,7 +898,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/Init5e1.scm"'>>scmflags.h | + echo '#define IMPLINIT "/home/jaffer/scm/Init5e2.scm"'>>scmflags.h | echo '#define BIGNUMS'>>scmflags.h echo '#define FLOATS'>>scmflags.h echo '#define ARRAYS'>>scmflags.h @@ -914,8 +914,8 @@ add a compiled dll file to SLIB's catalog. File: scm.info, Node: Installing Dynamic Linking, Next: Configure Module Catalog, Prev: Building SCM, Up: Installing SCM -2.4 Installing Dynamic Linking | -============================== | +2.4 Installing Dynamic Linking +============================== Dynamic linking has not been ported to all platforms. Operating systems in the BSD family (a.out binary format) can usually be ported to "DLD". @@ -954,15 +954,15 @@ These notes about using libdl on SunOS are from `gcc.info': File: scm.info, Node: Configure Module Catalog, Next: Saving Images, Prev: Installing Dynamic Linking, Up: Installing SCM -2.5 Configure Module Catalog | -============================ | +2.5 Configure Module Catalog +============================ The SLIB module "catalog" can be extended to define other `require'-able packages by adding calls to the Scheme source file `mkimpcat.scm'. Within `mkimpcat.scm', the following procedures are defined. - -- Function: add-link feature object-file lib1 ... | + -- Function: add-link feature object-file lib1 ... FEATURE should be a symbol. OBJECT-FILE should be a string naming a file containing compiled "object-code". Each LIBn argument should be either a string naming a library file or `#f'. @@ -983,7 +983,7 @@ defined. link:able-suffix)) - -- Function: add-alias alias feature | + -- Function: add-alias alias feature ALIAS and FEATURE are symbols. The procedure `add-alias' registers ALIAS as an alias for FEATURE. An unspecified value is returned. @@ -991,7 +991,7 @@ defined. `add-alias' causes `(require 'ALIAS)' to behave like `(require 'FEATURE)'. - -- Function: add-source feature filename | + -- Function: add-source feature filename FEATURE is a symbol. FILENAME is a string naming a file containing Scheme source code. The procedure `add-source' registers FEATURE so that the first time `require' is called with @@ -1004,8 +1004,8 @@ Remember to delete the file `slibcat' after modifying the file File: scm.info, Node: Saving Images, Next: Automatic C Preprocessor Definitions, Prev: Configure Module Catalog, Up: Installing SCM -2.6 Saving Images | -================= | +2.6 Saving Images +================= In SCM, the ability to save running program images is called "dump" (*note Dump::). In order to make `dump' available to SCM, build with @@ -1021,8 +1021,8 @@ file from emacs. File: scm.info, Node: Automatic C Preprocessor Definitions, Next: Problems Compiling, Prev: Saving Images, Up: Installing SCM -2.7 Automatic C Preprocessor Definitions | -======================================== | +2.7 Automatic C Preprocessor Definitions +======================================== These `#defines' are automatically provided by preprocessors of various C compilers. SCM uses the presence or absence of these definitions to @@ -1037,6 +1037,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 | _DCC Dice C on AMIGA __GNUC__ Gnu CC (and DJGPP) __EMX__ Gnu C port (gcc/emx 0.8e) to OS/2 2.0 @@ -1066,13 +1067,14 @@ 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 | MSDOS Microsoft C 5.10 and 6.00A _MSDOS Microsoft CLARM and CLTHUMB compilers. __MSDOS__ Turbo C, Borland C, and DJGPP __NetBSD__ NetBSD nosve Control Data NOS/VE SVR2 System V Revision 2. - sun SunOS | + sun SunOS __SVR4 SunOS THINK_C developement environment for the Macintosh ultrix VAX with ULTRIX operating system. @@ -1091,9 +1093,9 @@ lines or add a `#define FLAG' line to `scmfig.h' or the beginning of __alpha DEC Alpha processor __alpha__ DEC Alpha processor hp9000s800 HP RISC processor - __ia64 GCC on IA64 | - __ia64__ GCC on IA64 | - _LONGLONG GCC on IA64 | + __ia64 GCC on IA64 + __ia64__ GCC on IA64 + _LONGLONG GCC on IA64 __i386__ DJGPP i386 DJGPP _M_ARM Microsoft CLARM compiler defines as 4 for ARM. @@ -1107,12 +1109,13 @@ 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 | File: scm.info, Node: Problems Compiling, Next: Problems Linking, Prev: Automatic C Preprocessor Definitions, Up: Installing SCM -2.8 Problems Compiling | -====================== | +2.8 Problems Compiling +====================== FILE PROBLEM / MESSAGE HOW TO FIX *.c include file not found. Correct the status of @@ -1144,8 +1147,8 @@ scl.c syntax error. #define SYSTNAME to your system File: scm.info, Node: Problems Linking, Next: Problems Running, Prev: Problems Compiling, Up: Installing SCM -2.9 Problems Linking | -==================== | +2.9 Problems Linking +==================== PROBLEM HOW TO FIX _sin etc. missing. Uncomment LIBS in makefile. @@ -1153,8 +1156,8 @@ _sin etc. missing. Uncomment LIBS in makefile. File: scm.info, Node: Problems Running, Next: Testing, Prev: Problems Linking, Up: Installing SCM -2.10 Problems Running | -===================== | +2.10 Problems Running +===================== PROBLEM HOW TO FIX Opening message and then machine Change memory model option to C @@ -1173,17 +1176,17 @@ remove <FLAG> in scmfig.h and Do so and recompile files. recompile scm. add <FLAG> in scmfig.h and recompile scm. -ERROR: Init5e1.scm not found. Assign correct IMPLINIT in makefile | +ERROR: Init5e2.scm not found. Assign correct IMPLINIT in makefile | or scmfig.h. Define environment variable SCM_INIT_PATH to be the full - pathname of Init5e1.scm. | + pathname of Init5e2.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 - Init5e1.scm to point to library or | + Init5e2.scm to point to library or | remove. Make sure the value of (library-vicinity) has a trailing @@ -1192,8 +1195,8 @@ WARNING: require.scm not found. Define environment variable File: scm.info, Node: Testing, Next: Reporting Problems, Prev: Problems Running, Up: Installing SCM -2.11 Testing | -============ | +2.11 Testing +============ Loading `r4rstest.scm' in the distribution will run an [R4RS] conformance test on `scm'. @@ -1243,7 +1246,7 @@ Some symbol names print incorrectly. Change memory model option to C than HEAP_SEG_SIZE). ERROR: Rogue pointer in Heap. See above under machine crashes. Newlines don't appear correctly in Check file mode (define OPEN_... in -output files. `Init5e1.scm'). | +output files. `Init5e2.scm'). | Spaces or control characters appear Check character defines in in symbol names. `scmfig.h'. Negative numbers turn positive. Check SRS in `scmfig.h'. @@ -1258,14 +1261,14 @@ Sparc(SUN-4) heap is growing out of control This causes lots of stuff which should be collected to not be. This will be a problem with any _conservative_ GC until we find what instruction will clear the register windows. This problem is - exacerbated by using lots of call-with-current-continuations. A | - possible fix for dynthrow() is commented out in `continue.c'. | + exacerbated by using lots of call-with-current-continuations. A + possible fix for dynthrow() is commented out in `continue.c'. File: scm.info, Node: Reporting Problems, Prev: Testing, Up: Installing SCM -2.12 Reporting Problems | -======================= | +2.12 Reporting Problems +======================= Reported problems and solutions are grouped under Compiling, Linking, Running, and Testing. If you don't find your problem listed there, you @@ -1290,8 +1293,8 @@ include: File: scm.info, Node: Operational Features, Next: The Language, Prev: Installing SCM, Up: Top -3 Operational Features | -********************** | +3 Operational Features +********************** * Menu: @@ -1302,7 +1305,7 @@ File: scm.info, Node: Operational Features, Next: The Language, Prev: Install * SCM Session:: * Editing Scheme Code:: * Debugging Scheme Code:: -* Debugging Continuations:: | +* Debugging Continuations:: * Errors:: * Memoized Expressions:: * Internal State:: @@ -1311,8 +1314,8 @@ File: scm.info, Node: Operational Features, Next: The Language, Prev: Install File: scm.info, Node: Invoking SCM, Next: SCM Options, Prev: Operational Features, Up: Operational Features -3.1 Invoking SCM | -================ | +3.1 Invoking SCM +================ scm [-a kbytes] [-muvbiq] [-version] [-help] [[-]-no-init-file] [-p int] [-r feature] [-h feature] @@ -1326,7 +1329,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 `Init5e1.scm') in platform-dependent directories relative | +file (usually `Init5e2.scm') in platform-dependent directories relative | to this directory. See *Note File-System Habitat:: for a blow-by-blow description. @@ -1335,12 +1338,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, `Init5e1.scm' checks to see if there is file | +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. -`Init5e1.scm' then looks for command input from one of three sources: | +`Init5e2.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. @@ -1352,55 +1355,55 @@ Lexical Conventions. File: scm.info, Node: SCM Options, Next: Invocation Examples, Prev: Invoking SCM, Up: Operational Features -3.2 Options | -=========== | +3.2 Options +=========== The options are processed in the order specified on the command line. - -- Command Option: -a k | + -- Command Option: -a k specifies that `scm' should allocate an initial heapsize of K kilobytes. This option, if present, must be the first on the command line. If not specified, the default is `INIT_HEAP_SIZE' in source file `setjump.h' which the distribution sets at `25000*sizeof(cell)'. - -- Command Option: -no-init-file | - -- Command Option: --no-init-file | + -- Command Option: -no-init-file + -- Command Option: --no-init-file Inhibits the loading of `ScmInit.scm' as described above. - -- Command Option: --help | + -- Command Option: --help prints usage information and URI; then exit. - -- Command Option: --version | + -- Command Option: --version prints version information and exit. - -- Command Option: -r feature | + -- Command Option: -r feature requires FEATURE. This will load a file from [SLIB] if that - FEATURE is not already provided. If FEATURE is 2, 2rs, or r2rs; | - 3, 3rs, or r3rs; 4, 4rs, or r4rs; 5, 5rs, or r5rs; `scm' will | - require the features neccessary to support [R2RS]; [R3RS]; [R4RS]; | - or [R5RS], respectively. | + FEATURE is not already provided. If FEATURE is 2, 2rs, or r2rs; + 3, 3rs, or r3rs; 4, 4rs, or r4rs; 5, 5rs, or r5rs; `scm' will + require the features neccessary to support [R2RS]; [R3RS]; [R4RS]; + or [R5RS], respectively. - -- Command Option: -h feature | + -- Command Option: -h feature provides FEATURE. - -- Command Option: -l filename | - -- Command Option: -f filename | + -- Command Option: -l filename + -- Command Option: -f filename loads FILENAME. `Scm' will load the first (unoptioned) file named on the command line if no `-c', `-e', `-f', `-l', or `-s' option preceeds it. - -- Command Option: -d filename | + -- Command Option: -d filename Loads SLIB `databases' feature and opens FILENAME as a database. - -- Command Option: -e expression | - -- Command Option: -c expression | + -- Command Option: -e expression + -- Command Option: -c expression specifies that the scheme expression EXPRESSION is to be evaluated. These options are inspired by `perl' and `sh' respectively. On Amiga systems the entire option and argument need to be enclosed in quotes. For instance `"-e(newline)"'. - -- Command Option: -o dumpname | + -- Command Option: -o dumpname saves the current SCM session as the executable program `dumpname'. This option works only in SCM builds supporting `dump' (*note Dump::). @@ -1410,33 +1413,33 @@ The options are processed in the order specified on the command line. it is invoked. Otherwise the (new) command line is processed as usual when the saved image is invoked. - -- Command Option: -p level | + -- Command Option: -p level sets the prolixity (verboseness) to LEVEL. This is the same as the `scm' command (verobse LEVEL). - -- Command Option: -v | + -- Command Option: -v (verbose mode) specifies that `scm' will print prompts, evaluation times, notice of loading files, and garbage collection statistics. This is the same as `-p3'. - -- Command Option: -q | + -- Command Option: -q (quiet mode) specifies that `scm' will print no extra information. This is the same as `-p0'. - -- Command Option: -m | + -- Command Option: -m specifies that subsequent loads, evaluations, and user interactions will be with syntax-rules macro capability. To use a specific syntax-rules macro implementation from [SLIB] (instead of [SLIB]'s default) put `-r' MACROPACKAGE before `-m' on the command line. - -- Command Option: -u | + -- Command Option: -u specifies that subsequent loads, evaluations, and user interactions will be without syntax-rules macro capability. Syntax-rules macro capability can be restored by a subsequent `-m' on the command line or from Scheme code. - -- Command Option: -i | + -- Command Option: -i specifies that `scm' should run interactively. That means that `scm' will not terminate until the `(quit)' or `(exit)' command is given, even if there are errors. It also sets the prolixity level @@ -1446,26 +1449,26 @@ The options are processed in the order specified on the command line. will assume that it should be interactive unless given a subsequent `-b' option. - -- Command Option: -b | + -- Command Option: -b specifies that `scm' should run non-interactively. That means that `scm' will terminate after processing the command line or if there are errors. - -- Command Option: -s | + -- Command Option: -s specifies, by analogy with `sh', that `scm' should run interactively and that further options are to be treated as program aguments. - -- Command Option: - | - -- Command Option: -- | + -- Command Option: - + -- Command Option: -- specifies that further options are to be treated as program aguments. File: scm.info, Node: Invocation Examples, Next: SCM Variables, Prev: SCM Options, Up: Operational Features -3.3 Invocation Examples | -======================= | +3.3 Invocation Examples +======================= `% scm foo.scm' Loads and executes the contents of `foo.scm' and then enters @@ -1496,39 +1499,39 @@ File: scm.info, Node: Invocation Examples, Next: SCM Variables, Prev: SCM Opt File: scm.info, Node: SCM Variables, Next: SCM Session, Prev: Invocation Examples, Up: Operational Features -3.4 Environment Variables | -========================= | +3.4 Environment Variables +========================= - -- Environment Variable: SCM_INIT_PATH | + -- Environment Variable: SCM_INIT_PATH is the pathname where `scm' will look for its initialization code. - The default is the file `Init5e1.scm' in the source directory. | + The default is the file `Init5e2.scm' in the source directory. | - -- Environment Variable: SCHEME_LIBRARY_PATH | + -- Environment Variable: SCHEME_LIBRARY_PATH is the [SLIB] Scheme library directory. - -- Environment Variable: HOME | - is the directory where `Init5e1.scm' will look for the user | + -- Environment Variable: HOME + is the directory where `Init5e2.scm' will look for the user | initialization file `ScmInit.scm'. - -- Environment Variable: EDITOR | + -- Environment Variable: EDITOR is the name of the program which `ed' will call. If EDITOR is not defined, the default is `ed'. -3.5 Scheme Variables | -==================== | +3.5 Scheme Variables +==================== - -- Variable: *argv* | + -- Variable: *argv* contains the list of arguments to the program. `*argv*' can change during argument processing. This list is suitable for use as an argument to [SLIB] `getopt'. - -- Variable: *syntax-rules* | + -- Variable: *syntax-rules* controls whether loading and interaction support syntax-rules macros. Define this in `ScmInit.scm' or files specified on the command line. This can be overridden by subsequent `-m' and `-u' options. - -- Variable: *interactive* | + -- Variable: *interactive* controls interactivity as explained for the `-i' and `-b' options. Define this in `ScmInit.scm' or files specified on the command line. This can be overridden by subsequent `-i' and `-b' options. @@ -1536,8 +1539,8 @@ File: scm.info, Node: SCM Variables, Next: SCM Session, Prev: Invocation Exam File: scm.info, Node: SCM Session, Next: Editing Scheme Code, Prev: SCM Variables, Up: Operational Features -3.6 SCM Session | -=============== | +3.6 SCM Session +=============== * Options, file loading and features can be specified from the command line. *Note System interface: (scm)System interface. @@ -1549,23 +1552,23 @@ File: scm.info, Node: SCM Session, Next: Editing Scheme Code, Prev: SCM Varia * Typing the interrupt character aborts evaluation of the current form and resumes the top level read-eval-print loop. - -- Function: quit | - -- Function: quit n | - -- Function: exit | - -- Function: exit n | + -- Function: quit + -- Function: quit n + -- Function: exit + -- Function: exit n Aliases for `exit' (*note exit: (slib)System.). On many systems, SCM can also tail-call another program. *Note execp: I/O-Extensions. - -- Callback procedure: boot-tail dumped? | + -- Callback procedure: boot-tail dumped? `boot-tail' is called by `scm_top_level' just before entering interactive top-level. If `boot-tail' calls `quit', then interactive top-level is not entered. - -- Function: program-arguments | + -- Function: program-arguments Returns a list of strings of the arguments scm was called with. - -- Function: getlogin | + -- Function: getlogin Returns the (login) name of the user logged in on the controlling terminal of the process, or #f if this information cannot be determined. @@ -1573,31 +1576,31 @@ File: scm.info, Node: SCM Session, Next: Editing Scheme Code, Prev: SCM Varia For documentation of the procedures `getenv' and `system' *Note System Interface: (slib)System Interface. - -- Function: vms-debug | + -- Function: vms-debug If SCM is compiled under VMS this `vms-debug' will invoke the VMS debugger. File: scm.info, Node: Editing Scheme Code, Next: Debugging Scheme Code, Prev: SCM Session, Up: Operational Features -3.7 Editing Scheme Code | -======================= | +3.7 Editing Scheme Code +======================= - -- Function: ed arg1 ... | + -- Function: ed arg1 ... The value of the environment variable `EDITOR' (or just `ed' if it isn't defined) is invoked as a command with arguments ARG1 .... - -- Function: ed filename | + -- Function: ed filename If SCM is compiled under VMS `ed' will invoke the editor with a single the single argument FILENAME. Gnu Emacs: Editing of Scheme code is supported by emacs. Buffers holding - files ending in .scm are automatically put into scheme-mode. | + files ending in .scm are automatically put into scheme-mode. - If your Emacs can run a process in a buffer you can use the Emacs | - command `M-x run-scheme' with SCM. Otherwise, use the emacs | - command `M-x suspend-emacs'; or see "other systems" below. | + If your Emacs can run a process in a buffer you can use the Emacs + command `M-x run-scheme' with SCM. Otherwise, use the emacs + command `M-x suspend-emacs'; or see "other systems" below. Epsilon (MS-DOS): There is lisp (and scheme) mode available by use of the package @@ -1627,9 +1630,9 @@ other systems: File: scm.info, Node: Debugging Scheme Code, Next: Debugging Continuations, Prev: Editing Scheme Code, Up: Operational Features - | -3.8 Debugging Scheme Code | -========================= | + +3.8 Debugging Scheme Code +========================= The `cautious' and `stack-limit' options of `build' (*note Build Options::) support debugging in Scheme. @@ -1665,53 +1668,53 @@ Options::) support debugging in Scheme. There are several SLIB macros which so useful that SCM automatically loads the appropriate module from SLIB if they are invoked. - -- Macro: trace proc1 ... | + -- Macro: trace proc1 ... Traces the top-level named procedures given as arguments. - -- Macro: trace | + -- Macro: trace With no arguments, makes sure that all the currently traced identifiers are traced (even if those identifiers have been redefined) and returns a list of the traced identifiers. - -- Macro: untrace proc1 ... | + -- Macro: untrace proc1 ... Turns tracing off for its arguments. - -- Macro: untrace | + -- Macro: untrace With no arguments, untraces all currently traced identifiers and returns a list of these formerly traced identifiers. The routines I use most frequently for debugging are: - -- Function: print arg1 ... | + -- Function: print arg1 ... `Print' writes all its arguments, separated by spaces. `Print' outputs a `newline' at the end and returns the value of the last argument. - One can just insert `(print '<label>' and `)' around an expression | - in order to see its values as a program operates. | - - -- Function: pprint arg1 ... | - `Pprint' pretty-prints (*note Pretty-Print: (slib)Pretty-Print.) | - all its arguments, separated by newlines. `Pprint' returns the | - value of the last argument. | - | - One can just insert `(pprint '<label>' and `)' around an | - expression in order to see its values as a program operates. | - _Note_ `pretty-print' does _not_ format procedures. | - | -When typing at top level, `pprint' is not a good way to see nested | -structure because it will return the last object pretty-printed, which | -could be large. `pp' is a better choice. | - | - -- Procedure: pp arg1 ... | - `Pprint' pretty-prints (*note Pretty-Print: (slib)Pretty-Print.) | - all its arguments, separated by newlines. `pp' returns | - `#<unspecified>'. | - | - -- Syntax: print-args name | - -- Syntax: print-args | - Writes NAME if supplied; then writes the names and values of the | - closest lexical bindings enclosing the call to `Print-args'. | + One can just insert `(print '<label>' and `)' around an expression + in order to see its values as a program operates. + + -- Function: pprint arg1 ... + `Pprint' pretty-prints (*note Pretty-Print: (slib)Pretty-Print.) + all its arguments, separated by newlines. `Pprint' returns the + value of the last argument. + + One can just insert `(pprint '<label>' and `)' around an + expression in order to see its values as a program operates. + _Note_ `pretty-print' does _not_ format procedures. + +When typing at top level, `pprint' is not a good way to see nested +structure because it will return the last object pretty-printed, which +could be large. `pp' is a better choice. + + -- Procedure: pp arg1 ... + `Pprint' pretty-prints (*note Pretty-Print: (slib)Pretty-Print.) + all its arguments, separated by newlines. `pp' returns + `#<unspecified>'. + + -- Syntax: print-args name + -- Syntax: print-args + Writes NAME if supplied; then writes the names and values of the + closest lexical bindings enclosing the call to `Print-args'. (define (foo a b) (print-args foo) (+ a b)) (foo 3 6) @@ -1727,104 +1730,104 @@ When `trace' is not sufficient to find program flow problems, SLIB-PSD, the Portable Scheme Debugger offers source code debugging from GNU Emacs. PSD runs slowly, so start by instrumenting only a few functions at a time. - http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz | - swiss.csail.mit.edu:/pub/scm/slib-psd1-3.tar.gz | + http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz + swiss.csail.mit.edu:/pub/scm/slib-psd1-3.tar.gz ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz File: scm.info, Node: Debugging Continuations, Next: Errors, Prev: Debugging Scheme Code, Up: Operational Features - | -3.9 Debugging Continuations | -=========================== | - | -These functions are defined in `debug.c', all operate on captured | -continuations: | - | - -- Procedure: frame-trace cont n | - Prints information about the code being executed and the | - environment scopes active for continuation frame N of continuation | - CONT. A "continuation frame" is an entry in the environment | - stack; a new frame is pushed when the environment is replaced or | - extended in a non-tail call context. Frame 0 is the top of the | - stack. | - | - -- Procedure: frame->environment cont n | - Prints the environment for continuation frame N of continuation | - CONT. This contains just the names, not the values, of the | - environment. | - | - -- Procedure: scope-trace env | - will print information about active lexical scopes for environment | - ENV. | - | - -- Procedure: frame-eval cont n expr | - Evaluates EXPR in the environment defined by continuation frame N | - of continuation CONT and returns the result. Values in the | - environment may be returned or SET!. | - | -*Note stack-trace: Errors. also now accepts an optional continuation | -argument. `stack-trace' differs from `frame-trace' in that it | -truncates long output using safeports and prints code from all | -available frames. | - | - (define k #f) | - (define (foo x y) | - (set! k (call-with-current-continuation identity)) | - #f) | - (let ((a 3) (b 4)) | - (foo a b) | - #f) | - (stack-trace k) | - -| | - ;STACK TRACE | - 1; ((#@set! #@k (#@call-with-current-continuation #@identity)) #f ... | - 2; (#@let ((a 3) (b 4)) (#@foo #@a #@b) #f) | - ... | - #t | - | - (frame-trace k 0) | - -| | - (#@call-with-current-continuation #@identity) | - ; in scope: | - ; (x y) procedure foo#<unspecified> | - | - (frame-trace k 1) | - -| | - ((#@set! #@k (#@call-with-current-continuation #@identity)) #f) | - ; in scope: | - ; (x y) procedure foo#<unspecified> | - | - (frame-trace k 2) | - -| | - (#@let ((a 3) (b 4)) (#@foo #@a #@b) #f) | - ; in scope: | - ; (a b . #@let)#<unspecified> | - | - (frame-trace k 3) | - -| | - (#@let ((a 3) (b 4)) (#@foo #@a #@b) #f) | - ; in top level environment. | - | - (frame->environment k 0) | - -| | - ((x y) 2 foo) | - | - (scope-trace (frame->environment k 0)) | - -| | - ; in scope: | - ; (x y) procedure foo#<unspecified> | - | - (frame-eval k 0 'x) => 3 | - | - (frame-eval k 0 '(set! x 8)) | - (frame-eval k 0 'x) => 8 | - | + +3.9 Debugging Continuations +=========================== + +These functions are defined in `debug.c', all operate on captured +continuations: + + -- Procedure: frame-trace cont n + Prints information about the code being executed and the + environment scopes active for continuation frame N of continuation + CONT. A "continuation frame" is an entry in the environment + stack; a new frame is pushed when the environment is replaced or + extended in a non-tail call context. Frame 0 is the top of the + stack. + + -- Procedure: frame->environment cont n + Prints the environment for continuation frame N of continuation + CONT. This contains just the names, not the values, of the + environment. + + -- Procedure: scope-trace env + will print information about active lexical scopes for environment + ENV. + + -- Procedure: frame-eval cont n expr + Evaluates EXPR in the environment defined by continuation frame N + of continuation CONT and returns the result. Values in the + environment may be returned or SET!. + +*Note stack-trace: Errors. also now accepts an optional continuation +argument. `stack-trace' differs from `frame-trace' in that it +truncates long output using safeports and prints code from all +available frames. + + (define k #f) + (define (foo x y) + (set! k (call-with-current-continuation identity)) + #f) + (let ((a 3) (b 4)) + (foo a b) + #f) + (stack-trace k) + -| + ;STACK TRACE + 1; ((#@set! #@k (#@call-with-current-continuation #@identity)) #f ... + 2; (#@let ((a 3) (b 4)) (#@foo #@a #@b) #f) + ... + #t + + (frame-trace k 0) + -| + (#@call-with-current-continuation #@identity) + ; in scope: + ; (x y) procedure foo#<unspecified> + + (frame-trace k 1) + -| + ((#@set! #@k (#@call-with-current-continuation #@identity)) #f) + ; in scope: + ; (x y) procedure foo#<unspecified> + + (frame-trace k 2) + -| + (#@let ((a 3) (b 4)) (#@foo #@a #@b) #f) + ; in scope: + ; (a b . #@let)#<unspecified> + + (frame-trace k 3) + -| + (#@let ((a 3) (b 4)) (#@foo #@a #@b) #f) + ; in top level environment. + + (frame->environment k 0) + -| + ((x y) 2 foo) + + (scope-trace (frame->environment k 0)) + -| + ; in scope: + ; (x y) procedure foo#<unspecified> + + (frame-eval k 0 'x) => 3 + + (frame-eval k 0 '(set! x 8)) + (frame-eval k 0 'x) => 8 + File: scm.info, Node: Errors, Next: Memoized Expressions, Prev: Debugging Continuations, Up: Operational Features - | -3.10 Errors | -=========== | + +3.10 Errors +=========== A computer-language implementation designer faces choices of how reflexive to make the implementation in handling exceptions and errors; @@ -1901,7 +1904,7 @@ other error messages which are not treated specially. "PROF_SIGNAL" `(profile-alarm-interrupt)' - -- Variable: errobj | + -- Variable: errobj When SCM encounters a non-fatal error, it aborts evaluation of the current form, prints a message explaining the error, and resumes the top level read-eval-print loop. The value of ERROBJ is the @@ -1911,8 +1914,8 @@ other error messages which are not treated specially. `errno' and `perror' report ANSI C errors encountered during a call to a system or library function. - -- Function: errno | - -- Function: errno n | + -- Function: errno + -- Function: errno n With no argument returns the current value of the system variable `errno'. When given an argument, `errno' sets the system variable `errno' to N and returns the previous value of `errno'. `(errno @@ -1920,7 +1923,7 @@ a system or library function. `try-load' returns `#f' since this occurs when the file could not be opened. - -- Function: perror string | + -- Function: perror string Prints on standard error output the argument STRING, a colon, followed by a space, the error message corresponding to the current value of `errno' and a newline. The value returned is unspecified. @@ -1928,15 +1931,15 @@ a system or library function. `warn' and `error' provide a uniform way for Scheme code to signal warnings and errors. - -- Function: warn arg1 arg2 arg3 ... | + -- Function: warn arg1 arg2 arg3 ... Alias for *Note slib:warn: (slib)System. Outputs an error message - containing the arguments. `warn' is defined in `Init5e1.scm'. | + containing the arguments. `warn' is defined in `Init5e2.scm'. | - -- Function: error arg1 arg2 arg3 ... | + -- 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 `Init5e1.scm'. | + defined in `Init5e2.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 @@ -1951,17 +1954,17 @@ and conclude by calling `breakpoint' (*note Breakpoints: (slib)Breakpoints.). This allows the user to interract with SCM as with Lisp systems. - -- Function: stack-trace | + -- 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 `Init5e1.scm' for an example of the use | + and `#f' otherwise. See `Init5e2.scm' for an example of the use | of `stack-trace'. File: scm.info, Node: Memoized Expressions, Next: Internal State, Prev: Errors, Up: Operational Features -3.11 Memoized Expressions | -========================= | +3.11 Memoized Expressions +========================= SCM memoizes the address of each occurence of an identifier's value when first encountering it in a source expression. Subsequent executions of @@ -1979,7 +1982,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 `Init5e1.scm': | +For instance, `open-input-file' is defined as follows in `Init5e2.scm': | (define (open-input-file str) (or (open-file str OPEN_READ) @@ -2019,36 +2022,36 @@ too become memoized: File: scm.info, Node: Internal State, Next: Scripting, Prev: Memoized Expressions, Up: Operational Features -3.12 Internal State | -=================== | +3.12 Internal State +=================== - -- Variable: *interactive* | + -- Variable: *interactive* The variable *INTERACTIVE* determines whether the SCM session is interactive, or should quit after the command line is processed. *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 `Init5e1.scm' for details. | + more complicated; see `Init5e2.scm' for details. | - -- Function: abort | + -- Function: abort Resumes the top level Read-Eval-Print loop. - -- Function: restart | + -- Function: restart Restarts the SCM program with the same arguments as it was originally invoked. All `-l' loaded files are loaded again; If those files have changed, those changes will be reflected in the new session. - _Note_ When running a saved executable (*note Dump::), `restart' | + _Note_ When running a saved executable (*note Dump::), `restart' is redefined to be `exec-self'. - -- Function: exec-self | + -- Function: exec-self Exits and immediately re-invokes the same executable with the same arguments. If the executable file has been changed or replaced since the beginning of the current session, the _new_ executable will be invoked. This differentiates `exec-self' from `restart'. - -- Function: verbose n | + -- Function: verbose n Controls how much monitoring information is printed. If N is: 0 @@ -2072,20 +2075,20 @@ File: scm.info, Node: Internal State, Next: Scripting, Prev: Memoized Express a message for each GC (*note Garbage Collection::) is printed; warnings issued for top-level symbols redefined. - -- Function: gc | + -- Function: gc Scans all of SCM objects and reclaims for further use those that are no longer accessible. - -- Function: room | - -- Function: room #t | + -- Function: room + -- Function: room #t Prints out statistics about SCM's current use of storage. `(room #t)' also gives the hexadecimal heap segment and stack bounds. - -- Constant: *scm-version* | - Contains the version string (e.g. `5e1') of SCM. | + -- Constant: *scm-version* + Contains the version string (e.g. `5e2') of SCM. | -3.12.1 Executable path | ----------------------- | +3.12.1 Executable path +---------------------- In order to dump a saved executable or to dynamically-link using DLD, SCM must know where its executable file is. Sometimes SCM (*note @@ -2093,13 +2096,13 @@ Executable Pathname::) guesses incorrectly the location of the currently running executable. In that case, the correct path can be set by calling `execpath' with the pathname. - -- Function: execpath | + -- Function: execpath Returns the path (string) which SCM uses to find the executable file whose invocation the currently running session is, or #f if the path is not set. - -- Function: execpath #f | - -- Function: execpath newpath | + -- Function: execpath #f + -- Function: execpath newpath Sets the path to `#f' or NEWPATH, respectively. The old path is returned. @@ -2109,8 +2112,8 @@ For other configuration constants and procedures *Note Configuration: File: scm.info, Node: Scripting, Prev: Internal State, Up: Operational Features -3.13 Scripting | -============== | +3.13 Scripting +============== * Menu: @@ -2121,14 +2124,14 @@ File: scm.info, Node: Scripting, Prev: Internal State, Up: Operational Featur File: scm.info, Node: Unix Scheme Scripts, Next: MS-DOS Compatible Scripts, Prev: Scripting, Up: Scripting -3.13.1 Unix Scheme Scripts | --------------------------- | +3.13.1 Unix Scheme Scripts +-------------------------- In reading this section, keep in mind that the first line of a script file has (different) meanings to SCM and the operating system (`execve'). - -- file: #! interpreter \ ... | + -- file: #! interpreter \ ... On unix systems, a "Shell-Script" is a file (with execute permissions) whose first two characters are `#!'. The INTERPRETER argument must be the pathname of the program to process the rest @@ -2157,7 +2160,7 @@ file has (different) meanings to SCM and the operating system `\' substitution; this will only take place if INTERPRETER is a SCM or SCSH interpreter. - -- Read syntax: #! ignored !# | + -- Read syntax: #! ignored !# When the first two characters of the file being loaded are `#!' and a `\' is present before a newline in the file, all characters up to `!#' will be ignored by SCM `read'. @@ -2169,7 +2172,7 @@ POSIX shell-scripts if the first line is: The following Scheme-Script prints factorial of its argument: - #! /usr/local/bin/scm \ %0 %* | + #! /usr/local/bin/scm \ %0 %* - !# (define (fact.script args) @@ -2207,23 +2210,23 @@ usage information. File: scm.info, Node: MS-DOS Compatible Scripts, Next: Unix Shell Scripts, Prev: Unix Scheme Scripts, Up: Scripting -3.13.2 MS-DOS Compatible Scripts | --------------------------------- | +3.13.2 MS-DOS Compatible Scripts +-------------------------------- It turns out that we can create scheme-scripts which run both under unix and MS-DOS. To implement this, I have written the MS-DOS programs: -`#!.bat' and `!#.exe', which are available from: | -`http://swiss.csail.mit.edu/ftpdir/scm/sharpbang.zip' | +`#!.bat' and `!#.exe', which are available from: +`http://swiss.csail.mit.edu/ftpdir/scm/sharpbang.zip' With these two programs installed in a `PATH' directory, we have the following syntax for <PROGRAM>.BAT files. - -- file: #! interpreter \ %0 %* | + -- file: #! interpreter \ %0 %* The first two characters of the Scheme-Script are `#!'. The INTERPRETER can be either a unix style program path (using `/' between filename components) or a DOS program name or path. The rest of the first line of the Scheme-Script should be literally - `\ %0 %*', as shown. | + `\ %0 %*', as shown. If INTERPRETER has `/' in it, INTERPRETER is converted to a DOS style filename (`/' => `\'). @@ -2235,9 +2238,9 @@ following syntax for <PROGRAM>.BAT files. `#!' tries all directories named by environment variable `PATH'. Once the INTERPRETER executable path is found, arguments are - processed in the manner of scheme-shell, with all the text after | - the `\' taken as part of the meta-argument. More precisely, `#!' | - calls INTERPRETER with any options on the second line of the | + processed in the manner of scheme-shell, with all the text after + the `\' taken as part of the meta-argument. More precisely, `#!' + calls INTERPRETER with any options on the second line of the Scheme-Script up to `!#', the name of the Scheme-Script file, and then any of at most 8 arguments given on the command line invoking this Scheme-Script. @@ -2248,8 +2251,8 @@ systems. File: scm.info, Node: Unix Shell Scripts, Prev: MS-DOS Compatible Scripts, Up: Scripting -3.13.3 Unix Shell Scripts | -------------------------- | +3.13.3 Unix Shell Scripts +------------------------- Scheme-scripts suffer from two drawbacks: * Some Unixes limit the length of the `#!' interpreter line to the @@ -2281,7 +2284,7 @@ argument, making it compatible with the scheme code of the previous example. #! /bin/sh - :;exec scm -e"(set! *script* \"$0\")" -l$0 "$@" | + :;exec scm -e"(set! *script* \"$0\")" -l$0 "$@" (define (fact.script args) (cond ((and (= 1 (length args)) @@ -2308,8 +2311,8 @@ example. File: scm.info, Node: The Language, Next: Packages, Prev: Operational Features, Up: Top -4 The Language | -************** | +4 The Language +************** * Menu: @@ -2326,8 +2329,8 @@ File: scm.info, Node: The Language, Next: Packages, Prev: Operational Feature File: scm.info, Node: Standards Compliance, Next: Storage, Prev: The Language, Up: The Language -4.1 Standards Compliance | -======================== | +4.1 Standards Compliance +======================== Scm conforms to the `IEEE Standard 1178-1990. IEEE Standard for the Scheme Programming Language.' (*note Bibliography::), and `Revised(5) @@ -2388,7 +2391,7 @@ Optionals of [R5RS] not Supported by SCM See SLIB file `Template.scm'. `current-time' - *Note Time and Date: (slib)Time and Date. | + *Note Time and Date: (slib)Time and Date. `defmacro' *Note Defmacro: (slib)Defmacro. @@ -2446,10 +2449,10 @@ Optionals of [R5RS] not Supported by SCM File: scm.info, Node: Storage, Next: Time, Prev: Standards Compliance, Up: The Language -4.2 Storage | -=========== | +4.2 Storage +=========== - -- Function: vector-set-length! object length | + -- Function: vector-set-length! object length Change the length of string, vector, bit-vector, or uniform-array OBJECT to LENGTH. If this shortens OBJECT then the remaining contents are lost. If it enlarges OBJECT then the contents of the @@ -2457,20 +2460,20 @@ File: scm.info, Node: Storage, Next: Time, Prev: Standards Compliance, Up: T It is an error to change the length of literal datums. The new object is returned. - -- Function: copy-tree obj | - -- Function: @copy-tree obj | + -- Function: copy-tree obj + -- Function: @copy-tree obj *Note copy-tree: (slib)Tree Operations. This extends the SLIB version by also copying vectors. Use `@copy-tree' if you depend on this feature; `copy-tree' could get redefined. - -- Function: acons obj1 obj2 obj3 | + -- Function: acons obj1 obj2 obj3 Returns (cons (cons obj1 obj2) obj3). (set! a-list (acons key datum a-list)) Adds a new association to a-list. - -- Callback procedure: gc-hook ... | + -- Callback procedure: gc-hook ... Allows a Scheme procedure to be run shortly after each garbage collection. This procedure will not be run recursively. If it runs long enough to cause a garbage collection before returning a @@ -2478,7 +2481,7 @@ File: scm.info, Node: Storage, Next: Time, Prev: Standards Compliance, Up: T To remove the gc-hook, `(set! gc-hook #f)'. - -- Function: add-finalizer object finalizer | + -- Function: add-finalizer object finalizer OBJECT may be any garbage collected object, that is, any object other than an immediate integer, character, or special token such as `#f' or `#t', *Note Immediates::. FINALIZER is a thunk, or @@ -2504,38 +2507,38 @@ File: scm.info, Node: Storage, Next: Time, Prev: Standards Compliance, Up: T File: scm.info, Node: Time, Next: Interrupts, Prev: Storage, Up: The Language -4.3 Time | -======== | +4.3 Time +======== - -- Constant: internal-time-units-per-second | + -- Constant: internal-time-units-per-second Is the integer number of internal time units in a second. - -- Function: get-internal-run-time | + -- Function: get-internal-run-time Returns the integer run time in internal time units from an unspecified starting time. The difference of two calls to `get-internal-run-time' divided by `internal-time-units-per-second' will give elapsed run time in seconds. - -- Function: get-internal-real-time | + -- Function: get-internal-real-time Returns the integer time in internal time units from an unspecified starting time. The difference of two calls to `get-internal-real-time' divided by `interal-time-units-per-second' will give elapsed real time in seconds. - -- Function: current-time | + -- Function: current-time Returns the time since 00:00:00 GMT, January 1, 1970, measured in - seconds. *Note current-time: (slib)Time and Date. `current-time' | - is used in *Note Time and Date: (slib)Time and Date. | + seconds. *Note current-time: (slib)Time and Date. `current-time' + is used in *Note Time and Date: (slib)Time and Date. File: scm.info, Node: Interrupts, Next: Process Synchronization, Prev: Time, Up: The Language -4.4 Interrupts | -============== | +4.4 Interrupts +============== - -- Function: ticks n | + -- Function: ticks n Returns the number of ticks remaining till the next tick interrupt. Ticks are an arbitrary unit of evaluation. Ticks can vary greatly in the amount of time they represent. @@ -2545,22 +2548,22 @@ File: scm.info, Node: Interrupts, Next: Process Synchronization, Prev: Time, `ticks' is supported if SCM is compiled with the `ticks' flag defined. - -- Callback procedure: ticks-interrupt ... | + -- Callback procedure: ticks-interrupt ... Establishes a response for tick interrupts. Another tick interrupt will not occur unless `ticks' is called again. Program execution will resume if the handler returns. This procedure should (abort) or some other action which does not return if it does not want processing to continue. - -- Function: alarm secs | + -- Function: alarm secs Returns the number of seconds remaining till the next alarm interrupt. If SECS is 0, any alarm request is canceled. Otherwise an `alarm-interrupt' will be signaled SECS from the current time. ALARM is not supported on all systems. - -- Function: milli-alarm millisecs interval | - -- Function: virtual-alarm millisecs interval | - -- Function: profile-alarm millisecs interval | + -- Function: milli-alarm millisecs interval + -- Function: virtual-alarm millisecs interval + -- Function: profile-alarm millisecs interval `milli-alarm' is similar to `alarm', except that the first argument MILLISECS, and the return value are measured in milliseconds rather than seconds. If the optional argument @@ -2577,10 +2580,10 @@ File: scm.info, Node: Interrupts, Next: Process Synchronization, Prev: Time, `milli-alarm', `virtual-alarm', and `profile-alarm' are supported only on systems providing the `setitimer' system call. - -- Callback procedure: user-interrupt ... | - -- Callback procedure: alarm-interrupt ... | - -- Callback procedure: virtual-alarm-interrupt ... | - -- Callback procedure: profile-alarm-interrupt ... | + -- Callback procedure: user-interrupt ... + -- Callback procedure: alarm-interrupt ... + -- Callback procedure: virtual-alarm-interrupt ... + -- Callback procedure: profile-alarm-interrupt ... Establishes a response for `SIGINT' (control-C interrupt) and `SIGALRM', `SIGVTALRM', and `SIGPROF' interrupts. Program execution will resume if the handler returns. This procedure @@ -2593,11 +2596,11 @@ File: scm.info, Node: Interrupts, Next: Process Synchronization, Prev: Time, To unestablish a response for an interrupt set the handler symbol to `#f'. For instance, `(set! user-interrupt #f)'. - -- Callback procedure: out-of-storage ... | - -- Callback procedure: could-not-open ... | - -- Callback procedure: end-of-program ... | - -- Callback procedure: hang-up ... | - -- Callback procedure: arithmetic-error ... | + -- Callback procedure: out-of-storage ... + -- Callback procedure: could-not-open ... + -- Callback procedure: end-of-program ... + -- Callback procedure: hang-up ... + -- Callback procedure: arithmetic-error ... Establishes a response for storage allocation error, file opening error, end of program, SIGHUP (hang up interrupt) and arithmetic errors respectively. This procedure should (abort) or some other @@ -2611,15 +2614,15 @@ File: scm.info, Node: Interrupts, Next: Process Synchronization, Prev: Time, File: scm.info, Node: Process Synchronization, Next: Files and Ports, Prev: Interrupts, Up: The Language -4.5 Process Synchronization | -=========================== | +4.5 Process Synchronization +=========================== -An "exchanger" is a procedure of one argument regulating mutually exclusive | -access to a resource. When a exchanger is called, its current content | -is returned, while being replaced by its argument in an atomic | +An "exchanger" is a procedure of one argument regulating mutually exclusive +access to a resource. When a exchanger is called, its current content +is returned, while being replaced by its argument in an atomic operation. - -- Function: make-exchanger obj | + -- Function: make-exchanger obj Returns a new exchanger with the argument OBJ as its initial content. @@ -2642,23 +2645,23 @@ operation. (pop queue) => #f - -- Function: make-arbiter name | + -- Function: make-arbiter name Returns an object of type arbiter and name NAME. Its state is initially unlocked. - -- Function: try-arbiter arbiter | + -- Function: try-arbiter arbiter Returns `#t' and locks ARBITER if ARBITER was unlocked. Otherwise, returns `#f'. - -- Function: release-arbiter arbiter | + -- Function: release-arbiter arbiter Returns `#t' and unlocks ARBITER if ARBITER was locked. Otherwise, returns `#f'. File: scm.info, Node: Files and Ports, Next: Eval and Load, Prev: Process Synchronization, Up: The Language -4.6 Files and Ports | -=================== | +4.6 Files and Ports +=================== These procedures generalize and extend the standard capabilities in *Note Ports: (r5rs)Ports. @@ -2673,11 +2676,11 @@ These procedures generalize and extend the standard capabilities in File: scm.info, Node: Opening and Closing, Next: Port Properties, Prev: Files and Ports, Up: Files and Ports -4.6.1 Opening and Closing | -------------------------- | +4.6.1 Opening and Closing +------------------------- - -- Function: open-file string modes | - -- Function: try-open-file string modes | + -- Function: open-file string modes + -- Function: try-open-file string modes Returns a port capable of receiving or delivering characters as specified by the MODES string. If a file cannot be opened `#f' is returned. @@ -2687,9 +2690,9 @@ File: scm.info, Node: Opening and Closing, Next: Port Properties, Prev: Files `try-open-file' is the primitive procedure; Do not redefine `try-open-file'! - -- Constant: open_read | - -- Constant: open_write | - -- Constant: open_both | + -- Constant: open_read + -- Constant: open_write + -- Constant: open_both Contain modes strings specifying that a file is to be opened for reading, writing, and both reading and writing respectively. @@ -2697,92 +2700,92 @@ File: scm.info, Node: Opening and Closing, Next: Port Properties, Prev: Files of file must be read or a file-set-position done on the port between a read operation and a write operation or vice-versa. - -- Function: _ionbf modestr | + -- Function: _ionbf modestr Returns a version of MODESTR which when `open-file' is called with it as the second argument will return an unbuffered port. An input-port must be unbuffered in order for `char-ready?' and `wait-for-input' to work correctly on it. The initial value of `(current-input-port)' is unbuffered if the platform supports it. - -- Function: _tracked modestr | + -- Function: _tracked modestr Returns a version of MODESTR which when `open-file' is called with it as the second argument will return a tracked port. A tracked port maintains current line and column numbers, which may be queried with `port-line' and `port-column'. - -- Function: _exclusive modestr | + -- Function: _exclusive modestr Returns a version of MODESTR which when `open-file' is called with it as the second argument will return a port only if the named file does not already exist. This functionality is provided by calling `try-create-file' *Note I/O-Extensions::, which is not available for all platforms. - -- Function: open-ports | + -- Function: open-ports Returns a list of all currently open ports, excluding string ports, see *Note String Ports: (slib)String Ports. This may be useful after a fork *Note Posix Extensions::, or for debugging. Bear in mind that ports that would be closed by gc will be kept open by a reference to this list. - -- Function: close-port port | + -- Function: close-port port Closes PORT. The same as close-input-port and close-output-port. File: scm.info, Node: Port Properties, Next: Port Redirection, Prev: Opening and Closing, Up: Files and Ports -4.6.2 Port Properties | ---------------------- | +4.6.2 Port Properties +--------------------- - -- Function: port-closed? port | + -- Function: port-closed? port Returns #t if PORT is closed. - -- Function: port-type obj | + -- Function: port-type obj If OBJ is not a port returns false, otherwise returns a symbol describing the port type, for example string or pipe. - -- Function: port-filename port | + -- Function: port-filename port Returns the filename PORT was opened with. If PORT is not open to a file the result is unspecified. - -- Function: port-line port | - -- Function: port-column port | + -- Function: port-line port + -- Function: port-column port If PORT is a tracked port, return the current line (column) number, otherwise return `#f'. Line and column numbers begin with 1. The column number applies to the next character to be read; if that character is a newline, then the column number will be one more than the length of the line. - -- Function: freshline port | + -- Function: freshline port Outputs a newline to optional argument PORT unless the current output column number of PORT is known to be zero, ie output will start at the beginning of a new line. PORT defaults to `current-output-port'. If PORT is not a tracked port `freshline' is equivalent to `newline'. - -- Function: isatty? port | + -- Function: isatty? port Returns `#t' if PORT is input or output to a serial non-file device. - -- procedure: char-ready? | - -- procedure: char-ready? port | + -- procedure: char-ready? + -- procedure: char-ready? port Returns `#t' if a character is ready on the input PORT and returns `#f' otherwise. If `char-ready?' returns `#t' then the next `read-char' operation on the given PORT is guaranteed not to hang. - If the PORT is at end of file then `char-ready?' returns `#t'. PORT | - may be omitted, in which case it defaults to the value returned by | - `current-input-port'. | - - _Rationale_ `Char-ready?' exists to make it possible for a program | - to accept characters from interactive ports without getting stuck | - waiting for input. Any input editors associated with such ports | - must ensure that characters whose existence has been asserted by | - `char-ready?' cannot be rubbed out. If `char-ready?' were to | - return `#f' at end of file, a port at end of file would be | - indistinguishable from an interactive port that has no ready | - characters. | - - -- procedure: wait-for-input x | - -- procedure: wait-for-input x port1 ... | + If the PORT is at end of file then `char-ready?' returns `#t'. PORT + may be omitted, in which case it defaults to the value returned by + `current-input-port'. + + _Rationale_ `Char-ready?' exists to make it possible for a program + to accept characters from interactive ports without getting stuck + waiting for input. Any input editors associated with such ports + must ensure that characters whose existence has been asserted by + `char-ready?' cannot be rubbed out. If `char-ready?' were to + return `#f' at end of file, a port at end of file would be + indistinguishable from an interactive port that has no ready + characters. + + -- procedure: wait-for-input x + -- procedure: wait-for-input x port1 ... Returns a list those ports PORT1 ... which are `char-ready?'. If none of PORT1 ... become `char-ready?' within the time interval of X seconds, then #f is returned. The PORT1 ... arguments may be @@ -2792,13 +2795,13 @@ File: scm.info, Node: Port Properties, Next: Port Redirection, Prev: Opening File: scm.info, Node: Port Redirection, Next: Soft Ports, Prev: Port Properties, Up: Files and Ports -4.6.3 Port Redirection | ----------------------- | +4.6.3 Port Redirection +---------------------- - -- Function: current-error-port | + -- Function: current-error-port Returns the current port to which diagnostic output is directed. - -- Function: with-error-to-file string thunk | + -- Function: with-error-to-file string thunk THUNK must be a procedure of no arguments, and string must be a string naming a file. The file is opened for output, an output port connected to it is made the default value returned by @@ -2807,14 +2810,14 @@ File: scm.info, Node: Port Redirection, Next: Soft Ports, Prev: Port Properti default is restored. With-error-to-file returns the value yielded by THUNK. - -- Function: with-input-from-port port thunk | - -- Function: with-output-to-port port thunk | - -- Function: with-error-to-port port thunk | + -- Function: with-input-from-port port thunk + -- Function: with-output-to-port port thunk + -- Function: with-error-to-port port thunk These routines differ from with-input-from-file, with-output-to-file, and with-error-to-file in that the first argument is a port, rather than a string naming a file. - -- Function: call-with-outputs thunk proc | + -- Function: call-with-outputs thunk proc Calls the THUNK procedure while the current-output-port and current-error-port are directed to string-ports. If THUNK returns, the PROC procedure is called with the output-string, the @@ -2825,16 +2828,16 @@ File: scm.info, Node: Port Redirection, Next: Soft Ports, Prev: Port Properti File: scm.info, Node: Soft Ports, Prev: Port Redirection, Up: Files and Ports -4.6.4 Soft Ports | ----------------- | +4.6.4 Soft Ports +---------------- A "soft-port" is a port based on a vector of procedures capable of accepting or delivering characters. It allows emulation of I/O ports. - -- Function: make-soft-port vector modes | + -- Function: make-soft-port vector modes Returns a port capable of receiving or delivering characters as specified by the MODES string (*note open-file: Files and Ports.). - VECTOR must be a vector of length 5. Its components are as | + VECTOR must be a vector of length 5. Its components are as follows: 0. procedure accepting one character for output @@ -2874,10 +2877,10 @@ accepting or delivering characters. It allows emulation of I/O ports. File: scm.info, Node: Eval and Load, Next: Lexical Conventions, Prev: Files and Ports, Up: The Language -4.7 Eval and Load | -================= | +4.7 Eval and Load +================= - -- Function: try-load filename | + -- Function: try-load filename If the string FILENAME names an existing file, the try-load procedure reads Scheme source code expressions and definitions from the file and evaluates them sequentially and returns `#t'. @@ -2885,26 +2888,26 @@ File: scm.info, Node: Eval and Load, Next: Lexical Conventions, Prev: Files a affect the values returned by `current-input-port' and `current-output-port'. - -- Variable: *load-pathname* | + -- Variable: *load-pathname* Is set to the pathname given as argument to `load', `try-load', and `dyn:link' (*note Compiling And Linking: (hobbit)Compiling And Linking.). `*load-pathname*' is used to compute the value of *Note program-vicinity: (slib)Vicinity. - -- Function: eval obj | + -- Function: eval obj Alias for *Note eval: (slib)System. - -- Function: eval-string str | + -- Function: eval-string str Returns the result of reading an expression from STR and evaluating it. `eval-string' does not change `*load-pathname*' or `line-number'. - -- Function: load-string str | + -- Function: load-string str Reads and evaluates all the expressions from STR. As with `load', the value returned is unspecified. `load-string' does not change `*load-pathname*' or `line-number'. - -- Function: line-number | + -- Function: line-number Returns the current line number of the file currently being loaded. * Menu: @@ -2914,15 +2917,15 @@ File: scm.info, Node: Eval and Load, Next: Lexical Conventions, Prev: Files a File: scm.info, Node: Line Numbers, Prev: Eval and Load, Up: Eval and Load -4.7.1 Line Numbers | ------------------- | +4.7.1 Line Numbers +------------------ Scheme code defined by load may optionally contain line number information. Currently this information is used only for reporting expansion time errors, but in the future run-time error messages may also include line number information. - -- Function: try-load pathname reader | + -- Function: try-load pathname reader This is the primitive for loading, PATHNAME is the name of a file containing Scheme code, and optional argument READER is a function of one argument, a port. READER should read and return Scheme @@ -2936,32 +2939,32 @@ pair consisting of a line-number in the car and a vector in the cdr is equivalent to the vector. The meaning of s-expressions with line-numbers in other positions is undefined. - -- Function: read-numbered port | - Behaves like `read', except that | - - bullet Load (read) sytnaxes are enabled. | - | - bullet every s-expression read will be replaced with a cons of | - a line-number object and the sexp actually read. This | - replacement is done only if PORT is a tracked port See *Note | - Files and Ports::. | - | - | - -- Function: integer->line-number int | + -- Function: read-numbered port + Behaves like `read', except that + + bullet Load (read) sytnaxes are enabled. + + bullet every s-expression read will be replaced with a cons of + a line-number object and the sexp actually read. This + replacement is done only if PORT is a tracked port See *Note + Files and Ports::. + + + -- Function: integer->line-number int Returns a line-number object with value INT. INT should be an exact non-negative integer. - -- Function: line-number->integer linum | + -- Function: line-number->integer linum Returns the value of line-number object LINUM as an integer. - -- Function: line-number? obj | + -- Function: line-number? obj Returns true if and only if OBJ is a line-number object. - -- Function: read-for-load port | - Behaves like `read', except that load syntaxes are enabled. | - | - -- Variable: *load-reader* | - -- Variable: *slib-load-reader* | + -- Function: read-for-load port + Behaves like `read', except that load syntaxes are enabled. + + -- Variable: *load-reader* + -- Variable: *slib-load-reader* The value of `*load-reader*' should be a value acceptable as the second argument to `try-load' (note that #f is acceptable). This value will be used to read code during calls to `scm:load'. The @@ -2974,32 +2977,32 @@ line-numbers in other positions is undefined. File: scm.info, Node: Lexical Conventions, Next: Syntax, Prev: Eval and Load, Up: The Language -4.8 Lexical Conventions | -======================= | +4.8 Lexical Conventions +======================= * Menu: * Common-Lisp Read Syntax:: -* Load Syntax:: | +* Load Syntax:: * Documentation and Comments:: * Modifying Read Syntax:: File: scm.info, Node: Common-Lisp Read Syntax, Next: Load Syntax, Prev: Lexical Conventions, Up: Lexical Conventions - | -4.8.1 Common-Lisp Read Syntax | ------------------------------ | - -- Read syntax: #\token | - If TOKEN is a sequence of two or more digits, then this syntax is | - equivalent to `#.(integer->char (string->number token 8))'. | +4.8.1 Common-Lisp Read Syntax +----------------------------- - If TOKEN is `C-', `c-', or `^' followed by a character, then this | - syntax is read as a control character. If TOKEN is `M-' or `m-' | - followed by a character, then a meta character is read. `c-' and | - `m-' prefixes may be combined. | + -- Read syntax: #\token + If TOKEN is a sequence of two or more digits, then this syntax is + equivalent to `#.(integer->char (string->number token 8))'. - -- Read syntax: #+ feature form | + If TOKEN is `C-', `c-', or `^' followed by a character, then this + syntax is read as a control character. If TOKEN is `M-' or `m-' + followed by a character, then a meta character is read. `c-' and + `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. @@ -3009,59 +3012,59 @@ File: scm.info, Node: Common-Lisp Read Syntax, Next: Load Syntax, Prev: Lexic For more information on `provided?' and `*features*', *Note Require: (slib)Require. - -- Read syntax: #- feature form | + -- Read syntax: #- feature form is equivalent to `#+(not feature) expression'. - -- Read syntax: #| any thing |# | + -- Read syntax: #| any thing |# Is a balanced comment. Everything up to the matching `|#' is ignored by the `read'. Nested `#|...|#' can occur inside ANY THING. -"Load sytax" is Read syntax enabled for `read' only when that `read' is | -part of loading a file or string. This distinction was made so that | -reading from a datafile would not be able to corrupt a scheme program | -using `#.'. | +"Load sytax" is Read syntax enabled for `read' only when that `read' is +part of loading a file or string. This distinction was made so that +reading from a datafile would not be able to corrupt a scheme program +using `#.'. + + -- Load syntax: #. expression + Is read as the object resulting from the evaluation of EXPRESSION. + This substitution occurs even inside quoted structure. + + In order to allow compiled code to work with `#.' it is good + practice to define those symbols used inside of EXPRESSION with + `#.(define ...)'. For example: - -- Load syntax: #. expression | - Is read as the object resulting from the evaluation of EXPRESSION. | - This substitution occurs even inside quoted structure. | + #.(define foo 9) => #<unspecified> + '(#.foo #.(+ foo foo)) => (9 18) - In order to allow compiled code to work with `#.' it is good | - practice to define those symbols used inside of EXPRESSION with | - `#.(define ...)'. For example: | - | - #.(define foo 9) => #<unspecified> | - '(#.foo #.(+ foo foo)) => (9 18) | - | - -- Load syntax: #' form | - is equivalent to FORM (for compatibility with common-lisp). | + -- Load syntax: #' form + is equivalent to FORM (for compatibility with common-lisp). File: scm.info, Node: Load Syntax, Next: Documentation and Comments, Prev: Common-Lisp Read Syntax, Up: Lexical Conventions - | -4.8.2 Load Syntax | ------------------ | + +4.8.2 Load Syntax +----------------- "#!" is the unix mechanism for executing scripts. See *Note Unix -Scheme Scripts:: for the full description of how this comment supports | -scripting. | - | - -- Load syntax: #?line | - -- Load syntax: #?column | - Return integers for the current line and column being read during a | - load. | - | - -- Load syntax: #?file | - Returns the string naming the file currently being loaded. This | - path is the string passed to `load', possibly with `.scm' appended. | - | +Scheme Scripts:: for the full description of how this comment supports +scripting. + + -- Load syntax: #?line + -- Load syntax: #?column + Return integers for the current line and column being read during a + load. + + -- Load syntax: #?file + Returns the string naming the file currently being loaded. This + path is the string passed to `load', possibly with `.scm' appended. + File: scm.info, Node: Documentation and Comments, Next: Modifying Read Syntax, Prev: Load Syntax, Up: Lexical Conventions - | -4.8.3 Documentation and Comments | --------------------------------- | - | - -- procedure: procedure-documentation proc | + +4.8.3 Documentation and Comments +-------------------------------- + + -- procedure: procedure-documentation proc Returns the documentation string of PROC if it exists, or `#f' if not. @@ -3077,24 +3080,24 @@ File: scm.info, Node: Documentation and Comments, Next: Modifying Read Syntax, => #<unspecified> (procedure-documentation square) => "Return the square of X." - -- Function: comment string1 ... | + -- Function: comment string1 ... Appends STRING1 ... to the strings given as arguments to previous calls `comment'. - -- Function: comment | + -- Function: comment Returns the (appended) strings given as arguments to previous calls `comment' and empties the current string collection. - -- Load syntax: #;text-till-end-of-line | + -- Load syntax: #;text-till-end-of-line Behaves as `(comment "TEXT-TILL-END-OF-LINE")'. File: scm.info, Node: Modifying Read Syntax, Prev: Documentation and Comments, Up: Lexical Conventions -4.8.4 Modifying Read Syntax | ---------------------------- | +4.8.4 Modifying Read Syntax +--------------------------- - -- Callback procedure: read:sharp c port | + -- Callback procedure: read:sharp c port If a <#> followed by a character (for a non-standard syntax) is encountered by `read', `read' will call the value of the symbol `read:sharp' with arguments the character and the port being read @@ -3104,31 +3107,31 @@ File: scm.info, Node: Modifying Read Syntax, Prev: Documentation and Comments, whitespace. `#<unspecified>' is the value returned by the expression `(if #f #f)'. - -- Callback procedure: load:sharp c port | - Dispatches like `read:sharp', but only during `load's. The | - read-syntaxes handled by `load:sharp' are a superset of those | - handled by `read:sharp'. `load:sharp' calls `read:sharp' if none | - of its syntaxes match C. | - | - -- Callback procedure: char:sharp token | + -- Callback procedure: load:sharp c port + Dispatches like `read:sharp', but only during `load's. The + read-syntaxes handled by `load:sharp' are a superset of those + handled by `read:sharp'. `load:sharp' calls `read:sharp' if none + of its syntaxes match C. + + -- Callback procedure: char:sharp token If the sequence <#\> followed by a non-standard character name is encountered by `read', `read' will call the value of the symbol - `char:sharp' with the token (a string of length at least two) as | - argument. If the value returned is a character, then that will be | - the value of `read' for this expression, otherwise an error will | - be signaled. | + `char:sharp' with the token (a string of length at least two) as + argument. If the value returned is a character, then that will be + the value of `read' for this expression, otherwise an error will + be signaled. -_Note_ When adding new <#> syntaxes, have your code save the previous | -value of `load:sharp', `read:sharp', or `char:sharp' when defining it. | -Call this saved value if an invocation's syntax is not recognized. | -This will allow `#+', `#-', and *Note Uniform Array::s to still be | -supported (as they dispatch from `read:sharp'). | +_Note_ When adding new <#> syntaxes, have your code save the previous +value of `load:sharp', `read:sharp', or `char:sharp' when defining it. +Call this saved value if an invocation's syntax is not recognized. +This will allow `#+', `#-', and *Note Uniform Array::s to still be +supported (as they dispatch from `read:sharp'). File: scm.info, Node: Syntax, Prev: Lexical Conventions, Up: The Language -4.9 Syntax | -========== | +4.9 Syntax +========== SCM provides a native implementation of "defmacro". *Note Defmacro: (slib)Defmacro. @@ -3160,25 +3163,25 @@ use the correct macro loader when `require'd. File: scm.info, Node: Define and Set, Next: Defmacro, Prev: Syntax, Up: Syntax -4.9.1 Define and Set | --------------------- | +4.9.1 Define and Set +-------------------- - -- Special Form: defined? symbol | + -- Special Form: defined? symbol Equivalent to `#t' if SYMBOL is a syntactic keyword (such as `if') or a symbol with a value in the top level environment (*note Variables and regions: (r5rs)Variables and regions.). Otherwise equivalent to `#f'. - -- Special Form: defvar identifier initial-value | + -- Special Form: defvar identifier initial-value If IDENTIFIER is unbound in the top level environment, then IDENTIFIER is `define'd to the result of evaluating the form INITIAL-VALUE as if the `defvar' form were instead the form `(define identifier initial-value)' . If IDENTIFIER already has a value, then INITIAL-VALUE is _not_ evaluated and IDENTIFIER's - value is not changed. `defvar' is valid only when used at | + value is not changed. `defvar' is valid only when used at top-level. - -- Special Form: defconst identifier value | + -- Special Form: defconst identifier value If IDENTIFIER is unbound in the top level environment, then IDENTIFIER is `define'd to the result of evaluating the form VALUE as if the `defconst' form were instead the form `(define @@ -3187,7 +3190,7 @@ File: scm.info, Node: Define and Set, Next: Defmacro, Prev: Syntax, Up: Synt an error is signaled. `defconst' is valid only when used at top-level. - -- Special Form: set! (variable1 variable2 ...) <expression> | + -- Special Form: set! (variable1 variable2 ...) <expression> The identifiers VARIABLE1, VARIABLE2, ... must be bound either in some region enclosing the `set!' expression or at top level. @@ -3201,7 +3204,7 @@ File: scm.info, Node: Define and Set, Next: Defmacro, Prev: Syntax, Up: Synt (set! (x y) (list 4 5)) => _unspecified_ (+ x y) => 9 - -- Special Form: qase key clause1 clause2 ... | + -- Special Form: qase key clause1 clause2 ... `qase' is an extension of standard Scheme `case': Each CLAUSE of a `qase' statement must have as first element a list containing elements which are: @@ -3242,8 +3245,8 @@ File: scm.info, Node: Define and Set, Next: Defmacro, Prev: Syntax, Up: Synt File: scm.info, Node: Defmacro, Next: Syntax-Rules, Prev: Define and Set, Up: Syntax -4.9.2 Defmacro | --------------- | +4.9.2 Defmacro +-------------- SCM supports the following constructs from Common Lisp: `defmacro', `macroexpand', `macroexpand-1', and `gentemp'. *Note Defmacro: @@ -3276,8 +3279,8 @@ For example: File: scm.info, Node: Syntax-Rules, Next: Macro Primitives, Prev: Defmacro, Up: Syntax -4.9.3 Syntax-Rules | ------------------- | +4.9.3 Syntax-Rules +------------------ SCM supports [R5RS] `syntax-rules' macros *Note Macros: (r5rs)Macros. @@ -3330,17 +3333,17 @@ For example: File: scm.info, Node: Macro Primitives, Next: Environment Frames, Prev: Syntax-Rules, Up: Syntax -4.9.4 Macro Primitives | ----------------------- | +4.9.4 Macro Primitives +---------------------- - -- Function: procedure->syntax proc | + -- Function: procedure->syntax proc Returns a "macro" which, when a symbol defined to this value appears as the first symbol in an expression, returns the result of applying PROC to the expression and the environment. - -- Function: procedure->macro proc | - -- Function: procedure->memoizing-macro proc | - -- Function: procedure->identifier-macro | + -- Function: procedure->macro proc + -- Function: procedure->memoizing-macro proc + -- Function: procedure->identifier-macro Returns a "macro" which, when a symbol defined to this value appears as the first symbol in an expression, evaluates the result of applying PROC to the expression and the environment. The value @@ -3362,7 +3365,7 @@ File: scm.info, Node: Macro Primitives, Next: Environment Frames, Prev: Synta identifier. - -- Special Form: defsyntax name expr | + -- Special Form: defsyntax name expr Defines NAME as a macro keyword bound to the result of evaluating EXPR, which should be a macro. Using `define' for this purpose may not result in NAME being interpreted as a macro keyword. @@ -3370,8 +3373,8 @@ File: scm.info, Node: Macro Primitives, Next: Environment Frames, Prev: Synta File: scm.info, Node: Environment Frames, Next: Syntactic Hooks for Hygienic Macros, Prev: Macro Primitives, Up: Syntax -4.9.5 Environment Frames | ------------------------- | +4.9.5 Environment Frames +------------------------ An "environment" is a list of frames representing lexical bindings. Only the names and scope of the bindings are included in environments @@ -3420,7 +3423,7 @@ There are several types of environment frames: <env-procedure-name-marker> the integer 2. - -- Special Form: @apply procedure argument-list | + -- Special Form: @apply procedure argument-list Returns the result of applying PROCEDURE to ARGUMENT-LIST. `@apply' differs from `apply' when the identifiers bound by the closure being applied are `set!'; setting affects ARGUMENT-LIST. @@ -3435,8 +3438,8 @@ There are several types of environment frames: File: scm.info, Node: Syntactic Hooks for Hygienic Macros, Prev: Environment Frames, Up: Syntax -4.9.6 Syntactic Hooks for Hygienic Macros | ------------------------------------------ | +4.9.6 Syntactic Hooks for Hygienic Macros +----------------------------------------- SCM provides a synthetic identifier type for efficient implementation of hygienic macros (for example, `syntax-rules' *note Macros: @@ -3444,7 +3447,7 @@ hygienic macros (for example, `syntax-rules' *note Macros: a macro expander in any context where a symbol would normally be used. Collectively, symbols and synthetic identifiers are _identifiers_. - -- Function: identifier? obj | + -- Function: identifier? obj Returns `#t' if OBJ is a symbol or a synthetic identifier, and `#f' otherwise. @@ -3457,7 +3460,7 @@ environment which has been passed to a "macro expander" (a procedure passed as an argument to `procedure->macro', `procedure->memoizing-macro', or `procedure->syntax'). - -- Function: renamed-identifier parent env | + -- Function: renamed-identifier parent env Returns a synthetic identifier. PARENT must be an identifier, and ENV must either be `#f' or a lexical environment passed to a macro expander. `renamed-identifier' returns a distinct object for each @@ -3468,12 +3471,12 @@ identifier, those data are used during variable lookup. If a synthetic identifier is inserted as quoted data then during macro expansion it will be repeatedly replaced by its parent, until a symbol is obtained. - -- Function: identifier->symbol id | + -- Function: identifier->symbol id Returns the symbol obtained by recursively extracting the parent of ID, which must be an identifier. -4.9.7 Use of Synthetic Identifiers | ----------------------------------- | +4.9.7 Use of Synthetic Identifiers +---------------------------------- `renamed-identifier' may be used as a replacement for `gentemp': (define gentemp @@ -3520,7 +3523,7 @@ determine whether two identifiers have the same denotation. With synthetic identifiers it is not necessary that two identifiers be `eq?' in order to denote the same binding. - -- Function: identifier-equal? id1 id2 env | + -- Function: identifier-equal? id1 id2 env Returns `#t' if identifiers ID1 and ID2 denote the same binding in lexical environment ENV, and `#f' otherwise. ENV must either be a lexical environment passed to a macro transformer during macro @@ -3538,13 +3541,13 @@ in order to denote the same binding. (let ((foo 'local)) (top-level-foo? foo)) => #f - -- Function: @macroexpand1 expr env | + -- Function: @macroexpand1 expr env If the `car' of EXPR denotes a macro in ENV, then if that macro is a primitive, EXPR will be returned, if the macro was defined in Scheme, then a macro expansion will be returned. If the `car' of EXPR does not denote a macro, the `#f' is returned. - -- Function: extended-environment names values env | + -- Function: extended-environment names values env Returns a new environment object, equivalent to ENV, which must either be an environment object or null, extended by one frame. NAMES must be an identifier, or an improper list of identifiers, @@ -3554,13 +3557,13 @@ in order to denote the same binding. list then VALS may be, respectively, any object or an improper list of objects. - -- Special Form: syntax-quote obj | + -- Special Form: syntax-quote obj Synthetic identifiers are converted to their parent symbols by `quote' and `quasiquote' so that literal data in macro definitions will be properly transcribed. `syntax-quote' behaves like `quote', but preserves synthetic identifier intact. - -- Special Form: the-macro mac | + -- Special Form: the-macro mac `the-macro' is the simplest of all possible macro transformers: MAC may be a syntactic keyword (macro name) or an expression evaluating to a macro, otherwise an error is signaled. MAC is @@ -3573,7 +3576,7 @@ in order to denote the same binding. ;; code that will continue to work even if LET is redefined. ...) - -- Special Form: renaming-transformer proc | + -- Special Form: renaming-transformer proc A low-level "explicit renaming" macro facility very similar to that proposed by W. Clinger [Exrename] is supported. Syntax may be defined in `define-syntax', `let-syntax', and `letrec-syntax' @@ -3589,8 +3592,8 @@ in order to denote the same binding. File: scm.info, Node: Packages, Next: The Implementation, Prev: The Language, Up: Top -5 Packages | -********** | +5 Packages +********** * Menu: @@ -3602,46 +3605,46 @@ File: scm.info, Node: Packages, Next: The Implementation, Prev: The Language, * I/O-Extensions:: i/o-extensions * Posix Extensions:: posix * Unix Extensions:: non-posix unix -* Sequence Comparison:: | +* Sequence Comparison:: * Regular Expression Pattern Matching:: regex * Line Editing:: edit-line * Curses:: Screen Control * Sockets:: Cruise the Net -* SCMDB:: interface to MySQL | +* SCMDB:: interface to MySQL * Menu: * Xlib: (Xlibscm). X Window Graphics. -* Hobbit: (hobbit). Scheme-to-C Compiler | +* Hobbit: (hobbit). Scheme-to-C Compiler File: scm.info, Node: Dynamic Linking, Next: Dump, Prev: Packages, Up: Packages -5.1 Dynamic Linking | -=================== | +5.1 Dynamic Linking +=================== If SCM has been compiled with `dynl.c' then the additional properties of load and ([SLIB]) require specified here are supported. The `require' form is preferred. - -- Function: require feature | + -- Function: require feature If the symbol FEATURE has not already been given as an argument to `require', then the object and library files associated with FEATURE will be dynamically-linked, and an unspecified value returned. If FEATURE is not found in `*catalog*', then an error is signaled. - -- Function: usr:lib lib | + -- Function: usr:lib lib Returns the pathname of the C library named LIB. For example: `(usr:lib "m")' returns `"/usr/lib/libm.a"', the path of the C math library. - -- Function: x:lib lib | + -- Function: x:lib lib Returns the pathname of the X library named LIB. For example: `(x:lib "X11")' returns `"/usr/X11/lib/libX11.sa"', the path of the X11 library. - -- Function: load filename lib1 ... | + -- Function: load filename lib1 ... In addition to the [R5RS] requirement of loading Scheme expressions if FILENAME is a Scheme source file, `load' will also dynamically load/link object files (produced by `compile-file', for @@ -3684,7 +3687,7 @@ The following functions comprise the low-level Scheme interface to dynamic linking. See the file `Link.scm' in the SCM distribution for an example of their use. - -- Function: dyn:link filename | + -- Function: dyn:link filename FILENAME should be a string naming an "object" or "archive" file, the result of C-compiling. The `dyn:link' procedure links and loads FILENAME into the current SCM session. If successfull, @@ -3692,7 +3695,7 @@ an example of their use. second argument to `dyn:call'. If not successful, `#f' is returned. - -- Function: dyn:call name link-token | + -- Function: dyn:call name link-token LINK-TOKEN should be the value returned by a call to `dyn:link'. NAME should be the name of C function of no arguments defined in the file named FILENAME which was succesfully `dyn:link'ed in the @@ -3704,10 +3707,10 @@ an example of their use. SCM object files. The init_... function then makes the identifiers defined in the file accessible as Scheme procedures. - -- Function: dyn:main-call name link-token arg1 ... | + -- 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, - 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' @@ -3719,7 +3722,7 @@ an example of their use. low level routines of which callback (*note Callbacks::) into SCM (which emulates PCI hardware). - -- Function: dyn:unlink link-token | + -- Function: dyn:unlink link-token LINK-TOKEN should be the value returned by a call to `dyn:link'. The `dyn:unlink' procedure removes the previously loaded file from the current SCM session. If successful, `dyn:unlink' returns @@ -3728,8 +3731,8 @@ an example of their use. File: scm.info, Node: Dump, Next: Numeric, Prev: Dynamic Linking, Up: Packages -5.2 Dump | -======== | +5.2 Dump +======== "Dump", (also known as "unexec"), saves the continuation of an entire SCM session to an executable file, which can then be invoked as a @@ -3757,10 +3760,10 @@ There are constraints on which sessions are savable using `dump' * `Dump' can be called from the command line. - -- Function: dump newpath | - -- Function: dump newpath #f | - -- Function: dump newpath #t | - -- Function: dump newpath thunk | + -- Function: dump newpath + -- Function: dump newpath #f + -- Function: dump newpath #t + -- Function: dump newpath thunk * Calls `gc'. * Creates an executable program named NEWPATH which continues @@ -3826,66 +3829,66 @@ This task can also be accomplished using the `-o' command line option File: scm.info, Node: Numeric, Next: Arrays, Prev: Dump, Up: Packages -5.3 Numeric | -=========== | +5.3 Numeric +=========== - -- Constant: most-positive-fixnum | + -- Constant: most-positive-fixnum The immediate integer closest to positive infinity. *Note Configuration: (slib)Configuration. - -- Constant: most-negative-fixnum | + -- Constant: most-negative-fixnum The immediate integer closest to negative infinity. - -- Constant: $pi | - -- Constant: pi | + -- Constant: $pi + -- Constant: pi The ratio of the circumference to the diameter of a circle. These procedures augment the standard capabilities in *Note Numerical operations: (r5rs)Numerical operations. - -- Function: pi* z | + -- Function: pi* z `(* pi Z)' - -- Function: pi/ z | + -- Function: pi/ z `(/ pi Z)' - -- Function: sinh z | - -- Function: cosh z | - -- Function: tanh z | + -- Function: sinh z + -- Function: cosh z + -- Function: tanh z Return the hyperbolic sine, cosine, and tangent of Z - -- Function: asinh z | - -- Function: acosh z | - -- Function: atanh z | + -- Function: asinh z + -- Function: acosh z + -- 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: $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 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: $log10 x Real-only base 10 logarithm. - -- Function: $atan2 y x | + -- Function: $atan2 y x Computes `(angle (make-rectangular x y))' for real numbers Y and X. - -- Function: $expt x1 x2 | + -- Function: $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. @@ -3893,8 +3896,8 @@ operations: (r5rs)Numerical operations. File: scm.info, Node: Arrays, Next: Records, Prev: Numeric, Up: Packages -5.4 Arrays | -========== | +5.4 Arrays +========== * Menu: @@ -3906,8 +3909,8 @@ File: scm.info, Node: Arrays, Next: Records, Prev: Numeric, Up: Packages File: scm.info, Node: Conventional Arrays, Next: Uniform Array, Prev: Arrays, Up: Arrays -5.4.1 Conventional Arrays | -------------------------- | +5.4.1 Conventional Arrays +------------------------- The following syntax and procedures are SCM extensions to feature `array' in *Note Arrays: (slib)Arrays. @@ -3916,14 +3919,14 @@ The following syntax and procedures are SCM extensions to feature dimensions) followed by the character #\a or #\A and what appear as lists (of lists) of elements. The lists must be nested to the depth of the rank. For each depth, all lists must be the same length. - (make-array '#(ho) 4 3) => | - #2A((ho ho ho) (ho ho ho) (ho ho ho) (ho ho ho)) | + (make-array '#(ho) 4 3) => + #2A((ho ho ho) (ho ho ho) (ho ho ho) (ho ho ho)) Unshared, conventional (not uniform) 0-based arrays of rank 1 are equivalent to (and can't be distinguished from) scheme vectors. - (make-array '#(ho) 3) => #(ho ho ho) | + (make-array '#(ho) 3) => #(ho ho ho) - -- Function: transpose-array array dim0 dim1 ... | + -- Function: transpose-array array dim0 dim1 ... Returns an array sharing contents with ARRAY, but with dimensions arranged in a different order. There must be one DIM argument for each dimension of ARRAY. DIM0, DIM1, ... should be integers @@ -3941,7 +3944,7 @@ equivalent to (and can't be distinguished from) scheme vectors. (transpose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) => #2A((a 4) (b 5) (c 6)) - -- Function: enclose-array array dim0 dim1 ... | + -- Function: enclose-array array dim0 dim1 ... DIM0, DIM1 ... should be nonnegative integers less than the rank of ARRAY. ENCLOSE-ARRAY returns an array resembling an array of shared arrays. The dimensions of each shared array are the same @@ -3962,17 +3965,17 @@ equivalent to (and can't be distinguished from) scheme vectors. (enclose-array '#3A(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0) => #<enclosed-array #2A((a 1) (d 4)) #2A((b 2) (e 5)) #2A((c 3) (f 6))> - -- Function: array->list array | + -- Function: array->list array Returns a list consisting of all the elements, in order, of ARRAY. In the case of a rank-0 array, returns the single element. - -- Function: array-contents array | - -- Function: array-contents array strict | + -- Function: array-contents array + -- Function: array-contents array strict If ARRAY may be "unrolled" into a one dimensional shared array without changing their order (last subscript changing fastest), then `array-contents' returns that shared array, otherwise it - returns `#f'. All arrays made by MAKE-ARRAY may be unrolled, some | - arrays made by MAKE-SHARED-ARRAY may not be. | + returns `#f'. All arrays made by MAKE-ARRAY may be unrolled, some + arrays made by MAKE-SHARED-ARRAY may not be. If the optional argument STRICT is provided, a shared array will be returned only if its elements are stored internally contiguous @@ -3981,8 +3984,8 @@ equivalent to (and can't be distinguished from) scheme vectors. File: scm.info, Node: Uniform Array, Next: Bit Vectors, Prev: Conventional Arrays, Up: Arrays -5.4.2 Uniform Array | -------------------- | +5.4.2 Uniform Array +------------------- "Uniform Arrays" and vectors are arrays whose elements are all of the same type. Uniform vectors occupy less storage than conventional @@ -3990,16 +3993,16 @@ vectors. Uniform Array procedures also work on vectors, uniform-vectors, bit-vectors, and strings. SLIB now supports uniform arrys. The primary array creation procedure -is `make-array', detailed in *Note Arrays: (slib)Arrays. | +is `make-array', detailed in *Note Arrays: (slib)Arrays. Unshared uniform character 0-based arrays of rank 1 (dimension) are equivalent to (and can't be distinguished from) strings. - (make-array "" 3) => "$q2" | + (make-array "" 3) => "$q2" Unshared uniform boolean 0-based arrays of rank 1 (dimension) are equivalent to (and can't be distinguished from) *Note bit-vectors: Bit Vectors. - (make-array '#1at() 3) => #*000 | + (make-array '#1at() 3) => #*000 == #1At(#f #f #f) => #*000 @@ -4008,30 +4011,30 @@ according to the table: prototype type display prefix - () conventional vector #A | - +64i complex (double precision) #A:floC64b | - 64.0 double (double precision) #A:floR64b | - 32.0 float (single precision) #A:floR32b | - 32 unsigned integer (32-bit) #A:fixN32b | - -32 signed integer (32-bit) #A:fixZ32b | - -16 signed integer (16-bit) #A:fixZ16b | - #\a char (string) #A:char | - #t boolean (bit-vector) #A:bool | + () conventional vector #A + +64i complex (double precision) #A:floC64b + 64.0 double (double precision) #A:floR64b + 32.0 float (single precision) #A:floR32b + 32 unsigned integer (32-bit) #A:fixN32b + -32 signed integer (32-bit) #A:fixZ32b + -16 signed integer (16-bit) #A:fixZ16b + #\a char (string) #A:char + #t boolean (bit-vector) #A:bool Other uniform vectors are written in a form similar to that of general arrays, except that one or more modifying characters are put between the -#\A character and the contents list. For example, `'#1A:fixZ32b(3 5 9)' | +#\A character and the contents list. For example, `'#1A:fixZ32b(3 5 9)' returns a uniform vector of signed integers. - -- Function: array? obj prototype | + -- Function: array? obj prototype Returns `#t' if the OBJ is an array of type corresponding to PROTOTYPE, and `#f' if not. - -- Function: array-prototype array | + -- Function: array-prototype array Returns an object that would produce an array of the same type as ARRAY, if used as the PROTOTYPE for `list->uniform-array'. - -- Function: list->uniform-array rank prot lst | + -- Function: list->uniform-array rank prot lst Returns a uniform array of the type indicated by prototype PROT with elements the same as those of LST. Elements must be of the appropriate type, no coercions are done. @@ -4044,8 +4047,8 @@ returns a uniform vector of signed integers. If RANK is zero, LST, which need not be a list, is the single element of the returned array. - -- Function: uniform-array-read! ura | - -- Function: uniform-array-read! ura port | + -- Function: uniform-array-read! ura + -- Function: uniform-array-read! ura port Attempts to read all elements of URA, in lexicographic order, as binary objects from PORT. If an end of file is encountered during uniform-array-read! the objects up to that point only are put into @@ -4056,14 +4059,14 @@ returns a uniform vector of signed integers. may be omitted, in which case it defaults to the value returned by `(current-input-port)'. - -- Function: uniform-array-write ura | - -- Function: uniform-array-write ura port | + -- Function: uniform-array-write ura + -- Function: uniform-array-write ura port Writes all elements of URA as binary objects to PORT. The number of of objects actually written is returned. PORT may be omitted, in which case it defaults to the value returned by `(current-output-port)'. - -- Function: logaref array index1 index2 ... | + -- Function: logaref array index1 index2 ... If an INDEX is provided for each dimension of ARRAY returns the INDEX1, INDEX2, ...'th element of ARRAY. If one more INDEX is provided, then the last index specifies bit position of the @@ -4075,7 +4078,7 @@ returns a uniform vector of signed integers. (logaref '#(#b1101 #b0010) 0 1) => #f (logaref '#2((#b1101 #b0010)) 0 0) => #b1101 - -- Function: logaset! array val index1 index2 ... | + -- Function: logaset! array val index1 index2 ... If an INDEX is provided for each dimension of ARRAY sets the INDEX1, INDEX2, ...'th element of ARRAY to VAL. If one more INDEX is provided, then the last index specifies bit position of the @@ -4087,29 +4090,29 @@ returns a uniform vector of signed integers. File: scm.info, Node: Bit Vectors, Next: Array Mapping, Prev: Uniform Array, Up: Arrays -5.4.3 Bit Vectors | ------------------ | +5.4.3 Bit Vectors +----------------- Bit vectors can be written and read as a sequence of `0's and `1's prefixed by `#*'. - #1At(#f #f #f #t #f #t #f) => #*0001010 | + #1At(#f #f #f #t #f #t #f) => #*0001010 Some of these operations will eventually be generalized to other uniform-arrays. - -- Function: bit-count bool bv | - Returns the number of occurrences of BOOL in BV. | + -- Function: bit-count bool bv + Returns the number of occurrences of BOOL in BV. - -- Function: bit-position bool bv k | + -- Function: bit-position bool bv k Returns the minimum index of an occurrence of BOOL in BV which is at least K. If no BOOL occurs within the specified range `#f' is returned. - -- Function: bit-invert! bv | + -- Function: bit-invert! bv Modifies BV by replacing each element with its negation. - -- Function: bit-set*! bv uve bool | + -- Function: bit-set*! bv uve bool If uve is a bit-vector BV and uve must be of the same length. If BOOL is `#t', uve is OR'ed into BV; If BOOL is `#f', the inversion of uve is AND'ed into BV. @@ -4120,7 +4123,7 @@ uniform-arrays. The return value is unspecified. - -- Function: bit-count* bv uve bool | + -- Function: bit-count* bv uve bool Returns (bit-count (bit-set*! (if bool bv (bit-invert! bv)) uve #t) #t). BV is not modified. @@ -4128,28 +4131,28 @@ uniform-arrays. File: scm.info, Node: Array Mapping, Prev: Bit Vectors, Up: Arrays -5.4.4 Array Mapping | -------------------- | +5.4.4 Array Mapping +------------------- `(require 'array-for-each)' SCM has some extra functions in feature `array-for-each': - -- Function: array-fill! array fill | + -- Function: array-fill! array fill Stores FILL in every element of ARRAY. The value returned is unspecified. - -- Function: serial-array:copy! destination source | - Same as `array:copy!' but guaranteed to copy in row-major order. | + -- Function: serial-array:copy! destination source + Same as `array:copy!' but guaranteed to copy in row-major order. - -- Function: array-equal? array0 array1 ... | + -- Function: array-equal? array0 array1 ... Returns `#t' iff all arguments are arrays with the same shape, the same type, and have corresponding elements which are either `equal?' or `array-equal?'. This function differs from `equal?' in that a one dimensional shared array may be ARRAY-EQUAL? but not EQUAL? to a vector or uniform vector. - -- Function: array-map! array0 proc array1 ... | + -- Function: array-map! array0 proc array1 ... If ARRAY1, ... are arrays, they must have the same number of dimensions as ARRAY0 and have a range for each index which includes the range for the corresponding index in ARRAY0. If they @@ -4161,22 +4164,22 @@ SCM has some extra functions in feature `array-for-each': unspecified. Handling non-array arguments is a SCM extension of *Note - array-map!: (slib)Array Mapping. | + array-map!: (slib)Array Mapping. - -- Function: serial-array-map! array0 proc array1 ... | + -- Function: serial-array-map! array0 proc array1 ... Same as ARRAY-MAP!, but guaranteed to apply PROC in row-major order. - -- Function: array-map prototype proc array1 array2 ... | - ARRAY2, ... must have the same number of dimensions as ARRAY1 and | - have a range for each index which includes the range for the | - corresponding index in ARRAY1. PROC is applied to each tuple of | - elements of ARRAY1, ARRAY2, ... and the result is stored as the | - corresponding element in a new array of type PROTOTYPE. The new | - array is returned. The order of application is unspecified. | - | - -- Function: scalar->array scalar array prototype | - -- Function: scalar->array scalar array | + -- Function: array-map prototype proc array1 array2 ... + ARRAY2, ... must have the same number of dimensions as ARRAY1 and + have a range for each index which includes the range for the + corresponding index in ARRAY1. PROC is applied to each tuple of + elements of ARRAY1, ARRAY2, ... and the result is stored as the + corresponding element in a new array of type PROTOTYPE. The new + array is returned. The order of application is unspecified. + + -- Function: scalar->array scalar array prototype + -- Function: scalar->array scalar array Returns a uniform array of the same shape as ARRAY, having only one shared element, which is `eqv?' to SCALAR. If the optional argument PROTOTYPE is supplied it will be used as the prototype @@ -4188,13 +4191,13 @@ SCM has some extra functions in feature `array-for-each': File: scm.info, Node: Records, Next: I/O-Extensions, Prev: Arrays, Up: Packages -5.5 Records | -=========== | +5.5 Records +=========== SCM provides user-definable datatypes with the same interface as SLIB, see *Note Records: (slib)Records, with the following extension. - -- Function: record-printer-set! rtd printer | + -- Function: record-printer-set! rtd printer Causes records of type RTD to be printed in a user-specified format. RTD must be a record type descriptor returned by `make-record-type', PRINTER a procedure accepting three arguments: @@ -4210,13 +4213,13 @@ see *Note Records: (slib)Records, with the following extension. File: scm.info, Node: I/O-Extensions, Next: Posix Extensions, Prev: Records, Up: Packages -5.6 I/O-Extensions | -================== | +5.6 I/O-Extensions +================== If `'i/o-extensions' is provided (by linking in `ioext.o'), *Note Line I/O: (slib)Line I/O, and the following functions are defined: - -- Function: stat <port-or-string> | + -- Function: stat <port-or-string> Returns a vector of integers describing the argument. The argument can be either a string or an open input port. If the argument is an open port then the returned vector describes the file to which @@ -4259,70 +4262,70 @@ I/O: (slib)Line I/O, and the following functions are defined: 10 st_ctime Last file status change time - -- Function: getpid | + -- Function: getpid Returns the process ID of the current process. - -- Function: file-position port | + -- Function: file-position port Returns the current position of the character in PORT which will next be read or written. If PORT is not open to a file the result is unspecified. - -- Function: file-set-position port integer | + -- Function: file-set-position port integer Sets the current position in PORT which will next be read or written. If PORT is not open to a file the action of `file-set-position' is unspecified. The result of `file-set-position' is unspecified. - -- Function: try-create-file name modes perms | + -- Function: try-create-file name modes perms If the file with name NAME already exists, return `#f', otherwise try to create and open the file like `try-open-file', *Note Files and Ports::. If the optional integer argument PERMS is provided, it is used as the permissions of the new file (modified by the current umask). - -- Function: reopen-file filename modes port | + -- Function: reopen-file filename modes port Closes port PORT and reopens it with FILENAME and MODES. `reopen-file' returns `#t' if successful, `#f' if not. - -- Function: duplicate-port port modes | + -- Function: duplicate-port port modes Creates and returns a "duplicate" port from PORT. Duplicate _unbuffered_ ports share one file position. MODES are as for *Note open-file: Files and Ports. - -- Function: redirect-port! from-port to-port | + -- Function: redirect-port! from-port to-port Closes TO-PORT and makes TO-PORT be a duplicate of FROM-PORT. `redirect-port!' returns TO-PORT if successful, `#f' if not. If unsuccessful, TO-PORT is not closed. - -- Function: opendir dirname | + -- Function: opendir dirname Returns a "directory" object corresponding to the file system directory named DIRNAME. If unsuccessful, returns `#f'. - -- Function: readdir dir | + -- Function: readdir dir Returns the string name of the next entry from the directory DIR. If there are no more entries in the directory, `readdir' returns a `#f'. - -- Function: rewinddir dir | + -- Function: rewinddir dir Reinitializes DIR so that the next call to `readdir' with DIR will return the first entry in the directory again. - -- Function: closedir dir | + -- Function: closedir dir Closes DIR and returns `#t'. If DIR is already closed,, `closedir' returns a `#f'. - -- Function: directory-for-each proc directory | + -- Function: directory-for-each proc directory PROC must be a procedure taking one argument. `Directory-For-Each' applies PROC to the (string) name of each file in DIRECTORY. The dynamic order in which PROC is applied to the filenames is unspecified. The value returned by `directory-for-each' is unspecified. - -- Function: directory-for-each proc directory pred | + -- Function: directory-for-each proc directory pred Applies PROC only to those filenames for which the procedure PRED returns a non-false value. - -- Function: directory-for-each proc directory match | + -- Function: directory-for-each proc directory match Applies PROC only to those filenames for which `(filename:match?? MATCH)' would return a non-false value (*note Filenames: (slib)Filenames.). @@ -4335,9 +4338,9 @@ I/O: (slib)Line I/O, and the following functions are defined: "Link.scm" "Macro.scm" "Transcen.scm" - "Init5e1.scm" | + "Init5e2.scm" | - -- Function: mkdir path mode | + -- Function: mkdir path mode The `mkdir' function creates a new, empty directory whose name is PATH. The integer argument MODE specifies the file permissions for the new directory. *Note The Mode Bits for Access Permission: @@ -4346,48 +4349,48 @@ I/O: (slib)Line I/O, and the following functions are defined: `mkdir' returns if successful, `#f' if not. - -- Function: rmdir path | + -- Function: rmdir path The `rmdir' function deletes the directory PATH. The directory must be empty before it can be removed. `rmdir' returns if successful, `#f' if not. - -- Function: chdir filename | + -- Function: chdir filename Changes the current directory to FILENAME. If FILENAME does not exist or is not a directory, `#f' is returned. Otherwise, `#t' is returned. - -- Function: getcwd | + -- Function: getcwd The function `getcwd' returns a string containing the absolute file name representing the current working directory. If this string cannot be obtained, `#f' is returned. - -- Function: rename-file oldfilename newfilename | + -- Function: rename-file oldfilename newfilename Renames the file specified by OLDFILENAME to NEWFILENAME. If the renaming is successful, `#t' is returned. Otherwise, `#f' is returned. - -- Function: chmod file mode | + -- Function: chmod file mode The function `chmod' sets the access permission bits for the file named by FILE to MODE. The FILE argument may be a string containing the filename or a port open to the file. `chmod' returns if successful, `#f' if not. - -- Function: utime pathname acctime modtime | + -- Function: utime pathname acctime modtime Sets the file times associated with the file named PATHNAME to have access time ACCTIME and modification time MODTIME. `utime' returns if successful, `#f' if not. - -- Function: umask mode | + -- Function: umask mode The function `umask' sets the file creation mask of the current process to MASK, and returns the previous value of the file creation mask. - -- Function: fileno port | + -- Function: fileno port Returns the integer file descriptor associated with the port PORT. If an error is detected, `#f' is returned. - -- Function: access pathname how | + -- Function: access pathname how Returns `#t' if the file named by PATHNAME can be accessed in the way specified by the HOW argument. The HOW argument can be the `logior' of the flags: @@ -4413,8 +4416,8 @@ I/O: (slib)Line I/O, and the following functions are defined: <r> File-is-readable? - -- Function: execl command arg0 ... | - -- Function: execlp command arg0 ... | + -- Function: execl command arg0 ... + -- Function: execlp command arg0 ... Transfers control to program COMMAND called with arguments ARG0 .... For `execl', COMMAND must be an exact pathname of an executable file. `execlp' searches for COMMAND in the list of @@ -4424,12 +4427,12 @@ I/O: (slib)Line I/O, and the following functions are defined: If successful, this procedure does not return. Otherwise an error message is printed and the integer `errno' is returned. - -- Function: execv command arglist | - -- Function: execvp command arglist | + -- Function: execv command arglist + -- Function: execvp command arglist Like `execl' and `execlp' except that the set of arguments to COMMAND is ARGLIST. - -- Function: putenv string | + -- Function: putenv string adds or removes definitions from the "environment". If the STRING is of the form `NAME=VALUE', the definition is added to the environment. Otherwise, the STRING is interpreted as the name of @@ -4450,30 +4453,30 @@ I/O: (slib)Line I/O, and the following functions are defined: File: scm.info, Node: Posix Extensions, Next: Unix Extensions, Prev: I/O-Extensions, Up: Packages -5.7 Posix Extensions | -==================== | +5.7 Posix Extensions +==================== If `'posix' is provided (by linking in `posix.o'), the following functions are defined: - -- Function: open-pipe string modes | + -- Function: open-pipe string modes If the string MODES contains an <r>, returns an input port capable of delivering characters from the standard output of the system command STRING. Otherwise, returns an output port capable of receiving characters which become the standard input of the system command STRING. If a pipe cannot be created `#f' is returned. - -- Function: open-input-pipe string | + -- Function: open-input-pipe string Returns an input port capable of delivering characters from the standard output of the system command STRING. If a pipe cannot be created `#f' is returned. - -- Function: open-output-pipe string | + -- Function: open-output-pipe string Returns an output port capable of receiving characters which become the standard input of the system command STRING. If a pipe cannot be created `#f' is returned. - -- Function: broken-pipe port | + -- Function: broken-pipe port If this function is defined at top level, it will be called when an output pipe is closed from the other side (this is the condition under which a SIGPIPE is sent). The already closed PORT will be @@ -4481,16 +4484,16 @@ functions are defined: signaled when output to a pipe fails in this way, but any further output to the closed pipe will cause an error to be signaled. - -- Function: close-port pipe | + -- Function: close-port pipe Closes the PIPE, rendering it incapable of delivering or accepting characters. This routine has no effect if the pipe has already been closed. The value returned is unspecified. - -- Function: pipe | + -- Function: pipe Returns `(cons RD WD)' where RD and WD are the read and write (port) ends of a "pipe" respectively. - -- Function: fork | + -- Function: fork Creates a copy of the process calling `fork'. Both processes return from `fork', but the calling ("parent") process's `fork' returns the "child" process's ID whereas the child process's @@ -4499,39 +4502,39 @@ functions are defined: For a discussion of "ID"s *Note Process Persona: (GNU C Library)Process Persona. - -- Function: getppid | + -- Function: getppid Returns the process ID of the parent of the current process. For a process's own ID *Note getpid: I/O-Extensions. - -- Function: getuid | + -- Function: getuid Returns the real user ID of this process. - -- Function: getgid | + -- Function: getgid Returns the real group ID of this process. - -- Function: getegid | + -- Function: getegid Returns the effective group ID of this process. - -- Function: geteuid | + -- Function: geteuid Returns the effective user ID of this process. - -- Function: setuid id | + -- Function: setuid id Sets the real user ID of this process to ID. Returns `#t' if successful, `#f' if not. - -- Function: setgid id | + -- Function: setgid id Sets the real group ID of this process to ID. Returns `#t' if successful, `#f' if not. - -- Function: setegid id | + -- Function: setegid id Sets the effective group ID of this process to ID. Returns `#t' if successful, `#f' if not. - -- Function: seteuid id | + -- Function: seteuid id Sets the effective user ID of this process to ID. Returns `#t' if successful, `#f' if not. - -- Function: kill pid sig | + -- Function: kill pid sig The `kill' function sends the signal SIGNUM to the process or process group specified by PID. Besides the signals listed in *Note Standard Signals: (libc)Standard Signals, SIGNUM can also @@ -4570,7 +4573,7 @@ Persona. There's no way you can tell which of the processes got the signal or whether all of them did. - -- Function: waitpid pid options | + -- Function: waitpid pid options The `waitpid' function suspends execution of the current process until a child as specified by the PID argument has exited, or until a signal is delivered whose action is to terminate the @@ -4618,7 +4621,7 @@ Persona. information about the `errno' codes *Note Process Completion: (GNU C Library)Process Completion. - -- Function: uname | + -- Function: uname You can use the `uname' procedure to find out some information about the type of computer your program is running on. @@ -4639,9 +4642,9 @@ Persona. Some examples are `"i386-ANYTHING"', `"m68k-hp"', `"sparc-sun"', `"m68k-sun"', `"m68k-sony"' and `"mips-dec"'. - -- Function: getpw name | - -- Function: getpw uid | - -- Function: getpw | + -- Function: getpw name + -- Function: getpw uid + -- Function: getpw Returns a vector of information for the entry for `NAME', `UID', or the next entry if no argument is given. The information is: @@ -4663,16 +4666,16 @@ Persona. user logs in, or `#f', indicating that the system default should be used. - -- Function: setpwent #t | + -- Function: setpwent #t Rewinds the pw entry table back to the begining. - -- Function: setpwent #f | - -- Function: setpwent | + -- Function: setpwent #f + -- Function: setpwent Closes the pw table. - -- Function: getgr name | - -- Function: getgr uid | - -- Function: getgr | + -- Function: getgr name + -- Function: getgr uid + -- Function: getgr Returns a vector of information for the entry for `NAME', `UID', or the next entry if no argument is given. The information is: @@ -4684,69 +4687,69 @@ Persona. 3. A list of (string) names of users in the group. - -- Function: setgrent #t | + -- Function: setgrent #t Rewinds the group entry table back to the begining. - -- Function: setgrent #f | - -- Function: setgrent | + -- Function: setgrent #f + -- Function: setgrent Closes the group table. - -- Function: getgroups | + -- Function: getgroups Returns a vector of all the supplementary group IDs of the process. - -- Function: link oldname newname | + -- Function: link oldname newname The `link' function makes a new link to the existing file named by OLDNAME, under the new name NEWNAME. `link' returns a value of `#t' if it is successful and `#f' on failure. - -- Function: chown filename owner group | + -- Function: chown filename owner group The `chown' function changes the owner of the file FILENAME to OWNER, and its group owner to GROUP. `chown' returns a value of `#t' if it is successful and `#f' on failure. - -- Function: ttyname port | + -- Function: ttyname port If port PORT is associated with a terminal device, returns a string containing the file name of termainal device; otherwise `#f'. File: scm.info, Node: Unix Extensions, Next: Sequence Comparison, Prev: Posix Extensions, Up: Packages - | -5.8 Unix Extensions | -=================== | + +5.8 Unix Extensions +=================== If `'unix' is provided (by linking in `unix.o'), the following functions are defined: These "privileged" and symbolic link functions are not in Posix: - -- Function: symlink oldname newname | + -- Function: symlink oldname newname The `symlink' function makes a symbolic link to OLDNAME named NEWNAME. `symlink' returns a value of `#t' if it is successful and `#f' on failure. - -- Function: readlink filename | + -- Function: readlink filename Returns the value of the symbolic link FILENAME or `#f' for failure. - -- Function: lstat filename | + -- Function: lstat filename The `lstat' function is like `stat', except that it does not follow symbolic links. If FILENAME is the name of a symbolic link, `lstat' returns information about the link itself; otherwise, `lstat' works like `stat'. *Note I/O-Extensions::. - -- Function: nice increment | + -- Function: nice increment Increment the priority of the current process by INCREMENT. `chown' returns a value of `#t' if it is successful and `#f' on failure. - -- Function: acct filename | + -- Function: acct filename When called with the name of an exisitng file as argument, accounting is turned on, records for each terminating process are appended to FILENAME as it terminates. An argument of `#f' causes @@ -4755,41 +4758,41 @@ These "privileged" and symbolic link functions are not in Posix: `acct' returns a value of `#t' if it is successful and `#f' on failure. - -- Function: mknod filename mode dev | + -- Function: mknod filename mode dev The `mknod' function makes a special file with name FILENAME and modes MODE for device number DEV. `mknod' returns a value of `#t' if it is successful and `#f' on failure. - -- Function: sync | + -- Function: sync `sync' first commits inodes to buffers, and then buffers to disk. sync() only schedules the writes, so it may return before the actual writing is done. The value returned is unspecified. File: scm.info, Node: Sequence Comparison, Next: Regular Expression Pattern Matching, Prev: Unix Extensions, Up: Packages - | -5.9 Sequence Comparison | -======================= | - | -`(require 'diff)' | - | -A blazing fast implementation of the sequence-comparison module in | -SLIB, see *Note Sequence Comparison: (slib)Sequence Comparison. | - | + +5.9 Sequence Comparison +======================= + +`(require 'diff)' + +A blazing fast implementation of the sequence-comparison module in +SLIB, see *Note Sequence Comparison: (slib)Sequence Comparison. + File: scm.info, Node: Regular Expression Pattern Matching, Next: Line Editing, Prev: Sequence Comparison, Up: Packages - | -5.10 Regular Expression Pattern Matching | -======================================== | + +5.10 Regular Expression Pattern Matching +======================================== These functions are defined in `rgx.c' using a POSIX or GNU "regex" library. If your computer does not support regex, a package is available via ftp from `ftp.gnu.org:/pub/gnu/regex-0.12.tar.gz'. For a description of regular expressions, *Note syntax: (regex)syntax. - -- Function: regcomp PATTERN [FLAGS] | + -- Function: regcomp PATTERN [FLAGS] Compile a "regular expression". Return a compiled regular expression, or an integer error code suitable as an argument to `regerror'. @@ -4811,11 +4814,11 @@ description of regular expressions, *Note syntax: (regex)syntax. `f' enable GNU fastmaps. - -- Function: regerror ERRNO | + -- Function: regerror ERRNO Returns a string describing the integer ERRNO returned when `regcomp' fails. - -- Function: regexec RE STRING | + -- Function: regexec RE STRING Returns `#f' or a vector of integers. These integers are in doublets. The first of each doublet is the index of STRING of the start of the matching expression or sub-expression (delimited by @@ -4823,15 +4826,15 @@ description of regular expressions, *Note syntax: (regex)syntax. STRING of the end of that expression. `#f' is returned if the string does not match. - -- Function: regmatch? RE STRING | + -- Function: regmatch? RE STRING Returns `#t' if the PATTERN such that REGEXP = (regcomp PATTERN) matches STRING as a POSIX extended regular expressions. Returns `#f' otherwise. - -- Function: regsearch RE STRING [START [LEN]] | - -- Function: regsearchv RE STRING [START [LEN]] | - -- Function: regmatch RE STRING [START [LEN]] | - -- Function: regmatchv RE STRING [START [LEN]] | + -- Function: regsearch RE STRING [START [LEN]] + -- Function: regsearchv RE STRING [START [LEN]] + -- Function: regmatch RE STRING [START [LEN]] + -- Function: regmatchv RE STRING [START [LEN]] `Regsearch' searches for the pattern within the string. `Regmatch' anchors the pattern and begins matching it against @@ -4861,7 +4864,7 @@ description of regular expressions, *Note syntax: (regex)syntax. The character position at which to begin the search or match. If absent, the default is zero. - _Compiled _GNU_SOURCE and using GNU libregex only_ | + _Compiled _GNU_SOURCE and using GNU libregex only_ When searching, if START is negative, the absolute value of @@ -4873,15 +4876,15 @@ description of regular expressions, *Note syntax: (regex)syntax. characters of STRING. If absent, the entire string may be examined. - -- Function: string-split RE STRING | - -- Function: string-splitv RE STRING | + -- Function: string-split RE STRING + -- Function: string-splitv RE STRING `String-split' splits a string into substrings that are separated by RE, returning a vector of substrings. `String-splitv' returns a vector of string positions that indicate where the substrings are located. - -- Function: string-edit RE EDIT-SPEC STRING [COUNT] | + -- Function: string-edit RE EDIT-SPEC STRING [COUNT] Returns the edited string. EDIT-SPEC @@ -4897,8 +4900,8 @@ description of regular expressions, *Note syntax: (regex)syntax. File: scm.info, Node: Line Editing, Next: Curses, Prev: Regular Expression Pattern Matching, Up: Packages -5.11 Line Editing | -================= | +5.11 Line Editing +================= These procedures provide input line editing and recall. @@ -4914,22 +4917,22 @@ When `Iedline.scm' is loaded, if the current input port is the default input port and the environment variable EMACS is not defined, line-editing mode will be entered. - -- Function: default-input-port | + -- Function: default-input-port Returns the initial `current-input-port' SCM was invoked with (stdin). - -- Function: default-output-port | + -- Function: default-output-port Returns the initial `current-output-port' SCM was invoked with (stdout). - -- Function: make-edited-line-port | + -- Function: make-edited-line-port Returns an input/output port that allows command line editing and retrieval of history. - -- Function: line-editing | + -- Function: line-editing Returns the current edited line port or `#f'. - -- Function: line-editing bool | + -- Function: line-editing bool If BOOL is false, exits line-editing mode and returns the previous value of `(line-editing)'. If BOOL is true, sets the current input and output ports to an edited line port and returns the @@ -4938,18 +4941,18 @@ line-editing mode will be entered. File: scm.info, Node: Curses, Next: Sockets, Prev: Line Editing, Up: Packages -5.12 Curses | -=========== | +5.12 Curses +=========== These functions are defined in `crs.c' using the "curses" library. Unless otherwise noted these routines return `#t' for successful completion and `#f' for failure. - -- Function: initscr | + -- Function: initscr Returns a port for a full screen window. This routine must be called to initialize curses. - -- Function: endwin | + -- Function: endwin A program should call `endwin' before exiting or escaping from curses mode temporarily, to do a system call, for example. This routine will restore termio modes, move the cursor to the lower @@ -4969,21 +4972,21 @@ completion and `#f' for failure. File: scm.info, Node: Output Options Setting, Next: Terminal Mode Setting, Prev: Curses, Up: Curses -5.12.1 Output Options Setting | ------------------------------ | +5.12.1 Output Options Setting +----------------------------- These routines set options within curses that deal with output. All options are initially `#f', unless otherwise stated. It is not necessary to turn these options off before calling `endwin'. - -- Function: clearok win bf | + -- Function: clearok win bf If enabled (BF is `#t'), the next call to `force-output' or `refresh' with WIN will clear the screen completely and redraw the entire screen from scratch. This is useful when the contents of the screen are uncertain, or in some cases for a more pleasing visual effect. - -- Function: idlok win bf | + -- Function: idlok win bf If enabled (BF is `#t'), curses will consider using the hardware "insert/delete-line" feature of terminals so equipped. If disabled (BF is `#f'), curses will very seldom use this feature. @@ -4997,7 +5000,7 @@ necessary to turn these options off before calling `endwin'. "insert/delete-line" cannot be used, curses will redraw the changed portions of all lines. - -- Function: leaveok win bf | + -- Function: leaveok win bf Normally, the hardware cursor is left at the location of the window cursor being refreshed. This option allows the cursor to be left wherever the update happens to leave it. It is useful for @@ -5005,7 +5008,7 @@ necessary to turn these options off before calling `endwin'. need for cursor motions. If possible, the cursor is made invisible when this option is enabled. - -- Function: scrollok win bf | + -- Function: scrollok win bf This option controls what happens when the cursor of window WIN is moved off the edge of the window or scrolling region, either from a newline on the bottom line, or typing the last character of the @@ -5015,10 +5018,10 @@ necessary to turn these options off before calling `endwin'. window WIN, and then the physical terminal and window WIN are scrolled up one line. - _Note_ in order to get the physical scrolling effect on the | + _Note_ in order to get the physical scrolling effect on the terminal, it is also necessary to call `idlok'. - -- Function: nodelay win bf | + -- Function: nodelay win bf This option causes wgetch to be a non-blocking call. If no input is ready, wgetch will return an eof-object. If disabled, wgetch will hang until a key is pressed. @@ -5026,16 +5029,16 @@ necessary to turn these options off before calling `endwin'. File: scm.info, Node: Terminal Mode Setting, Next: Window Manipulation, Prev: Output Options Setting, Up: Curses -5.12.2 Terminal Mode Setting | ----------------------------- | +5.12.2 Terminal Mode Setting +---------------------------- These routines set options within curses that deal with input. The options involve using ioctl(2) and therefore interact with curses routines. It is not necessary to turn these options off before calling `endwin'. The routines in this section all return an unspecified value. - -- Function: cbreak | - -- Function: nocbreak | + -- Function: cbreak + -- Function: nocbreak These two routines put the terminal into and out of `CBREAK' mode, respectively. In `CBREAK' mode, characters typed by the user are immediately available to the program and erase/kill character @@ -5047,11 +5050,11 @@ routines. It is not necessary to turn these options off before calling `cbreak' or `nocbreak' explicitly. Most interactive programs using curses will set `CBREAK' mode. - _Note_ `cbreak' overrides `raw'. For a discussion of how these | + _Note_ `cbreak' overrides `raw'. For a discussion of how these routines interact with `echo' and `noecho' *Note read-char: Input. - -- Function: raw | - -- Function: noraw | + -- Function: raw + -- Function: noraw The terminal is placed into or out of `RAW' mode. `RAW' mode is similar to `CBREAK' mode, in that characters typed are immediately passed through to the user program. The differences are that in @@ -5061,8 +5064,8 @@ routines. It is not necessary to turn these options off before calling behavior of the `BREAK' key depends on other bits in the terminal driver that are not set by curses. - -- Function: echo | - -- Function: noecho | + -- Function: echo + -- Function: noecho These routines control whether characters typed by the user are echoed by `read-char' as they are typed. Echoing by the tty driver is always disabled, but initially `read-char' is in `ECHO' @@ -5072,16 +5075,16 @@ routines. It is not necessary to turn these options off before calling calling `noecho'. For a discussion of how these routines interact with `echo' and `noecho' *Note read-char: Input. - -- Function: nl | - -- Function: nonl | + -- Function: nl + -- Function: nonl These routines control whether <LFD> is translated into <RET> and `LFD' on output, and whether <RET> is translated into <LFD> on input. Initially, the translations do occur. By disabling these translations using `nonl', curses is able to make better use of the linefeed capability, resulting in faster cursor motion. - -- Function: resetty | - -- Function: savetty | + -- Function: resetty + -- Function: savetty These routines save and restore the state of the terminal modes. `savetty' saves the current state of the terminal in a buffer and `resetty' restores the state to what it was at the last call to @@ -5090,17 +5093,17 @@ routines. It is not necessary to turn these options off before calling File: scm.info, Node: Window Manipulation, Next: Output, Prev: Terminal Mode Setting, Up: Curses -5.12.3 Window Manipulation | --------------------------- | +5.12.3 Window Manipulation +-------------------------- - -- Function: newwin nlines ncols begy begx | + -- Function: newwin nlines ncols begy begx Create and return a new window with the given number of lines (or rows), NLINES, and columns, NCOLS. The upper left corner of the window is at line BEGY, column BEGX. If either NLINES or NCOLS is 0, they will be set to the value of `LINES'-BEGY and `COLS'-BEGX. A new full-screen window is created by calling `newwin(0,0,0,0)'. - -- Function: subwin orig nlines ncols begy begx | + -- Function: subwin orig nlines ncols begy begx Create and return a pointer to a new window with the given number of lines (or rows), NLINES, and columns, NCOLS. The window is at position (BEGY, BEGX) on the screen. This position is relative to @@ -5110,13 +5113,13 @@ File: scm.info, Node: Window Manipulation, Next: Output, Prev: Terminal Mode necessary to call `touchwin' or `touchline' on ORIG before calling `force-output'. - -- Function: close-port win | + -- Function: close-port win Deletes the window WIN, freeing up all memory associated with it. In the case of sub-windows, they should be deleted before the main window WIN. - -- Function: refresh | - -- Function: force-output win | + -- Function: refresh + -- Function: force-output win These routines are called to write output to the terminal, as most other routines merely manipulate data structures. `force-output' copies the window WIN to the physical terminal screen, taking into @@ -5127,21 +5130,21 @@ File: scm.info, Node: Window Manipulation, Next: Output, Prev: Terminal Mode `refresh', the number of characters output to the terminal is returned. - -- Function: mvwin win y x | + -- Function: mvwin win y x Move the window WIN so that the upper left corner will be at position (Y, X). If the move would cause the window WIN to be off the screen, it is an error and the window WIN is not moved. - -- Function: overlay srcwin dstwin | - -- Function: overwrite srcwin dstwin | + -- Function: overlay srcwin dstwin + -- Function: overwrite srcwin dstwin These routines overlay SRCWIN on top of DSTWIN; that is, all text in SRCWIN is copied into DSTWIN. SRCWIN and DSTWIN need not be the same size; only text where the two windows overlap is copied. The difference is that `overlay' is non-destructive (blanks are not copied), while `overwrite' is destructive. - -- Function: touchwin win | - -- Function: touchline win start count | + -- Function: touchwin win + -- Function: touchline win start count Throw away all optimization information about which parts of the window WIN have been touched, by pretending that the entire window WIN has been drawn on. This is sometimes necessary when using @@ -5151,7 +5154,7 @@ File: scm.info, Node: Window Manipulation, Next: Output, Prev: Terminal Mode pretends that COUNT lines have been changed, beginning with line START. - -- Function: wmove win y x | + -- Function: wmove win y x The cursor associated with the window WIN is moved to line (row) Y, column X. This does not move the physical cursor of the terminal until `refresh' (or `force-output') is called. The position @@ -5161,15 +5164,15 @@ File: scm.info, Node: Window Manipulation, Next: Output, Prev: Terminal Mode File: scm.info, Node: Output, Next: Input, Prev: Window Manipulation, Up: Curses -5.12.4 Output | -------------- | +5.12.4 Output +------------- These routines are used to "draw" text on windows - -- Function: display ch win | - -- Function: display str win | - -- Function: wadd win ch | - -- Function: wadd win str | + -- Function: display ch win + -- Function: display str win + -- Function: wadd win ch + -- Function: wadd win str The character CH or characters in STR are put into the window WIN at the current cursor position of the window and the position of WIN's cursor is advanced. At the right margin, an automatic @@ -5192,51 +5195,51 @@ These routines are used to "draw" text on windows can be copied from one place to another using inch and display. See `standout', below. - _Note_ For `wadd' CH can be an integer and will insert the | + _Note_ For `wadd' CH can be an integer and will insert the character of the corresponding value. - -- Function: werase win | + -- Function: werase win This routine copies blanks to every position in the window WIN. - -- Function: wclear win | + -- Function: wclear win This routine is like `werase', but it also calls *Note clearok: Output Options Setting, arranging that the screen will be cleared completely on the next call to `refresh' or `force-output' for window WIN, and repainted from scratch. - -- Function: wclrtobot win | + -- Function: wclrtobot win All lines below the cursor in window WIN are erased. Also, the current line to the right of the cursor, inclusive, is erased. - -- Function: wclrtoeol win | + -- Function: wclrtoeol win The current line to the right of the cursor, inclusive, is erased. - -- Function: wdelch win | + -- Function: wdelch win The character under the cursor in the window WIN is deleted. All characters to the right on the same line are moved to the left one position and the last character on the line is filled with a blank. The cursor position does not change. This does not imply use of the hardware "delete-character" feature. - -- Function: wdeleteln win | + -- Function: wdeleteln win The line under the cursor in the window WIN is deleted. All lines below the current line are moved up one line. The bottom line WIN is cleared. The cursor position does not change. This does not imply use of the hardware "deleteline" feature. - -- Function: winsch win ch | + -- Function: winsch win ch The character CH is inserted before the character under the cursor. All characters to the right are moved one <SPC> to the right, possibly losing the rightmost character of the line. The cursor position does not change . This does not imply use of the hardware "insertcharacter" feature. - -- Function: winsertln win | + -- Function: winsertln win A blank line is inserted above the current line and the bottom line is lost. This does not imply use of the hardware "insert-line" feature. - -- Function: scroll win | + -- Function: scroll win The window WIN is scrolled up one line. This involves moving the lines in WIN's data structure. As an optimization, if WIN is stdscr and the scrolling region is the entire window, the physical @@ -5245,10 +5248,10 @@ These routines are used to "draw" text on windows File: scm.info, Node: Input, Next: Curses Miscellany, Prev: Output, Up: Curses -5.12.5 Input | ------------- | +5.12.5 Input +------------ - -- Function: read-char win | + -- Function: read-char win A character is read from the terminal associated with the window WIN. Depending on the setting of `cbreak', this will be after one character (`CBREAK' mode), or after the first newline (`NOCBREAK' @@ -5260,23 +5263,23 @@ File: scm.info, Node: Input, Next: Curses Miscellany, Prev: Output, Up: Curs on the state of the terminal driver when each character is typed, the program may produce undesirable results. - -- Function: winch win | + -- Function: winch win The character, of type chtype, at the current position in window WIN is returned. If any attributes are set for that position, their values will be OR'ed into the value returned. - -- Function: getyx win | + -- Function: getyx win A list of the y and x coordinates of the cursor position of the window WIN is returned File: scm.info, Node: Curses Miscellany, Prev: Input, Up: Curses -5.12.6 Curses Miscellany | ------------------------- | +5.12.6 Curses Miscellany +------------------------ - -- Function: wstandout win | - -- Function: wstandend win | + -- Function: wstandout win + -- Function: wstandend win These functions set the current attributes of the window WIN. The current attributes of WIN are applied to all characters that are written into it. Attributes are a property of the character, and @@ -5289,16 +5292,16 @@ File: scm.info, Node: Curses Miscellany, Prev: Input, Up: Curses visibly different from other text. `wstandend' turns off the attributes. - -- Function: box win vertch horch | + -- Function: box win vertch horch A box is drawn around the edge of the window WIN. VERTCH and HORCH are the characters the box is to be drawn with. If VERTCH and HORCH are 0, then appropriate default characters, `ACS_VLINE' and `ACS_HLINE', will be used. - _Note_ VERTCH and HORCH can be an integers and will insert the | + _Note_ VERTCH and HORCH can be an integers and will insert the character (with attributes) of the corresponding values. - -- Function: unctrl c | + -- Function: unctrl c This macro expands to a character string which is a printable representation of the character C. Control characters are displayed in the `C-x' notation. Printing characters are displayed @@ -5306,9 +5309,9 @@ File: scm.info, Node: Curses Miscellany, Prev: Input, Up: Curses File: scm.info, Node: Sockets, Next: SCMDB, Prev: Curses, Up: Packages - | -5.13 Sockets | -============ | + +5.13 Sockets +============ These procedures (defined in `socket.c') provide a Scheme interface to most of the C "socket" library. For more information on sockets, *Note @@ -5323,15 +5326,15 @@ Sockets: (libc)Sockets. File: scm.info, Node: Host and Other Inquiries, Next: Internet Addresses and Socket Names, Prev: Sockets, Up: Sockets -5.13.1 Host and Other Inquiries | -------------------------------- | +5.13.1 Host and Other Inquiries +------------------------------- - -- Constant: af_inet | - -- Constant: af_unix | + -- Constant: af_inet + -- Constant: af_unix Integer family codes for Internet and Unix sockets, respectively. - -- Function: gethost host-spec | - -- Function: gethost | + -- Function: gethost host-spec + -- Function: gethost Returns a vector of information for the entry for `HOST-SPEC' or the next entry if `HOST-SPEC' isn't given. The information is: @@ -5345,16 +5348,16 @@ File: scm.info, Node: Host and Other Inquiries, Next: Internet Addresses and S 4. list of integer addresses - -- Function: sethostent stay-open | - -- Function: sethostent | + -- Function: sethostent stay-open + -- Function: sethostent Rewinds the host entry table back to the begining if given an argument. If the argument STAY-OPEN is `#f' queries will be be done using `UDP' datagrams. Otherwise, a connected `TCP' socket will be used. When called without an argument, the host table is closed. - -- Function: getnet name-or-number | - -- Function: getnet | + -- Function: getnet name-or-number + -- Function: getnet Returns a vector of information for the entry for NAME-OR-NUMBER or the next entry if an argument isn't given. The information is: @@ -5366,15 +5369,15 @@ File: scm.info, Node: Host and Other Inquiries, Next: Internet Addresses and S 3. integer network number - -- Function: setnetent stay-open | - -- Function: setnetent | + -- Function: setnetent stay-open + -- Function: setnetent Rewinds the network entry table back to the begining if given an argument. If the argument STAY-OPEN is `#f' the table will be closed between calls to getnet. Otherwise, the table stays open. When called without an argument, the network table is closed. - -- Function: getproto name-or-number | - -- Function: getproto | + -- Function: getproto name-or-number + -- Function: getproto Returns a vector of information for the entry for NAME-OR-NUMBER or the next entry if an argument isn't given. The information is: @@ -5384,16 +5387,16 @@ File: scm.info, Node: Host and Other Inquiries, Next: Internet Addresses and S 3. integer protocol number - -- Function: setprotoent stay-open | - -- Function: setprotoent | + -- Function: setprotoent stay-open + -- Function: setprotoent Rewinds the protocol entry table back to the begining if given an argument. If the argument STAY-OPEN is `#f' the table will be closed between calls to getproto. Otherwise, the table stays open. When called without an argument, the protocol table is closed. - -- Function: getserv name-or-port-number protocol | - -- Function: getserv | + -- Function: getserv name-or-port-number protocol + -- Function: getserv Returns a vector of information for the entry for NAME-OR-PORT-NUMBER and PROTOCOL or the next entry if arguments aren't given. The information is: @@ -5406,8 +5409,8 @@ File: scm.info, Node: Host and Other Inquiries, Next: Internet Addresses and S 3. protocol - -- Function: setservent stay-open | - -- Function: setservent | + -- Function: setservent stay-open + -- Function: setservent Rewinds the service entry table back to the begining if given an argument. If the argument STAY-OPEN is `#f' the table will be closed between calls to getserv. Otherwise, the table stays open. @@ -5416,53 +5419,53 @@ File: scm.info, Node: Host and Other Inquiries, Next: Internet Addresses and S File: scm.info, Node: Internet Addresses and Socket Names, Next: Socket, Prev: Host and Other Inquiries, Up: Sockets -5.13.2 Internet Addresses and Socket Names | ------------------------------------------- | +5.13.2 Internet Addresses and Socket Names +------------------------------------------ - -- Function: inet:string->address string | + -- Function: inet:string->address string Returns the host address number (integer) for host STRING or `#f' if not found. - -- Function: inet:address->string address | + -- Function: inet:address->string address Converts an internet (integer) address to a string in numbers and dots notation. - -- Function: inet:network address | + -- Function: inet:network address Returns the network number (integer) specified from ADDRESS or `#f' if not found. - -- Function: inet:local-network-address address | + -- Function: inet:local-network-address address Returns the integer for the address of ADDRESS within its local network or `#f' if not found. - -- Function: inet:make-address network local-address | + -- Function: inet:make-address network local-address Returns the Internet address of LOCAL-ADDRESS in NETWORK. The type "socket-name" is used for inquiries about open sockets in the following procedures: - -- Function: getsockname socket | + -- Function: getsockname socket Returns the socket-name of SOCKET. Returns `#f' if unsuccessful or SOCKET is closed. - -- Function: getpeername socket | + -- Function: getpeername socket Returns the socket-name of the socket connected to SOCKET. Returns `#f' if unsuccessful or SOCKET is closed. - -- Function: socket-name:family socket-name | + -- Function: socket-name:family socket-name Returns the integer code for the family of SOCKET-NAME. - -- Function: socket-name:port-number socket-name | + -- Function: socket-name:port-number socket-name Returns the integer port number of SOCKET-NAME. - -- Function: socket-name:address socket-name | + -- Function: socket-name:address socket-name Returns the integer Internet address for SOCKET-NAME. File: scm.info, Node: Socket, Prev: Internet Addresses and Socket Names, Up: Sockets -5.13.3 Socket | -------------- | +5.13.3 Socket +------------- When a port is returned from one of these calls it is unbuffered. This allows both reading and writing to the same port to work. If you want @@ -5471,8 +5474,8 @@ buffered ports you can (assuming sock-port is a socket i/o port): (define i-port (duplicate-port sock-port "r")) (define o-port (duplicate-port sock-port "w")) - -- Function: make-stream-socket family | - -- Function: make-stream-socket family protocol | + -- Function: make-stream-socket family + -- Function: make-stream-socket family protocol Returns a `SOCK_STREAM' socket of type FAMILY using PROTOCOL. If FAMILY has the value `AF_INET', `SO_REUSEADDR' will be set. The integer argument PROTOCOL corresponds to the integer protocol @@ -5481,8 +5484,8 @@ buffered ports you can (assuming sock-port is a socket i/o port): specified FAMILY is used. SCM sockets look like ports opened for neither reading nor writing. - -- Function: make-stream-socketpair family | - -- Function: make-stream-socketpair family protocol | + -- Function: make-stream-socketpair family + -- Function: make-stream-socketpair family protocol Returns a pair (cons) of connected `SOCK_STREAM' (socket) ports of type FAMILY using PROTOCOL. Many systems support only socketpairs of the `af-unix' FAMILY. The integer argument PROTOCOL @@ -5490,7 +5493,7 @@ buffered ports you can (assuming sock-port is a socket i/o port): elements) from (getproto). If the PROTOCOL argument is not supplied, the default (0) for the specified FAMILY is used. - -- Function: socket:shutdown socket how | + -- Function: socket:shutdown socket how Makes SOCKET no longer respond to some or all operations depending on the integer argument HOW: @@ -5502,34 +5505,34 @@ buffered ports you can (assuming sock-port is a socket i/o port): `Socket:shutdown' returns SOCKET if successful, `#f' if not. - -- Function: socket:connect inet-socket host-number port-number | - -- Function: socket:connect unix-socket pathname | + -- Function: socket:connect inet-socket host-number port-number + -- Function: socket:connect unix-socket pathname Returns SOCKET (changed to a read/write port) connected to the Internet socket on host HOST-NUMBER, port PORT-NUMBER or the Unix socket specified by PATHNAME. Returns `#f' if not successful. - -- Function: socket:bind inet-socket port-number | - -- Function: socket:bind unix-socket pathname | + -- Function: socket:bind inet-socket port-number + -- Function: socket:bind unix-socket pathname Returns INET-SOCKET bound to the integer PORT-NUMBER or the UNIX-SOCKET bound to new socket in the file system at location PATHNAME. Returns `#f' if not successful. Binding a UNIX-SOCKET creates a socket in the file system that must be deleted by the caller when it is no longer needed (using `delete-file'). - -- Function: socket:listen socket backlog | + -- Function: socket:listen socket backlog The bound (*note bind: Socket.) SOCKET is readied to accept connections. The positive integer BACKLOG specifies how many pending connections will be allowed before further connection requests are refused. Returns SOCKET (changed to a read-only port) if successful, `#f' if not. - -- Function: char-ready? listen-socket | + -- Function: char-ready? listen-socket The input port returned by a successful call to `socket:listen' can be polled for connections by `char-ready?' (*note char-ready?: Files and Ports.). This avoids blocking on connections by `socket:accept'. - -- Function: socket:accept socket | + -- Function: socket:accept socket Accepts a connection on a bound, listening SOCKET. Returns an input/output port for the connection. @@ -5619,21 +5622,21 @@ you can use a client written in scheme: File: scm.info, Node: SCMDB, Prev: Sockets, Up: Packages - | -5.14 SCMDB | -========== | - | -`(require 'mysql)' | - | -"SCMDB" is an add-on for SCM that ports the MySQL C-library to SCM. | - | -It is available from: `http://www.dedecker.net/jessie/scmdb/' | - | + +5.14 SCMDB +========== + +`(require 'mysql)' + +"SCMDB" is an add-on for SCM that ports the MySQL C-library to SCM. + +It is available from: `http://www.dedecker.net/jessie/scmdb/' + File: scm.info, Node: The Implementation, Next: Index, Prev: Packages, Up: Top - | -6 The Implementation | -******************** | + +6 The Implementation +******************** * Menu: @@ -5645,8 +5648,8 @@ File: scm.info, Node: The Implementation, Next: Index, Prev: Packages, Up: T File: scm.info, Node: Data Types, Next: Operations, Prev: The Implementation, Up: The Implementation -6.1 Data Types | -============== | +6.1 Data Types +============== In the descriptions below it is assumed that `long int's are 32 bits in length. Acutally, SCM is written to work with any `long int' size @@ -5669,35 +5672,35 @@ basic flavors, Immediates and Cells: File: scm.info, Node: Immediates, Next: Cells, Prev: Data Types, Up: Data Types -6.1.1 Immediates | ----------------- | +6.1.1 Immediates +---------------- An "immediate" is a data type contained in type `SCM' (`long int'). The type codes distinguishing immediate types from each other vary in length, but reside in the low order bits. - -- Macro: IMP x | - -- Macro: NIMP x | + -- Macro: IMP x + -- Macro: NIMP x Return non-zero if the `SCM' object X is an immediate or non-immediate type, respectively. - -- Immediate: inum | + -- Immediate: inum immediate 30 bit signed integer. An INUM is flagged by a `1' in the second to low order bit position. The high order 30 bits are used for the integer's value. - -- Macro: INUMP x | - -- Macro: NINUMP x | + -- Macro: INUMP x + -- Macro: NINUMP x Return non-zero if the `SCM' X is an immediate integer or not an immediate integer, respectively. - -- Macro: INUM x | + -- Macro: INUM x Returns the C `long integer' corresponding to `SCM' X. - -- Macro: MAKINUM x | + -- Macro: MAKINUM x Returns the `SCM' inum corresponding to C `long integer' x. - -- Immediate Constant: INUM0 | + -- Immediate Constant: INUM0 is equivalent to `MAKINUM(0)'. Computations on INUMs are performed by converting the arguments to @@ -5710,91 +5713,91 @@ length, but reside in the low order bits. detected in a #if statement in `scmfig.h' and a signed right shift, `SRS', is constructed in terms of unsigned right shift. - -- Immediate: ichr | + -- Immediate: ichr characters. - -- Macro: ICHRP x | + -- Macro: ICHRP x Return non-zero if the `SCM' object X is a character. - -- Macro: ICHR x | + -- Macro: ICHR x Returns corresponding `unsigned char'. - -- Macro: MAKICHR x | + -- Macro: MAKICHR x Given `char' X, returns `SCM' character. - -- Immediate: iflags | + -- Immediate: iflags These are frequently used immediate constants. - -- Immediate Constant: SCM BOOL_T | + -- Immediate Constant: SCM BOOL_T `#t' - -- Immediate Constant: SCM BOOL_F | + -- Immediate Constant: SCM BOOL_F `#f' - -- Immediate Constant: SCM EOL | + -- Immediate Constant: SCM EOL `()'. If `SICP' is `#define'd, `EOL' is `#define'd to be identical with `BOOL_F'. In this case, both print as `#f'. - -- Immediate Constant: SCM EOF_VAL | + -- Immediate Constant: SCM EOF_VAL end of file token, `#<eof>'. - -- Immediate Constant: SCM UNDEFINED | + -- Immediate Constant: SCM UNDEFINED `#<undefined>' used for variables which have not been defined and absent optional arguments. - -- Immediate Constant: SCM UNSPECIFIED | + -- Immediate Constant: SCM UNSPECIFIED `#<unspecified>' is returned for those procedures whose return values are not specified. - -- Macro: IFLAGP n | + -- Macro: IFLAGP n Returns non-zero if N is an ispcsym, isym or iflag. - -- Macro: ISYMP n | + -- Macro: ISYMP n Returns non-zero if N is an ispcsym or isym. - -- Macro: ISYMNUM n | + -- Macro: ISYMNUM n Given ispcsym, isym, or iflag N, returns its index in the C array `isymnames[]'. - -- Macro: ISYMCHARS n | + -- Macro: ISYMCHARS n Given ispcsym, isym, or iflag N, returns its `char *' representation (from `isymnames[]'). - -- Macro: MAKSPCSYM n | + -- Macro: MAKSPCSYM n Returns `SCM' ispcsym N. - -- Macro: MAKISYM n | + -- Macro: MAKISYM n Returns `SCM' iisym N. - -- Macro: MAKIFLAG n | + -- Macro: MAKIFLAG n Returns `SCM' iflag N. - -- Variable: isymnames | + -- Variable: isymnames An array of strings containing the external representations of all the ispcsym, isym, and iflag immediates. Defined in `repl.c'. - -- Constant: NUM_ISPCSYM | - -- Constant: NUM_ISYMS | + -- Constant: NUM_ISPCSYM + -- Constant: NUM_ISYMS The number of ispcsyms and ispcsyms+isyms, respectively. Defined in `scm.h'. - -- Immediate: isym | + -- Immediate: isym `and', `begin', `case', `cond', `define', `do', `if', `lambda', `let', `let*', `letrec', `or', `quote', `set!', `#f', `#t', `#<undefined>', `#<eof>', `()', and `#<unspecified>'. - -- CAR Immediate: ispcsym | + -- CAR Immediate: ispcsym special symbols: syntax-checked versions of first 14 isyms - -- CAR Immediate: iloc | + -- CAR Immediate: iloc indexes to a variable's location in environment - -- CAR Immediate: gloc | + -- CAR Immediate: gloc pointer to a symbol's value cell - -- Immediate: CELLPTR | + -- Immediate: CELLPTR pointer to a cell (not really an immediate type, but here for completeness). Since cells are always 8 byte aligned, a pointer to a cell has the low order 3 bits `0'. @@ -5808,8 +5811,8 @@ A "CAR Immediate" is an Immediate point which can only occur in the File: scm.info, Node: Cells, Next: Header Cells, Prev: Immediates, Up: Data Types -6.1.2 Cells | ------------ | +6.1.2 Cells +----------- "Cell"s represent all SCM objects other than immediates. A cell has a `CAR' and a `CDR'. Low-order bits in `CAR' identify the type of @@ -5817,7 +5820,7 @@ object. The rest of `CAR' and `CDR' hold object data. The number after `tc' specifies how many bits are in the type code. For instance, `tc7' indicates that the type code is 7 bits. - -- Macro: NEWCELL x | + -- Macro: NEWCELL x Allocates a new cell and stores a pointer to it in `SCM' local variable X. @@ -5827,23 +5830,23 @@ after `tc' specifies how many bits are in the type code. For instance, All of the C macros decribed in this section assume that their argument is of type `SCM' and points to a cell (`CELLPTR'). - -- Macro: CAR x | - -- Macro: CDR x | + -- Macro: CAR x + -- Macro: CDR x Returns the `car' and `cdr' of cell X, respectively. - -- Macro: TYP3 x | - -- Macro: TYP7 x | - -- Macro: TYP16 x | + -- Macro: TYP3 x + -- Macro: TYP7 x + -- Macro: TYP16 x Returns the 3, 7, and 16 bit type code of a cell. - -- Cell: tc3_cons | + -- Cell: tc3_cons scheme cons-cell returned by (cons arg1 arg2). - -- Macro: CONSP x | - -- Macro: NCONSP x | + -- Macro: CONSP x + -- Macro: NCONSP x Returns non-zero if X is a `tc3_cons' or isn't, respectively. - -- Cell: tc3_closure | + -- Cell: tc3_closure applicable object returned by (lambda (args) ...). `tc3_closure's have a pointer to the body of the procedure in the `CAR' and a pointer to the environment in the `CDR'. Bits 1 and 2 @@ -5853,15 +5856,15 @@ is of type `SCM' and points to a cell (`CELLPTR'). encoding precludes an immediate value for the `CDR': In the case of an empty environment all bits above 2 in the `CDR' are zero. - -- Macro: CLOSUREP x | + -- Macro: CLOSUREP x Returns non-zero if X is a `tc3_closure'. - -- Macro: CODE x | - -- Macro: ENV x | + -- Macro: CODE x + -- Macro: ENV x Returns the code body or environment of closure X, respectively. - -- Macro: ARGC x | + -- Macro: ARGC x Returns the a lower bound on the number of required arguments to closure X, it cannot exceed 3. @@ -5869,82 +5872,82 @@ is of type `SCM' and points to a cell (`CELLPTR'). File: scm.info, Node: Header Cells, Next: Subr Cells, Prev: Cells, Up: Data Types -6.1.3 Header Cells | ------------------- | +6.1.3 Header Cells +------------------ "Header"s are Cells whose `CDR's point elsewhere in memory, such as to memory allocated by `malloc'. - -- Header: spare | + -- Header: spare spare `tc7' type code - -- Header: tc7_vector | + -- Header: tc7_vector scheme vector. - -- Macro: VECTORP x | - -- Macro: NVECTORP x | + -- Macro: VECTORP x + -- Macro: NVECTORP x Returns non-zero if X is a `tc7_vector' or if not, respectively. - -- Macro: VELTS x | - -- Macro: LENGTH x | + -- Macro: VELTS x + -- Macro: LENGTH x Returns the C array of `SCM's holding the elements of vector X or its length, respectively. - -- Header: tc7_ssymbol | + -- Header: tc7_ssymbol static scheme symbol (part of initial system) - -- Header: tc7_msymbol | + -- Header: tc7_msymbol `malloc'ed scheme symbol (can be GCed) - -- Macro: SYMBOLP x | + -- Macro: SYMBOLP x Returns non-zero if X is a `tc7_ssymbol' or `tc7_msymbol'. - -- Macro: CHARS x | - -- Macro: UCHARS x | - -- Macro: LENGTH x | + -- Macro: CHARS x + -- Macro: UCHARS x + -- Macro: LENGTH x Returns the C array of `char's or as `unsigned char's holding the elements of symbol X or its length, respectively. - -- Header: tc7_string | + -- Header: tc7_string scheme string - -- Macro: STRINGP x | - -- Macro: NSTRINGP x | + -- Macro: STRINGP x + -- Macro: NSTRINGP x Returns non-zero if X is a `tc7_string' or isn't, respectively. - -- Macro: CHARS x | - -- Macro: UCHARS x | - -- Macro: LENGTH x | + -- Macro: CHARS x + -- Macro: UCHARS x + -- Macro: LENGTH x 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_bvect uniform vector of booleans (bit-vector) - -- Header: tc7_ivect | + -- Header: tc7_ivect uniform vector of integers - -- Header: tc7_uvect | + -- Header: tc7_uvect uniform vector of non-negative integers - -- Header: tc7_svect | + -- Header: tc7_svect uniform vector of short integers - -- Header: tc7_fvect | + -- Header: tc7_fvect uniform vector of short inexact real numbers - -- Header: tc7_dvect | + -- Header: tc7_dvect uniform vector of double precision inexact real numbers - -- Header: tc7_cvect | + -- Header: tc7_cvect uniform vector of double precision inexact complex numbers - -- Header: tc7_contin | + -- Header: tc7_contin applicable object produced by call-with-current-continuation - -- Header: tc7_specfun | + -- Header: tc7_specfun subr that is treated specially within the evaluator `apply' and `call-with-current-continuation' are denoted by these @@ -5961,36 +5964,36 @@ memory allocated by `malloc'. invocation is currently not tail recursive when given 2 or more arguments. - -- Function: makcclo proc len | + -- Function: makcclo proc len makes a closure from the _subr_ PROC with LEN-1 extra locations for `SCM' data. Elements of a CCLO are referenced using `VELTS(cclo)[n]' just as for vectors. - -- Macro: CCLO_LENGTH cclo | + -- Macro: CCLO_LENGTH cclo Expands to the length of CCLO. File: scm.info, Node: Subr Cells, Next: Ptob Cells, Prev: Header Cells, Up: Data Types -6.1.4 Subr Cells | ----------------- | +6.1.4 Subr Cells +---------------- A "Subr" is a header whose `CDR' points to a C code procedure. Scheme primitive procedures are subrs. Except for the arithmetic `tc7_cxr's, the C code procedures will be passed arguments (and return results) of type `SCM'. - -- Subr: tc7_asubr | + -- Subr: tc7_asubr associative C function of 2 arguments. Examples are `+', `-', `*', `/', `max', and `min'. - -- Subr: tc7_subr_0 | + -- Subr: tc7_subr_0 C function of no arguments. - -- Subr: tc7_subr_1 | + -- Subr: tc7_subr_1 C function of one argument. - -- Subr: tc7_cxr | + -- Subr: tc7_cxr These subrs are handled specially. If inexact numbers are enabled, the `CDR' should be a function which takes and returns type `double'. Conversions are handled in the interpreter. @@ -6009,107 +6012,107 @@ type `SCM'. `cadddr', `cdaaar', `cdaadr', `cdadar', `cdaddr', `cddaar', `cddadr', `cdddar', and `cddddr' are defined this way. - -- Subr: tc7_subr_3 | + -- Subr: tc7_subr_3 C function of 3 arguments. - -- Subr: tc7_subr_2 | + -- Subr: tc7_subr_2 C function of 2 arguments. - -- Subr: tc7_rpsubr | + -- Subr: tc7_rpsubr transitive relational predicate C function of 2 arguments. The C function should return either `BOOL_T' or `BOOL_F'. - -- Subr: tc7_subr_1o | + -- Subr: tc7_subr_1o C function of one optional argument. If the optional argument is not present, `UNDEFINED' is passed in its place. - -- Subr: tc7_subr_2o | + -- Subr: tc7_subr_2o C function of 1 required and 1 optional argument. If the optional argument is not present, `UNDEFINED' is passed in its place. - -- Subr: tc7_lsubr_2 | + -- Subr: tc7_lsubr_2 C function of 2 arguments and a list of (rest of) `SCM' arguments. - -- Subr: tc7_lsubr | + -- Subr: tc7_lsubr C function of list of `SCM' arguments. File: scm.info, Node: Ptob Cells, Next: Smob Cells, Prev: Subr Cells, Up: Data Types -6.1.5 Ptob Cells | ----------------- | +6.1.5 Ptob Cells +---------------- -A "ptob" is a port object, capable of delivering or accepting characters. | -*Note Ports: (r5rs)Ports. Unlike the types described so far, new | -varieties of ptobs can be defined dynamically (*note Defining Ptobs::). | -These are the initial ptobs: | +A "ptob" is a port object, capable of delivering or accepting characters. +*Note Ports: (r5rs)Ports. Unlike the types described so far, new +varieties of ptobs can be defined dynamically (*note Defining Ptobs::). +These are the initial ptobs: - -- ptob: tc16_inport | + -- ptob: tc16_inport input port. - -- ptob: tc16_outport | + -- ptob: tc16_outport output port. - -- ptob: tc16_ioport | + -- ptob: tc16_ioport input-output port. - -- ptob: tc16_inpipe | + -- ptob: tc16_inpipe input pipe created by `popen()'. - -- ptob: tc16_outpipe | + -- ptob: tc16_outpipe output pipe created by `popen()'. - -- ptob: tc16_strport | + -- ptob: tc16_strport String port created by `cwos()' or `cwis()'. - -- ptob: tc16_sfport | + -- ptob: tc16_sfport Software (virtual) port created by `mksfpt()' (*note Soft Ports::). - -- Macro: PORTP x | - -- Macro: OPPORTP x | - -- Macro: OPINPORTP x | - -- Macro: OPOUTPORTP x | - -- Macro: INPORTP x | - -- Macro: OUTPORTP x | + -- Macro: PORTP x + -- Macro: OPPORTP x + -- Macro: OPINPORTP x + -- Macro: OPOUTPORTP x + -- Macro: INPORTP x + -- Macro: OUTPORTP x Returns non-zero if X is a port, open port, open input-port, open output-port, input-port, or output-port, respectively. - -- Macro: OPENP x | - -- Macro: CLOSEDP x | + -- Macro: OPENP x + -- Macro: CLOSEDP x Returns non-zero if port X is open or closed, respectively. - -- Macro: STREAM x | + -- Macro: STREAM x Returns the `FILE *' stream for port X. Ports which are particularly well behaved are called "fport"s. Advanced operations like `file-position' and `reopen-file' only work for fports. - -- Macro: FPORTP x | - -- Macro: OPFPORTP x | - -- Macro: OPINFPORTP x | - -- Macro: OPOUTFPORTP x | + -- Macro: FPORTP x + -- Macro: OPFPORTP x + -- Macro: OPINFPORTP x + -- Macro: OPOUTFPORTP x Returns non-zero if X is a port, open port, open input-port, or open output-port, respectively. File: scm.info, Node: Smob Cells, Next: Data Type Representations, Prev: Ptob Cells, Up: Data Types -6.1.6 Smob Cells | ----------------- | +6.1.6 Smob Cells +---------------- -A "smob" is a miscellaneous datatype. The type code and GCMARK bit occupy | -the lower order 16 bits of the `CAR' half of the cell. The rest of the | -`CAR' can be used for sub-type or other information. The `CDR' | +A "smob" is a miscellaneous datatype. The type code and GCMARK bit occupy +the lower order 16 bits of the `CAR' half of the cell. The rest of the +`CAR' can be used for sub-type or other information. The `CDR' contains data of size long and is often a pointer to allocated memory. Like ptobs, new varieties of smobs can be defined dynamically (*note Defining Smobs::). These are the initial smobs: - -- smob: tc_free_cell | + -- smob: tc_free_cell unused cell on the freelist. - -- smob: tc16_flo | + -- smob: tc16_flo single-precision float. Inexact number data types are subtypes of type `tc16_flo'. If the @@ -6121,14 +6124,14 @@ Defining Smobs::). These are the initial smobs: 3. `CDR' is a pointer to a `malloc'ed pair of doubles. - -- smob: tc_dblr | + -- smob: tc_dblr double-precision float. - -- smob: tc_dblc | + -- smob: tc_dblc double-precision complex. - -- smob: tc16_bigpos | - -- smob: tc16_bigneg | + -- smob: tc16_bigpos + -- smob: tc16_bigneg positive and negative bignums, respectively. Scm has large precision integers called bignums. They are stored @@ -6158,18 +6161,18 @@ Defining Smobs::). These are the initial smobs: should obtain a package which specializes in number-theoretical calculations: - `ftp://megrez.math.u-bordeaux.fr/pub/pari/' | + `ftp://megrez.math.u-bordeaux.fr/pub/pari/' - -- smob: tc16_promise | + -- smob: tc16_promise made by DELAY. *Note Control features: (r5rs)Control features. - -- smob: tc16_arbiter | + -- smob: tc16_arbiter synchronization object. *Note Process Synchronization::. - -- smob: tc16_macro | + -- smob: tc16_macro macro expanding function. *Note Macro Primitives::. - -- smob: tc16_array | + -- smob: tc16_array multi-dimensional array. *Note Arrays::. This type implements both conventional arrays (those with @@ -6184,8 +6187,8 @@ Defining Smobs::). These are the initial smobs: File: scm.info, Node: Data Type Representations, Prev: Smob Cells, Up: Data Types -6.1.7 Data Type Representations | -------------------------------- | +6.1.7 Data Type Representations +------------------------------- IMMEDIATE: B,D,E,F=data bit, C=flag code, P=pointer address bit ................................ @@ -6201,7 +6204,7 @@ gloc PPPPPPPPPPPPPPPPPPPPPPPPPPPPP001 HEAP CELL: G=gc_mark; 1 during mark, 0 other times. 1s and 0s here indicate type. G missing means sys (not GC'd) - SIMPLE | + SIMPLE cons ..........SCM car..............0 ...........SCM cdr.............G closure ..........SCM code...........011 ...........SCM env...........CCG HEADERs: @@ -6222,17 +6225,17 @@ cvect .........long length....G0110101 ........double *words........... contin .........long length....G0111101 .............*regs.............. specfun ................xxxxxxxxG1111111 ...........SCM name............. cclo ..short length..xxxxxx10G1111111 ...........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 | + 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 subr_0 ..........int hpoff.....01010101 ...........SCM (*f)()........... @@ -6246,7 +6249,7 @@ subr_2o ..........int hpoff.....01101111 ...........SCM (*f)()........... lsubr_2 ..........int hpoff.....01110101 ...........SCM (*f)()........... lsubr ..........int hpoff.....01110111 ...........SCM (*f)()........... rpsubr ..........int hpoff.....01111101 ...........SCM (*f)()........... - SMOBs | + SMOBs free_cell 000000000000000000000000G1111111 ...........*free_cell........000 flo 000000000000000000000001G1111111 ...........float num............ @@ -6264,8 +6267,8 @@ array ...short rank..cxxxxxxxxG1111111 ............*array.............. File: scm.info, Node: Operations, Next: Program Self-Knowledge, Prev: Data Types, Up: The Implementation -6.2 Operations | -============== | +6.2 Operations +============== * Menu: @@ -6287,8 +6290,8 @@ File: scm.info, Node: Operations, Next: Program Self-Knowledge, Prev: Data Ty File: scm.info, Node: Garbage Collection, Next: Memory Management for Environments, Prev: Operations, Up: Operations -6.2.1 Garbage Collection | ------------------------- | +6.2.1 Garbage Collection +------------------------ The garbage collector is in the latter half of `sys.c'. The primary goal of "garbage collection" (or "GC") is to recycle those cells no @@ -6307,8 +6310,8 @@ heap. File: scm.info, Node: Marking Cells, Next: Sweeping the Heap, Prev: Garbage Collection, Up: Garbage Collection -6.2.1.1 Marking Cells | -..................... | +6.2.1.1 Marking Cells +..................... The first step in garbage collection is to "mark" all heap objects in use. Each heap cell has a bit reserved for this purpose. For pairs @@ -6318,11 +6321,11 @@ during garbage collection. Special C macros are defined in `scm.h' to allow easy manipulation when GC bits are possibly set. `CAR', `TYP3', and `TYP7' can be used on GC marked cells as they are. - -- Macro: GCCDR x | + -- Macro: GCCDR x Returns the CDR of a cons cell, even if that cell has been GC marked. - -- Macro: GCTYP16 x | + -- Macro: GCTYP16 x Returns the 16 bit type code of a cell. We need to (recursively) mark only a few objects in order to assure that @@ -6330,13 +6333,13 @@ all accessible objects are marked. Those objects are `sys_protects[]' (for example, `dynwinds'), the current C-stack and the hash table for symbols, "symhash". - -- Function: void gc_mark (SCM OBJ) | + -- Function: void gc_mark (SCM OBJ) The function `gc_mark()' is used for marking SCM cells. If OBJ is marked, `gc_mark()' returns. If OBJ is unmarked, gc_mark sets the 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 @@ -6353,8 +6356,8 @@ symbols, "symhash". File: scm.info, Node: Sweeping the Heap, Prev: Marking Cells, Up: Garbage Collection -6.2.1.2 Sweeping the Heap | -......................... | +6.2.1.2 Sweeping the Heap +......................... After all found objects have been marked, the heap is swept. @@ -6364,7 +6367,7 @@ object from its type-header cell in the heap. This allows malloc objects to be freed when the associated heap object is garbage collected. - -- Function: static void gc_sweep () | + -- Function: static void gc_sweep () The function `gc_sweep' scans through all heap segments. The mark bit is cleared from marked cells. Unmarked cells are spliced into FREELIST, where they can again be returned by invocations of @@ -6377,8 +6380,8 @@ collected. File: scm.info, Node: Memory Management for Environments, Next: Signals, Prev: Garbage Collection, Up: Operations -6.2.2 Memory Management for Environments | ----------------------------------------- | +6.2.2 Memory Management for Environments +---------------------------------------- * "Ecache" was designed and implemented by Radey Shouman. @@ -6477,17 +6480,17 @@ literature is available. File: scm.info, Node: Signals, Next: C Macros, Prev: Memory Management for Environments, Up: Operations -6.2.3 Signals | -------------- | +6.2.3 Signals +------------- - -- Function: init_signals | + -- Function: init_signals (in `scm.c') initializes handlers for `SIGINT' and `SIGALRM' if they are supported by the C implementation. All of the signal handlers immediately reestablish themselves by a call to `signal()'. - -- Function: int_signal sig | - -- Function: alrm_signal sig | + -- Function: int_signal sig + -- Function: alrm_signal sig The low level handlers for `SIGINT' and `SIGALRM'. If an interrupt handler is defined when the interrupt is received, the @@ -6499,14 +6502,14 @@ SCM does not use any signal masking system calls. These are not a portable feature. However, code can run uninterrupted by use of the C macros `DEFER_INTS' and `ALLOW_INTS'. - -- Macro: DEFER_INTS | + -- Macro: DEFER_INTS sets the global variable `ints_disabled' to 1. If an interrupt occurs during a time when `ints_disabled' is 1, then `deferred_proc' is set to non-zero, one of the global variables `SIGINT_deferred' or `SIGALRM_deferred' is set to 1, and the handler returns. - -- Macro: ALLOW_INTS | + -- Macro: ALLOW_INTS Checks the deferred variables and if set the appropriate handler is called. @@ -6518,10 +6521,10 @@ macros `DEFER_INTS' and `ALLOW_INTS'. File: scm.info, Node: C Macros, Next: Changing Scm, Prev: Signals, Up: Operations -6.2.4 C Macros | --------------- | +6.2.4 C Macros +-------------- - -- Macro: ASRTER cond arg pos subr | + -- Macro: ASRTER cond arg pos subr signals an error if the expression (COND) is 0. ARG is the offending object, SUBR is the string naming the subr, and POS indicates the position or type of error. POS can be one of @@ -6566,15 +6569,15 @@ File: scm.info, Node: C Macros, Next: Changing Scm, Prev: Signals, Up: Opera defined. An error condition can still be signaled in this case with a call to `wta(arg, pos, subr)'. - -- Macro: ASRTGO cond label | + -- Macro: ASRTGO cond label `goto' LABEL if the expression (COND) is 0. Like `ASRTER', `ASRTGO' does is not active if the flag `RECKLESS' is defined. File: scm.info, Node: Changing Scm, Next: Defining Subrs, Prev: C Macros, Up: Operations -6.2.5 Changing Scm | ------------------- | +6.2.5 Changing Scm +------------------ When writing C-code for SCM, a precaution is recommended. If your routine allocates a non-cons cell which will _not_ be incorporated into @@ -6595,7 +6598,7 @@ or put this assignment somewhere in your routine: of the local `SCM' variable to _any_ procedure also protects it. The procedure `scm_protect_temp' is provided for this purpose. - -- Function: void scm_protect_temp (SCM *PTR) | + -- Function: void scm_protect_temp (SCM *PTR) Forces the SCM object PTR to be saved on the C-stack, where it will be traced for GC. @@ -6604,7 +6607,7 @@ object, you must either make your pointer be the value cell of a symbol (see `errobj' for an example) or (permanently) add your pointer to `sys_protects' using: - -- Function: SCM scm_gc_protect (SCM OBJ) | + -- Function: SCM scm_gc_protect (SCM OBJ) Permanently adds OBJ to a table of objects protected from garbage collection. `scm_gc_protect' returns OBJ. @@ -6666,7 +6669,7 @@ To add a package of new procedures to scm (see `crs.c' for example): 7. put any scheme code which needs to be run as part of your package into `Ifoo.scm'. - 8. put an `if' into `Init5e1.scm' which loads `Ifoo.scm' if your | + 8. put an `if' into `Init5e2.scm' which loads `Ifoo.scm' if your | package is included: (if (defined? twiddle-bits!) @@ -6694,7 +6697,7 @@ Special forms (new syntax) can be added to scm. 2. add a string with the new name in the corresponding place in `isymnames' in `repl.c'. - 3. add `case' clause to `ceval()' near `i_quasiquote' (in `eval.c'). | + 3. add `case' clause to `ceval()' near `i_quasiquote' (in `eval.c'). New syntax can now be added without recompiling SCM by the use of the `procedure->syntax', `procedure->macro', `procedure->memoizing-macro', @@ -6703,8 +6706,8 @@ and `defmacro'. For details, *Note Syntax::. File: scm.info, Node: Defining Subrs, Next: Defining Smobs, Prev: Changing Scm, Up: Operations -6.2.6 Defining Subrs | --------------------- | +6.2.6 Defining Subrs +-------------------- If "CCLO" is `#define'd when compiling, the compiled closure feature will be enabled. It is automatically enabled if dynamic linking is @@ -6714,7 +6717,7 @@ The SCM interpreter directly recognizes subrs taking small numbers of arguments. In order to create subrs taking larger numbers of arguments use: - -- Function: make_gsubr name req opt rest fcn | + -- Function: make_gsubr name req opt rest fcn returns a cclo (compiled closure) object of name `char *' NAME which takes `int' REQ required arguments, `int' OPT optional arguments, and a list of rest arguments if `int' REST is 1 (0 for @@ -6757,8 +6760,8 @@ use: File: scm.info, Node: Defining Smobs, Next: Defining Ptobs, Prev: Defining Subrs, Up: Operations -6.2.7 Defining Smobs | --------------------- | +6.2.7 Defining Smobs +-------------------- Here is an example of how to add a new type named `foo' to SCM. The following lines need to be added to your code: @@ -6781,9 +6784,9 @@ following lines need to be added to your code: mark) and returns type `SCM' which will then be marked. If no further objects need to be marked then return an immediate object such as `BOOL_F'. The smob cell itself will already - have been marked. _Note_ This is different from SCM versions | - prior to 5c5. Only additional data specific to a smob type | - need be marked by `smob.mark'. | + have been marked. _Note_ This is different from SCM versions + prior to 5c5. Only additional data specific to a smob type + need be marked by `smob.mark'. 2 functions are provided: @@ -6831,8 +6834,8 @@ than `malloc' *Note Allocating memory::. File: scm.info, Node: Defining Ptobs, Next: Allocating memory, Prev: Defining Smobs, Up: Operations -6.2.8 Defining Ptobs | --------------------- | +6.2.8 Defining Ptobs +-------------------- "ptob"s are similar to smobs but define new types of port to which SCM procedures can read or write. The following functions are defined in @@ -6862,8 +6865,8 @@ memory::. File: scm.info, Node: Allocating memory, Next: Embedding SCM, Prev: Defining Ptobs, Up: Operations -6.2.9 Allocating memory | ------------------------ | +6.2.9 Allocating memory +----------------------- SCM maintains a count of bytes allocated using malloc, and calls the garbage collector when that number exceeds a dynamically managed limit. @@ -6871,17 +6874,17 @@ In order for this to work properly, `malloc' and `free' should not be called directly to manage memory freeable by garbage collection. The following functions are provided for that purpose: - -- Function: SCM must_malloc_cell (long LEN, SCM C, char *WHAT) | - -- Function: char * must_malloc (long LEN, char *WHAT) | + -- Function: SCM must_malloc_cell (long LEN, SCM C, char *WHAT) + -- Function: char * must_malloc (long LEN, char *WHAT) LEN is the number of bytes that should be allocated, WHAT is a string to be used in error or gc messages. `must_malloc' returns a pointer to newly allocated memory. `must_malloc_cell' returns a newly allocated cell whose `car' is C and whose `cdr' is a pointer to newly allocated memory. - -- Function: void must_realloc_cell (SCM Z, long OLEN, long LEN, char | + -- Function: void must_realloc_cell (SCM Z, long OLEN, long LEN, char *WHAT) - -- Function: char * must_realloc (char *WHERE, long OLEN, long LEN, | + -- Function: char * must_realloc (char *WHERE, long OLEN, long LEN, char *WHAT) `must_realloc_cell' takes as argument Z a cell whose `cdr' should be a pointer to a block of memory of length OLEN allocated with @@ -6901,7 +6904,7 @@ Signals::. `must_realloc' and `must_realloc_cell' must not be called during initialization (non-zero errjmp_bad) - the initial allocations must be large enough. - -- Function: void must_free (char *PTR, sizet LEN) | + -- Function: void must_free (char *PTR, sizet LEN) `must_free' is used to free a block of memory allocated by the above functions and pointed to by PTR. LEN is the length of the block in bytes, but this value is used only for debugging purposes. @@ -6911,22 +6914,22 @@ must be large enough. File: scm.info, Node: Embedding SCM, Next: Callbacks, Prev: Allocating memory, Up: Operations -6.2.10 Embedding SCM | --------------------- | +6.2.10 Embedding SCM +-------------------- The file `scmmain.c' contains the definition of main(). When SCM is compiled as a library `scmmain.c' is not included in the library; a copy of `scmmain.c' can be modified to use SCM as an embedded library module. - -- Function: int main (int ARGC, char **ARGV) | + -- Function: int main (int ARGC, char **ARGV) This is the top level C routine. The value of the ARGC argument is the number of command line arguments. The ARGV argument is a vector of C strings; its elements are the individual command line argument strings. A null pointer always follows the last element: `ARGV[ARGC]' is this null pointer. - -- Variable: char *execpath | + -- Variable: char *execpath This string is the pathname of the executable file being run. This variable can be examined and set from Scheme (*note Internal State::). EXECPATH must be set to executable's path in order to @@ -6938,11 +6941,11 @@ up SCM as you want it. If you need more control than is possible through ARGV, here are descriptions of the functions which main() calls. - -- Function: void init_sbrk (void) | + -- Function: void init_sbrk (void) Call this before SCM calls malloc(). Value returned from sbrk() is used to gauge how much storage SCM uses. - -- Function: char * scm_find_execpath (int ARGC, char **ARGV, char | + -- Function: char * scm_find_execpath (int ARGC, char **ARGV, char *SCRIPT_ARG) ARGC and ARGV are as described in main(). SCRIPT_ARG is the pathname of the SCSH-style script (*note Scripting::) being @@ -6957,7 +6960,7 @@ and DIRSEP control scm_find_implpath()'s operation. If your application has an easier way to locate initialization code for SCM, then you can replace `scm_find_implpath'. - -- Function: char * scm_find_implpath (char *EXECPATH) | + -- Function: char * scm_find_implpath (char *EXECPATH) Returns the full pathname of the Scheme initialization file or 0 if it cannot find it. @@ -6966,11 +6969,11 @@ 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 "Init5e1_scm"), and the directory separator string | + (default "Init5e2_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. - -- Function: int init_buf0 (FILE *INPORT) | + -- Function: int init_buf0 (FILE *INPORT) Tries to determine whether INPORT (usually stdin) is an interactive input port which should be used in an unbuffered mode. If so, INPORT is set to unbuffered and non-zero is returned. @@ -6980,7 +6983,7 @@ SCM, then you can replace `scm_find_implpath'. Its value can be used as the last argument to scm_init_from_argv(). - -- Function: void scm_init_from_argv (int ARGC, char **ARGV, char | + -- Function: void scm_init_from_argv (int ARGC, char **ARGV, char *SCRIPT_ARG, int IVERBOSE, int BUF0STDIN) Initializes SCM storage and creates a list of the argument strings PROGRAM-ARGUMENTS from ARGV. ARGC and ARGV must already be @@ -6992,15 +6995,15 @@ SCM, then you can replace `scm_find_implpath'. Call `init_signals' and `restore_signals' only if you want SCM to handle interrupts and signals. - -- Function: void init_signals (void) | + -- Function: void init_signals (void) Initializes handlers for `SIGINT' and `SIGALRM' if they are supported by the C implementation. All of the signal handlers immediately reestablish themselves by a call to `signal()'. - -- Function: void restore_signals (void) | + -- Function: void restore_signals (void) Restores the handlers in effect when `init_signals' was called. - -- Function: SCM scm_top_level (char *INITPATH, SCM (*toplvl_fun)()) | + -- Function: SCM scm_top_level (char *INITPATH, SCM (*toplvl_fun)()) This is SCM's top-level. Errors longjmp here. TOPLVL_FUN is a callback function of zero arguments that is called by `scm_top_level' to do useful work - if zero, then `repl', which @@ -7024,7 +7027,7 @@ handle interrupts and signals. resignalled. If `toplvl_fun' can not recover from an error situation it may simply return. - -- Function: void final_scm (int FREEALL) | + -- Function: void final_scm (int FREEALL) Calls all finalization routines registered with add_final(). If FREEALL is non-zero, then all memory which SCM allocated with malloc() will be freed. @@ -7053,9 +7056,9 @@ Here is a minimal embedding program `libtest.c': /* include patchlvl.h for SCM's INIT_FILE_NAME. */ #include "patchlvl.h" - void libtest_init_user_scm() | + void libtest_init_user_scm() { - fputs("This is libtest_init_user_scm\n", stderr); fflush(stderr); | + fputs("This is libtest_init_user_scm\n", stderr); fflush(stderr); sysintern("*the-string*", makfrom0str("hello world\n")); } @@ -7069,12 +7072,12 @@ Here is a minimal embedding program `libtest.c': int main(argc, argv) int argc; - char **argv; + const char **argv; | { SCM retval; char *implpath, *execpath; - init_user_scm = libtest_init_user_scm; | + init_user_scm = libtest_init_user_scm; execpath = dld_find_executable(argv[0]); fprintf(stderr, "dld_find_executable(%s): %s\n", argv[0], execpath); implpath = find_impl_file(execpath, "scm", INIT_FILE_NAME, dirsep); @@ -7089,25 +7092,25 @@ Here is a minimal embedding program `libtest.c': -| dld_find_executable(./libtest): /home/jaffer/scm/libtest - implpath: /home/jaffer/scm/Init5e1.scm | - This is libtest_init_user_scm | + implpath: /home/jaffer/scm/Init5e2.scm | + This is libtest_init_user_scm hello world File: scm.info, Node: Callbacks, Next: Type Conversions, Prev: Embedding SCM, Up: Operations -6.2.11 Callbacks | ----------------- | +6.2.11 Callbacks +---------------- SCM now has routines to make calling back to Scheme procedures easier. The source code for these routines are found in `rope.c'. - -- Function: int scm_ldfile (char *FILE) | + -- 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 - `Init5e1.scm'. | + `Init5e2.scm'. | - -- Function: int scm_ldprog (char *FILE) | + -- Function: int scm_ldprog (char *FILE) Loads the Scheme source file `(in-vicinity (program-vicinity) FILE)'. Returns 0 if successful, non-0 if not. @@ -7116,11 +7119,11 @@ The source code for these routines are found in `rope.c'. directory from which the calling code was loaded (*note Vicinity: (slib)Vicinity.). - -- Function: SCM scm_evstr (char *STR) | + -- Function: SCM scm_evstr (char *STR) Returns the result of reading an expression from STR and evaluating it. - -- Function: void scm_ldstr (char *STR) | + -- Function: void scm_ldstr (char *STR) Reads and evaluates all the expressions from STR. If you wish to catch errors during execution of Scheme code, then you @@ -7144,14 +7147,14 @@ Calls to procedures so wrapped will return even if an error occurs. File: scm.info, Node: Type Conversions, Next: Continuations, Prev: Callbacks, Up: Operations -6.2.12 Type Conversions | ------------------------ | +6.2.12 Type Conversions +----------------------- These type conversion functions are very useful for connecting SCM and C code. Most are defined in `rope.c'. - -- Function: SCM long2num (long N) | - -- Function: SCM ulong2num (unsigned long N) | + -- Function: SCM long2num (long N) + -- Function: SCM ulong2num (unsigned long N) Return an object of type `SCM' corresponding to the `long' or `unsigned long' argument N. If N cannot be converted, `BOOL_F' is returned. Which numbers can be converted depends on whether SCM @@ -7160,15 +7163,15 @@ code. Most are defined in `rope.c'. To convert integer numbers of smaller types (`short' or `char'), use the macro `MAKINUM(n)'. - -- Function: long num2long (SCM NUM, char *POS, char *S_CALLER) | - -- Function: unsigned long num2ulong (SCM NUM, char *POS, char | + -- Function: long num2long (SCM NUM, char *POS, char *S_CALLER) + -- Function: unsigned long num2ulong (SCM NUM, char *POS, char *S_CALLER) - -- Function: short num2short (SCM NUM, char *POS, char *S_CALLER) | - -- Function: unsigned short num2ushort (SCM NUM, char *POS, char | + -- Function: short num2short (SCM NUM, char *POS, char *S_CALLER) + -- Function: unsigned short num2ushort (SCM NUM, char *POS, char *S_CALLER) - -- Function: unsigned char num2uchar (SCM NUM, char *POS, char | + -- Function: unsigned char num2uchar (SCM NUM, char *POS, char *S_CALLER) - -- Function: double num2dbl (SCM NUM, char *POS, char *S_CALLER) | + -- Function: double num2dbl (SCM NUM, char *POS, char *S_CALLER) These functions are used to check and convert `SCM' arguments to the named C type. The first argument NUM is checked to see it it is within the range of the destination type. If so, the converted @@ -7176,12 +7179,12 @@ code. Most are defined in `rope.c'. NUM and strings POS and S_CALLER. For a listing of useful predefined POS macros, *Note C Macros::. - _Note_ Inexact numbers are accepted only by `num2dbl', `num2long', | - and `num2ulong' (for when `SCM' is compiled without bignums). To | + _Note_ Inexact numbers are accepted only by `num2dbl', `num2long', + and `num2ulong' (for when `SCM' is compiled without bignums). To convert inexact numbers to exact numbers, *Note inexact->exact: - (r5rs)Numerical operations. | + (r5rs)Numerical operations. - -- Function: unsigned long scm_addr (SCM ARGS, char *S_NAME) | + -- Function: unsigned long scm_addr (SCM ARGS, char *S_NAME) Returns a pointer (cast to an `unsigned long') to the storage corresponding to the location accessed by `aref(CAR(args),CDR(args))'. The string S_NAME is used in any @@ -7190,24 +7193,24 @@ code. Most are defined in `rope.c'. `scm_addr' is useful for performing C operations on strings or other uniform arrays (*note Uniform Array::). - -- Function: unsigned long scm_base_addr(SCM RA, char *S_NAME) | + -- Function: unsigned long scm_base_addr(SCM RA, char *S_NAME) Returns a pointer (cast to an `unsigned long') to the beginning of storage of array RA. Note that if RA is a shared-array, the strorage accessed this way may be much larger than RA. - _Note_ While you use a pointer returned from `scm_addr' or | + _Note_ While you use a pointer returned from `scm_addr' or `scm_base_addr' you must keep a pointer to the associated `SCM' object in a stack allocated variable or GC-protected location in order to assure that SCM does not reuse that storage before you are done with it. *Note scm_gc_protect: Changing Scm. - -- Function: SCM makfrom0str (char *SRC) | - -- Function: SCM makfromstr (char *SRC, sizet LEN) | + -- Function: SCM makfrom0str (char *SRC) + -- Function: SCM makfromstr (char *SRC, sizet LEN) Return a newly allocated string `SCM' object copy of the null-terminated string SRC or the string SRC of length LEN, respectively. - -- Function: SCM makfromstrs (int ARGC, char **ARGV) | + -- Function: SCM makfromstrs (int ARGC, char **ARGV) Returns a newly allocated `SCM' list of strings corresponding to the ARGC length array of null-terminated strings ARGV. If ARGV is less than `0', ARGV is assumed to be `NULL' terminated. @@ -7216,7 +7219,7 @@ code. Most are defined in `rope.c'. of SCM procedure calls to `program-arguments' (*note program-arguments: SCM Session.). - -- Function: char ** makargvfrmstrs (SCM ARGS, char *S_NAME) | + -- Function: char ** makargvfrmstrs (SCM ARGS, char *S_NAME) Returns a `NULL' terminated list of null-terminated strings copied from the `SCM' list of strings ARGS. The string S_NAME is used in messages from error calls by `makargvfrmstrs'. @@ -7224,15 +7227,15 @@ code. Most are defined in `rope.c'. `makargvfrmstrs' is useful for constructing argument lists suitable for passing to `main' functions. - -- Function: void must_free_argv (char **ARGV) | + -- Function: void must_free_argv (char **ARGV) Frees the storage allocated to create ARGV by a call to `makargvfrmstrs'. File: scm.info, Node: Continuations, Next: Evaluation, Prev: Type Conversions, Up: Operations -6.2.13 Continuations | --------------------- | +6.2.13 Continuations +-------------------- The source files `continue.h' and `continue.c' are designed to function as an independent resource for programs wishing to use continuations, @@ -7249,45 +7252,45 @@ SCM uses the names `jump_buf', `setjump', and `longjump' in lieu of `jmp_buf', `setjmp', and `longjmp' to prevent name and declaration conflicts. - -- Data type: CONTINUATION jmpbuf length stkbse other parent | + -- Data type: CONTINUATION jmpbuf length stkbse other parent is a `typedef'ed structure holding all the information needed to represent a continuation. The OTHER slot can be used to hold any data the user wishes to put there by defining the macro `CONTINUATION_OTHER'. - -- Macro: SHORT_ALIGN | + -- Macro: SHORT_ALIGN If `SHORT_ALIGN' is `#define'd (in `scmfig.h'), then the it is assumed that pointers in the stack can be aligned on `short int' boundaries. - -- Data type: STACKITEM | + -- Data type: STACKITEM is a pointer to objects of the size specified by `SHORT_ALIGN' being `#define'd or not. - -- Macro: CHEAP_CONTINUATIONS | + -- Macro: CHEAP_CONTINUATIONS If `CHEAP_CONTINUATIONS' is `#define'd (in `scmfig.h') each `CONTINUATION' has size `sizeof CONTINUATION'. Otherwise, all but "root" `CONTINUATION's have additional storage (immediately following) to contain a copy of part of the stack. - _Note_ On systems with nonlinear stack disciplines (multiple | + _Note_ On systems with nonlinear stack disciplines (multiple stacks or non-contiguous stack frames) copying the stack will not work properly. These systems need to #define `CHEAP_CONTINUATIONS' in `scmfig.h'. - -- Macro: STACK_GROWS_UP | + -- Macro: STACK_GROWS_UP Expresses which way the stack grows by its being `#define'd or not. - -- Variable: long thrown_value | + -- Variable: long thrown_value Gets set to the VALUE passed to `throw_to_continuation'. - -- Function: long stack_size (STACKITEM *START) | + -- Function: long stack_size (STACKITEM *START) Returns the number of units of size `STACKITEM' which fit between START and the current top of stack. No check is done in this routine to ensure that START is actually in the current stack segment. - -- Function: CONTINUATION * make_root_continuation (STACKITEM | + -- Function: CONTINUATION * make_root_continuation (STACKITEM *STACK_BASE) Allocates (`malloc') storage for a `CONTINUATION' of the current extent of stack. This newly allocated `CONTINUATION' is returned @@ -7296,7 +7299,7 @@ conflicts. `setjump(NEW_CONTINUATION->jmpbuf)' in order to complete the capture of this continuation. - -- Function: CONTINUATION * make_continuation (CONTINUATION | + -- Function: CONTINUATION * make_continuation (CONTINUATION *PARENT_CONT) Allocates storage for the current `CONTINUATION', copying (or encapsulating) the stack state from `PARENT_CONT->stkbse' to the @@ -7306,11 +7309,11 @@ conflicts. `setjump(NEW_CONTINUATION->jmpbuf)' in order to complete the capture of this continuation. - -- Function: void free_continuation (CONTINUATION *CONT) | + -- Function: void free_continuation (CONTINUATION *CONT) Frees the storage pointed to by CONT. Remember to free storage pointed to by `CONT->other'. - -- Function: void throw_to_continuation (CONTINUATION *CONT, long | + -- Function: void throw_to_continuation (CONTINUATION *CONT, long VALUE, CONTINUATION *ROOT_CONT) Sets `thrown_value' to VALUE and returns from the continuation CONT. @@ -7331,8 +7334,8 @@ conflicts. File: scm.info, Node: Evaluation, Prev: Continuations, Up: Operations -6.2.14 Evaluation | ------------------ | +6.2.14 Evaluation +----------------- SCM uses its type representations to speed evaluation. All of the `subr' types (*note Subr Cells::) are `tc7' types. Since the `tc7' @@ -7378,12 +7381,12 @@ with its cache footprint. In order to keep the size down, certain or because they are part of expensive operations) are instead calls to the C function `evalcar'. - -- Variable: symhash | + -- Variable: symhash Top level symbol values are stored in the `symhash' table. `symhash' is an array of lists of `ISYM's and pairs of symbols and values. - -- Immediate: ILOC | + -- Immediate: ILOC Whenever a symbol's value is found in the local environment the pointer to the symbol in the code is replaced with an immediate object (`ILOC') which specifies how many environment frames down @@ -7401,7 +7404,7 @@ Adding `#define TEST_FARLOC' to `eval.c' causes `FARLOC's to be generated for all local identifiers; this is useful only for testing memoization. - -- Immediate: GLOC | + -- Immediate: GLOC Pointers to symbols not defined in local environments are changed to one plus the value cell address in symhash. This incremented pointer is called a `GLOC'. The low order bit is normally @@ -7418,8 +7421,8 @@ argument checks for closures are made only when the function position will be checked only the first time it is evaluated because it will then be replaced with an `ILOC' or `GLOC'. - -- Macro: EVAL expression env | - -- Macro: SIDEVAL expression env | + -- Macro: EVAL expression env + -- Macro: SIDEVAL expression env `EVAL' Returns the result of evaluating EXPRESSION in ENV. `SIDEVAL' evaluates EXPRESSION in ENV when the value of the expression is not used. @@ -7429,7 +7432,7 @@ then be replaced with an `ILOC' or `GLOC'. EXPRESSION will not be referenced again. The C function `eval' is safe from this problem. - -- Function: SCM eval (SCM EXPRESSION) | + -- Function: SCM eval (SCM EXPRESSION) Returns the result of evaluating EXPRESSION in the top-level environment. `eval' copies `expression' so that memoization does not modify `expression'. @@ -7437,8 +7440,8 @@ then be replaced with an `ILOC' or `GLOC'. File: scm.info, Node: Program Self-Knowledge, Next: Improvements To Make, Prev: Operations, Up: The Implementation -6.3 Program Self-Knowledge | -========================== | +6.3 Program Self-Knowledge +========================== * Menu: @@ -7449,8 +7452,8 @@ File: scm.info, Node: Program Self-Knowledge, Next: Improvements To Make, Pre File: scm.info, Node: File-System Habitat, Next: Executable Pathname, Prev: Program Self-Knowledge, Up: Program Self-Knowledge -6.3.1 File-System Habitat | -------------------------- | +6.3.1 File-System Habitat +------------------------- Where should software reside? Although individually a minor annoyance, cumulatively this question represents many thousands of frustrated user @@ -7479,7 +7482,7 @@ for which this information is either not available or unrelated to the locations of support files, then a higher level interface will be needed. - -- Function: char * find_impl_file (char *EXEC_PATH, char | + -- Function: char * find_impl_file (char *EXEC_PATH, char *GENERIC_NAME, char *INITNAME, char *SEP) Given the pathname of this executable (EXEC_PATH), test for the existence of INITNAME in the implementation-vicinity of this @@ -7522,10 +7525,10 @@ needed. File: scm.info, Node: Executable Pathname, Next: Script Support, Prev: File-System Habitat, Up: Program Self-Knowledge -6.3.2 Executable Pathname | -------------------------- | +6.3.2 Executable Pathname +------------------------- -For purposes of finding `Init5e1.scm', dumping an executable, and | +For purposes of finding `Init5e2.scm', dumping an executable, and | dynamic linking, a SCM session needs the pathname of its executable image. @@ -7536,7 +7539,7 @@ directly to `find_impl_file' (*note File-System Habitat::). In order to find the habitat for a unix program, we first need to know the full pathname for the associated executable file. - -- Function: char * dld_find_executable (const char *COMMAND) | + -- Function: char * dld_find_executable (const char *COMMAND) `dld_find_executable' returns the absolute path name of the file that would be executed if COMMAND were given as a command. It looks up the environment variable PATH, searches in each of the @@ -7544,7 +7547,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, char **argv) + main (int argc, const char **argv) | { ... if (dld_init (dld_find_executable (argv[0]))) { @@ -7553,10 +7556,10 @@ the full pathname for the associated executable file. ... } - *Note@:* If the current process is executed using the | - `execve' call without passing the correct path name as | - argument 0, `dld_find_executable (argv[0]) ' will also fail | - to locate the executable file. | + *Note@:* If the current process is executed using the + `execve' call without passing the correct path name as + argument 0, `dld_find_executable (argv[0]) ' will also fail + to locate the executable file. `dld_find_executable' returns zero if `command' is not found in any of the directories listed in `PATH'. @@ -7564,21 +7567,21 @@ the full pathname for the associated executable file. File: scm.info, Node: Script Support, Prev: Executable Pathname, Up: Program Self-Knowledge -6.3.3 Script Support | --------------------- | +6.3.3 Script Support +-------------------- Source code for these C functions is in the file `script.c'. *Note Scripting:: for a description of script argument processing. `script_find_executable' is only defined on unix systems. - -- Function: char * script_find_executable (const char *NAME) | + -- Function: char * script_find_executable (const char *NAME) `script_find_executable' returns the path name of the executable which is invoked by the script file NAME; NAME if it is a binary executable (not a script); or 0 if NAME does not exist or is not executable. - -- Function: char ** script_process_argv (int ARGC; char **ARGV) | + -- Function: char ** script_process_argv (int ARGC; char **ARGV) Given an "main" style argument vector ARGV and the number of arguments, ARGC, `script_process_argv' returns a newly allocated argument vector in which the second line of the script being @@ -7591,14 +7594,14 @@ Scripting:: for a description of script argument processing. `script_process_argv' correctly processes argument vectors of nested script invocations. - -- Function: int script_count_argv (char **ARGV) | + -- Function: int script_count_argv (char **ARGV) Returns the number of argument strings in ARGV. File: scm.info, Node: Improvements To Make, Prev: Program Self-Knowledge, Up: The Implementation -6.4 Improvements To Make | -======================== | +6.4 Improvements To Make +======================== * Allow users to set limits for `malloc()' storage. @@ -7645,13 +7648,13 @@ File: scm.info, Node: Improvements To Make, Prev: Program Self-Knowledge, Up: * Menu: -* VMS Dynamic Linking:: Finishing the job. | +* VMS Dynamic Linking:: Finishing the job. File: scm.info, Node: VMS Dynamic Linking, Prev: Improvements To Make, Up: Improvements To Make - | -6.4.1 VMS Dynamic Linking | -------------------------- | + +6.4.1 VMS Dynamic Linking +------------------------- George Carrette (gjc@mitech.com) outlines how to dynamically link on VMS. There is already some code in `dynl.c' to do this, but someone @@ -7679,7 +7682,7 @@ with a VMS system needs to finish and debug it. PSECT_ATTR=the_heap,NOSHR,LCL PSECT_ATTR=the_environment,NOSHR,LCL - _Notice_ The "psect" (Program Section) attributes. | + _Notice_ The "psect" (Program Section) attributes. `LCL' means to keep the name local to the shared library. You almost always want to do that for a good clean library. @@ -7711,9 +7714,9 @@ with a VMS system needs to finish and debug it. LISPRTL/SHARE Note the definition of the `LISPRTL' logical name. Without such a - definition you will need to copy `LISPRTL.EXE' over to `SYS$SHARE' | - (aka `SYS$LIBRARY') in order to invoke the main program once it is | - linked. | + definition you will need to copy `LISPRTL.EXE' over to `SYS$SHARE' + (aka `SYS$LIBRARY') in order to invoke the main program once it is + linked. 5. Now say you have a file of optional subrs, `MYSUBRS.C'. And there is a routine `INIT_MYSUBRS' that must be called before using it. @@ -7769,978 +7772,978 @@ with a VMS system needs to finish and debug it. File: scm.info, Node: Index, Prev: The Implementation, Up: Top - | + Procedure and Macro Index ************************* This is an alphabetical list of all the procedures and macros in SCM. - + * Menu: -* #!: Unix Scheme Scripts. (line 40) | +* #!: Unix Scheme Scripts. (line 40) * #': Common-Lisp Read Syntax. - (line 50) | + (line 50) * #+: Common-Lisp Read Syntax. - (line 16) | + (line 16) * #-: Common-Lisp Read Syntax. - (line 26) | + (line 26) * #.: Common-Lisp Read Syntax. - (line 39) | + (line 39) * #;text-till-end-of-line: Documentation and Comments. - (line 31) | -* #?column: Load Syntax. (line 12) | -* #?file: Load Syntax. (line 16) | -* #?line: Load Syntax. (line 11) | + (line 31) +* #?column: Load Syntax. (line 12) +* #?file: Load Syntax. (line 16) +* #?line: Load Syntax. (line 11) * #\token: Common-Lisp Read Syntax. - (line 7) | + (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) | -* -: 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) | -* ---help: SCM Options. (line 20) | -* ---initialization=: Build Options. (line 141) | -* ---libraries=: Build Options. (line 103) | -* ---linker-options=: Build Options. (line 121) | -* ---no-init-file: SCM Options. (line 17) | -* ---object-files=: Build Options. (line 137) | -* ---outname=: Build Options. (line 97) | -* ---platform=: Build Options. (line 12) | -* ---scheme-initial=: Build Options. (line 125) | -* ---type=: Build Options. (line 146) | -* ---version: SCM Options. (line 23) | -* --batch-dialect=: Build Options. (line 164) | -* --script-name=: Build Options. (line 186) | -* -a: SCM Options. (line 9) | -* -b: SCM Options. (line 98) | -* -c <1>: SCM Options. (line 46) | -* -c: Build Options. (line 132) | -* -d: SCM Options. (line 42) | -* -D: Build Options. (line 110) | -* -e: SCM Options. (line 45) | -* -f: SCM Options. (line 37) | -* -F: Build Options. (line 190) | -* -f: Build Options. (line 68) | -* -h <1>: SCM Options. (line 33) | -* -h: Build Options. (line 163) | -* -i <1>: SCM Options. (line 88) | -* -i: Build Options. (line 140) | -* -j: Build Options. (line 136) | -* -l <1>: SCM Options. (line 36) | -* -l: Build Options. (line 102) | -* -m: SCM Options. (line 75) | -* -no-init-file: SCM Options. (line 16) | -* -o <1>: SCM Options. (line 52) | -* -o: Build Options. (line 96) | -* -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) | -* -u: SCM Options. (line 82) | -* -v: SCM Options. (line 66) | -* -w: Build Options. (line 185) | -* @apply: Environment Frames. (line 54) | -* @copy-tree: Storage. (line 16) | + (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) +* -: 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) +* ---help: SCM Options. (line 20) +* ---initialization=: Build Options. (line 141) +* ---libraries=: Build Options. (line 103) +* ---linker-options=: Build Options. (line 121) +* ---no-init-file: SCM Options. (line 17) +* ---object-files=: Build Options. (line 137) +* ---outname=: Build Options. (line 97) +* ---platform=: Build Options. (line 12) +* ---scheme-initial=: Build Options. (line 125) +* ---type=: Build Options. (line 146) +* ---version: SCM Options. (line 23) +* --batch-dialect=: Build Options. (line 164) +* --script-name=: Build Options. (line 186) +* -a: SCM Options. (line 9) +* -b: SCM Options. (line 98) +* -c <1>: SCM Options. (line 46) +* -c: Build Options. (line 132) +* -d: SCM Options. (line 42) +* -D: Build Options. (line 110) +* -e: SCM Options. (line 45) +* -f: SCM Options. (line 37) +* -F: Build Options. (line 190) +* -f: Build Options. (line 68) +* -h <1>: SCM Options. (line 33) +* -h: Build Options. (line 163) +* -i <1>: SCM Options. (line 88) +* -i: Build Options. (line 140) +* -j: Build Options. (line 136) +* -l <1>: SCM Options. (line 36) +* -l: Build Options. (line 102) +* -m: SCM Options. (line 75) +* -no-init-file: SCM Options. (line 16) +* -o <1>: SCM Options. (line 52) +* -o: Build Options. (line 96) +* -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) +* -u: SCM Options. (line 82) +* -v: SCM Options. (line 66) +* -w: Build Options. (line 185) +* @apply: Environment Frames. (line 54) +* @copy-tree: Storage. (line 16) * @macroexpand1: Syntactic Hooks for Hygienic Macros. - (line 107) | -* _exclusive: Opening and Closing. (line 41) | -* _ionbf: Opening and Closing. (line 28) | -* _tracked: Opening and Closing. (line 35) | -* abort: Internal State. (line 15) | -* access: I/O-Extensions. (line 181) | -* acct: Unix Extensions. (line 34) | -* acons: Storage. (line 21) | -* acosh: Numeric. (line 33) | + (line 107) +* _exclusive: Opening and Closing. (line 41) +* _ionbf: Opening and Closing. (line 28) +* _tracked: Opening and Closing. (line 35) +* abort: Internal State. (line 15) +* access: I/O-Extensions. (line 181) +* acct: Unix Extensions. (line 34) +* acons: Storage. (line 21) +* acosh: Numeric. (line 33) * add-alias: Configure Module Catalog. - (line 33) | -* add-finalizer: Storage. (line 36) | + (line 33) +* add-finalizer: Storage. (line 36) * add-link: Configure Module Catalog. - (line 12) | + (line 12) * add-source: Configure Module Catalog. - (line 41) | -* alarm: Interrupts. (line 24) | -* alarm-interrupt: Interrupts. (line 50) | -* ALLOW_INTS: Signals. (line 33) | -* alrm_signal: Signals. (line 14) | -* ARGC: Cells. (line 57) | -* arithmetic-error: Interrupts. (line 69) | -* array->list: Conventional Arrays. (line 60) | -* array-contents: Conventional Arrays. (line 64) | -* array-equal?: Array Mapping. (line 18) | -* array-fill!: Array Mapping. (line 11) | -* array-map: Array Mapping. (line 43) | -* array-map!: Array Mapping. (line 25) | -* array-prototype: Uniform Array. (line 50) | -* array?: Uniform Array. (line 46) | -* asinh: Numeric. (line 32) | -* ASRTER: C Macros. (line 7) | -* ASRTGO: C Macros. (line 52) | -* atanh: Numeric. (line 34) | -* bit-count: Bit Vectors. (line 15) | -* bit-count*: Bit Vectors. (line 37) | -* bit-invert!: Bit Vectors. (line 23) | -* bit-position: Bit Vectors. (line 18) | -* bit-set*!: Bit Vectors. (line 26) | -* boot-tail <1>: Dump. (line 38) | -* boot-tail: SCM Session. (line 25) | -* box: Curses Miscellany. (line 21) | -* broken-pipe: Posix Extensions. (line 27) | -* call-with-outputs: Port Redirection. (line 26) | -* CAR: Cells. (line 23) | + (line 41) +* alarm: Interrupts. (line 24) +* alarm-interrupt: Interrupts. (line 50) +* ALLOW_INTS: Signals. (line 33) +* alrm_signal: Signals. (line 14) +* ARGC: Cells. (line 57) +* arithmetic-error: Interrupts. (line 69) +* array->list: Conventional Arrays. (line 60) +* array-contents: Conventional Arrays. (line 64) +* array-equal?: Array Mapping. (line 18) +* array-fill!: Array Mapping. (line 11) +* array-map: Array Mapping. (line 43) +* array-map!: Array Mapping. (line 25) +* array-prototype: Uniform Array. (line 50) +* array?: Uniform Array. (line 46) +* asinh: Numeric. (line 32) +* ASRTER: C Macros. (line 7) +* ASRTGO: C Macros. (line 52) +* atanh: Numeric. (line 34) +* bit-count: Bit Vectors. (line 15) +* bit-count*: Bit Vectors. (line 37) +* bit-invert!: Bit Vectors. (line 23) +* bit-position: Bit Vectors. (line 18) +* bit-set*!: Bit Vectors. (line 26) +* boot-tail <1>: Dump. (line 38) +* boot-tail: SCM Session. (line 25) +* box: Curses Miscellany. (line 21) +* broken-pipe: Posix Extensions. (line 27) +* call-with-outputs: Port Redirection. (line 26) +* CAR: Cells. (line 23) * cbreak: Terminal Mode Setting. - (line 12) | -* CCLO_LENGTH: Header Cells. (line 101) | -* CDR: Cells. (line 24) | -* char: Type Conversions. (line 27) | -* char-ready: Port Properties. (line 39) | -* char-ready? <1>: Socket. (line 66) | -* char-ready?: Port Properties. (line 37) | -* char:sharp: Modifying Read Syntax. | - (line 23) | -* CHARS: Header Cells. (line 35) | -* chdir: I/O-Extensions. (line 145) | -* CHEAP_CONTINUATIONS: Continuations. (line 37) | -* chmod: I/O-Extensions. (line 160) | -* chown: Posix Extensions. (line 255) | + (line 12) +* CCLO_LENGTH: Header Cells. (line 101) +* CDR: Cells. (line 24) +* char: Type Conversions. (line 27) +* char-ready: Port Properties. (line 39) +* char-ready? <1>: Socket. (line 66) +* char-ready?: Port Properties. (line 37) +* char:sharp: Modifying Read Syntax. + (line 23) +* CHARS: Header Cells. (line 35) +* chdir: I/O-Extensions. (line 145) +* CHEAP_CONTINUATIONS: Continuations. (line 37) +* chmod: I/O-Extensions. (line 160) +* chown: Posix Extensions. (line 255) * clearok: Output Options Setting. - (line 11) | -* close-port <1>: Window Manipulation. (line 24) | -* close-port <2>: Posix Extensions. (line 35) | -* close-port: Opening and Closing. (line 55) | -* closedir: I/O-Extensions. (line 101) | -* CLOSEDP: Ptob Cells. (line 43) | -* CLOSUREP: Cells. (line 49) | -* CODE: Cells. (line 52) | + (line 11) +* close-port <1>: Window Manipulation. (line 24) +* close-port <2>: Posix Extensions. (line 35) +* close-port: Opening and Closing. (line 55) +* closedir: I/O-Extensions. (line 101) +* CLOSEDP: Ptob Cells. (line 43) +* CLOSUREP: Cells. (line 49) +* CODE: Cells. (line 52) * comment: Documentation and Comments. - (line 23) | -* CONSP: Cells. (line 35) | -* copy-tree: Storage. (line 15) | -* cosh: Numeric. (line 28) | -* could-not-open: Interrupts. (line 66) | -* current-error-port: Port Redirection. (line 7) | -* current-input-port: Port Properties. (line 43) | -* current-time: Time. (line 24) | -* default-input-port: Line Editing. (line 21) | -* default-output-port: Line Editing. (line 25) | -* defconst: Define and Set. (line 22) | -* DEFER_INTS: Signals. (line 26) | -* defined?: Define and Set. (line 7) | -* defmacro: Defmacro. (line 6) | -* defsyntax: Macro Primitives. (line 36) | -* defvar: Define and Set. (line 13) | -* directory-for-each: I/O-Extensions. (line 105) | -* display: Output. (line 9) | -* dld_find_executable: Executable Pathname. (line 18) | -* dump: Dump. (line 33) | -* duplicate-port: I/O-Extensions. (line 78) | -* dyn:call: Dynamic Linking. (line 79) | -* dyn:link: Dynamic Linking. (line 71) | -* dyn:main-call: Dynamic Linking. (line 91) | -* dyn:unlink: Dynamic Linking. (line 106) | + (line 23) +* CONSP: Cells. (line 35) +* copy-tree: Storage. (line 15) +* cosh: Numeric. (line 28) +* could-not-open: Interrupts. (line 66) +* current-error-port: Port Redirection. (line 7) +* current-input-port: Port Properties. (line 43) +* current-time: Time. (line 24) +* default-input-port: Line Editing. (line 21) +* default-output-port: Line Editing. (line 25) +* defconst: Define and Set. (line 22) +* DEFER_INTS: Signals. (line 26) +* defined?: Define and Set. (line 7) +* defmacro: Defmacro. (line 6) +* defsyntax: Macro Primitives. (line 36) +* defvar: Define and Set. (line 13) +* directory-for-each: I/O-Extensions. (line 105) +* display: Output. (line 9) +* dld_find_executable: Executable Pathname. (line 18) +* dump: Dump. (line 33) +* duplicate-port: I/O-Extensions. (line 78) +* dyn:call: Dynamic Linking. (line 79) +* dyn:link: Dynamic Linking. (line 71) +* dyn:main-call: Dynamic Linking. (line 91) +* dyn:unlink: Dynamic Linking. (line 106) * echo: Terminal Mode Setting. - (line 39) | -* ed: Editing Scheme Code. (line 7) | -* enclose-array: Conventional Arrays. (line 39) | -* end-of-program: Interrupts. (line 67) | -* endwin: Curses. (line 15) | -* ENV: Cells. (line 53) | -* errno: Errors. (line 92) | -* error: Errors. (line 113) | -* eval: Evaluation. (line 102) | -* EVAL: Evaluation. (line 91) | -* eval: Eval and Load. (line 21) | -* eval-string: Eval and Load. (line 24) | -* exec-self: Internal State. (line 27) | -* execl: I/O-Extensions. (line 207) | -* execlp: I/O-Extensions. (line 208) | -* execpath: Internal State. (line 78) | -* execv: I/O-Extensions. (line 218) | -* execvp: I/O-Extensions. (line 219) | -* exit: SCM Session. (line 19) | + (line 39) +* ed: Editing Scheme Code. (line 7) +* enclose-array: Conventional Arrays. (line 39) +* end-of-program: Interrupts. (line 67) +* endwin: Curses. (line 15) +* ENV: Cells. (line 53) +* errno: Errors. (line 92) +* error: Errors. (line 113) +* eval: Evaluation. (line 102) +* EVAL: Evaluation. (line 91) +* eval: Eval and Load. (line 21) +* eval-string: Eval and Load. (line 24) +* exec-self: Internal State. (line 27) +* execl: I/O-Extensions. (line 207) +* execlp: I/O-Extensions. (line 208) +* execpath: Internal State. (line 78) +* execv: I/O-Extensions. (line 218) +* execvp: I/O-Extensions. (line 219) +* exit: SCM Session. (line 19) * extended-environment: Syntactic Hooks for Hygienic Macros. - (line 113) | -* file-position: I/O-Extensions. (line 56) | -* file-set-position: I/O-Extensions. (line 61) | -* fileno: I/O-Extensions. (line 177) | -* final_scm: Embedding SCM. (line 117) | -* find_impl_file: File-System Habitat. (line 35) | -* force-output: Window Manipulation. (line 30) | -* fork: Posix Extensions. (line 44) | -* FPORTP: Ptob Cells. (line 53) | -* frame->environment: Debugging Continuations. | - (line 18) | -* frame-eval: Debugging Continuations. | - (line 27) | -* frame-trace: Debugging Continuations. | - (line 10) | -* free_continuation: Continuations. (line 79) | -* freshline: Port Properties. (line 26) | -* gc: Internal State. (line 57) | -* gc-hook: Storage. (line 28) | -* gc_mark: Marking Cells. (line 27) | -* GCCDR: Marking Cells. (line 15) | -* GCTYP16: Marking Cells. (line 19) | -* gentemp: Defmacro. (line 6) | -* get-internal-real-time: Time. (line 17) | -* get-internal-run-time: Time. (line 10) | -* getcwd: I/O-Extensions. (line 150) | -* getegid: Posix Extensions. (line 63) | -* geteuid: Posix Extensions. (line 66) | -* getgid: Posix Extensions. (line 60) | -* getgr: Posix Extensions. (line 224) | -* getgroups: Posix Extensions. (line 245) | + (line 113) +* file-position: I/O-Extensions. (line 56) +* file-set-position: I/O-Extensions. (line 61) +* fileno: I/O-Extensions. (line 177) +* final_scm: Embedding SCM. (line 117) +* find_impl_file: File-System Habitat. (line 35) +* force-output: Window Manipulation. (line 30) +* fork: Posix Extensions. (line 44) +* FPORTP: Ptob Cells. (line 53) +* frame->environment: Debugging Continuations. + (line 18) +* frame-eval: Debugging Continuations. + (line 27) +* frame-trace: Debugging Continuations. + (line 10) +* free_continuation: Continuations. (line 79) +* freshline: Port Properties. (line 26) +* gc: Internal State. (line 57) +* gc-hook: Storage. (line 28) +* gc_mark: Marking Cells. (line 27) +* GCCDR: Marking Cells. (line 15) +* GCTYP16: Marking Cells. (line 19) +* gentemp: Defmacro. (line 6) +* get-internal-real-time: Time. (line 17) +* get-internal-run-time: Time. (line 10) +* getcwd: I/O-Extensions. (line 150) +* getegid: Posix Extensions. (line 63) +* geteuid: Posix Extensions. (line 66) +* getgid: Posix Extensions. (line 60) +* getgr: Posix Extensions. (line 224) +* getgroups: Posix Extensions. (line 245) * gethost: Host and Other Inquiries. - (line 11) | -* getlogin: SCM Session. (line 33) | + (line 11) +* getlogin: SCM Session. (line 33) * getnet: Host and Other Inquiries. - (line 34) | + (line 34) * getpeername: Internet Addresses and Socket Names. - (line 33) | -* getpid: I/O-Extensions. (line 53) | -* getppid: Posix Extensions. (line 53) | + (line 33) +* getpid: I/O-Extensions. (line 53) +* getppid: Posix Extensions. (line 53) * getproto: Host and Other Inquiries. - (line 54) | -* getpw: Posix Extensions. (line 193) | + (line 54) +* getpw: Posix Extensions. (line 193) * getserv: Host and Other Inquiries. - (line 73) | + (line 73) * getsockname: Internet Addresses and Socket Names. - (line 29) | -* getuid: Posix Extensions. (line 57) | -* getyx: Input. (line 24) | -* hang-up: Interrupts. (line 68) | -* ICHR: Immediates. (line 51) | -* ICHRP: Immediates. (line 48) | + (line 29) +* getuid: Posix Extensions. (line 57) +* getyx: Input. (line 24) +* hang-up: Interrupts. (line 68) +* ICHR: Immediates. (line 51) +* ICHRP: Immediates. (line 48) * identifier->symbol: Syntactic Hooks for Hygienic Macros. - (line 37) | + (line 37) * identifier-equal?: Syntactic Hooks for Hygienic Macros. - (line 89) | + (line 89) * identifier?: Syntactic Hooks for Hygienic Macros. - (line 13) | + (line 13) * idlok: Output Options Setting. - (line 18) | -* IFLAGP: Immediates. (line 83) | -* IMP: Immediates. (line 11) | + (line 18) +* IFLAGP: Immediates. (line 83) +* IMP: Immediates. (line 11) * inet:address->string: Internet Addresses and Socket Names. - (line 11) | + (line 11) * inet:local-network-address: Internet Addresses and Socket Names. - (line 19) | + (line 19) * inet:make-address: Internet Addresses and Socket Names. - (line 23) | + (line 23) * inet:network: Internet Addresses and Socket Names. - (line 15) | + (line 15) * inet:string->address: Internet Addresses and Socket Names. - (line 7) | -* init_buf0: Embedding SCM. (line 63) | -* init_sbrk: Embedding SCM. (line 31) | -* init_signals <1>: Embedding SCM. (line 85) | -* init_signals: Signals. (line 7) | -* initscr: Curses. (line 11) | -* INPORTP: Ptob Cells. (line 37) | -* int_signal: Signals. (line 13) | -* integer->line-number: Line Numbers. (line 37) | -* INUM: Immediates. (line 26) | -* INUMP: Immediates. (line 21) | -* isatty?: Port Properties. (line 33) | -* ISYMCHARS: Immediates. (line 93) | -* ISYMNUM: Immediates. (line 89) | -* ISYMP: Immediates. (line 86) | -* kill: Posix Extensions. (line 85) | + (line 7) +* init_buf0: Embedding SCM. (line 63) +* init_sbrk: Embedding SCM. (line 31) +* init_signals <1>: Embedding SCM. (line 85) +* init_signals: Signals. (line 7) +* initscr: Curses. (line 11) +* INPORTP: Ptob Cells. (line 37) +* int_signal: Signals. (line 13) +* integer->line-number: Line Numbers. (line 37) +* INUM: Immediates. (line 26) +* INUMP: Immediates. (line 21) +* isatty?: Port Properties. (line 33) +* ISYMCHARS: Immediates. (line 93) +* ISYMNUM: Immediates. (line 89) +* ISYMP: Immediates. (line 86) +* kill: Posix Extensions. (line 85) * leaveok: Output Options Setting. - (line 32) | -* LENGTH: Header Cells. (line 22) | -* line-editing: Line Editing. (line 33) | -* line-number: Eval and Load. (line 34) | -* line-number->integer: Line Numbers. (line 41) | -* line-number?: Line Numbers. (line 44) | -* link: Posix Extensions. (line 248) | -* list->uniform-array: Uniform Array. (line 54) | -* load: Dynamic Linking. (line 28) | -* load-string: Eval and Load. (line 29) | -* load:sharp: Modifying Read Syntax. | - (line 17) | -* logaref: Uniform Array. (line 86) | -* logaset!: Uniform Array. (line 98) | -* long: Type Conversions. (line 22) | -* long2num: Type Conversions. (line 10) | -* lstat: Unix Extensions. (line 23) | -* macroexpand: Defmacro. (line 6) | -* macroexpand-1: Defmacro. (line 6) | -* main: Embedding SCM. (line 12) | -* makargvfrmstrs: Type Conversions. (line 76) | -* makcclo: Header Cells. (line 96) | + (line 32) +* LENGTH: Header Cells. (line 22) +* line-editing: Line Editing. (line 33) +* line-number: Eval and Load. (line 34) +* line-number->integer: Line Numbers. (line 41) +* line-number?: Line Numbers. (line 44) +* link: Posix Extensions. (line 248) +* list->uniform-array: Uniform Array. (line 54) +* load: Dynamic Linking. (line 28) +* load-string: Eval and Load. (line 29) +* load:sharp: Modifying Read Syntax. + (line 17) +* logaref: Uniform Array. (line 86) +* logaset!: Uniform Array. (line 98) +* long: Type Conversions. (line 22) +* long2num: Type Conversions. (line 10) +* lstat: Unix Extensions. (line 23) +* macroexpand: Defmacro. (line 6) +* macroexpand-1: Defmacro. (line 6) +* main: Embedding SCM. (line 12) +* makargvfrmstrs: Type Conversions. (line 76) +* makcclo: Header Cells. (line 96) * make-arbiter: Process Synchronization. - (line 35) | -* make-edited-line-port: Line Editing. (line 29) | + (line 35) +* make-edited-line-port: Line Editing. (line 29) * make-exchanger: Process Synchronization. - (line 12) | -* make-soft-port: Soft Ports. (line 10) | -* make-stream-socket: Socket. (line 14) | -* make-stream-socketpair: Socket. (line 24) | -* make_continuation: Continuations. (line 70) | -* make_gsubr: Defining Subrs. (line 15) | -* make_root_continuation: Continuations. (line 61) | -* makfrom0str: Type Conversions. (line 61) | -* makfromstr: Type Conversions. (line 62) | -* makfromstrs: Type Conversions. (line 67) | -* MAKICHR: Immediates. (line 54) | -* MAKIFLAG: Immediates. (line 103) | -* MAKINUM: Immediates. (line 29) | -* MAKISYM: Immediates. (line 100) | -* MAKSPCSYM: Immediates. (line 97) | -* mark_locations: Marking Cells. (line 33) | -* milli-alarm: Interrupts. (line 30) | -* mkdir: I/O-Extensions. (line 131) | -* mknod: Unix Extensions. (line 43) | -* must_free: Allocating memory. (line 43) | -* must_free_argv: Type Conversions. (line 84) | -* must_malloc: Allocating memory. (line 14) | -* must_malloc_cell: Allocating memory. (line 13) | -* must_realloc: Allocating memory. (line 24) | -* must_realloc_cell: Allocating memory. (line 22) | -* mvwin: Window Manipulation. (line 41) | -* NCONSP: Cells. (line 36) | -* NEWCELL: Cells. (line 13) | -* newwin: Window Manipulation. (line 7) | -* nice: Unix Extensions. (line 29) | -* NIMP: Immediates. (line 12) | -* NINUMP: Immediates. (line 22) | + (line 12) +* make-soft-port: Soft Ports. (line 10) +* make-stream-socket: Socket. (line 14) +* make-stream-socketpair: Socket. (line 24) +* make_continuation: Continuations. (line 70) +* make_gsubr: Defining Subrs. (line 15) +* make_root_continuation: Continuations. (line 61) +* makfrom0str: Type Conversions. (line 61) +* makfromstr: Type Conversions. (line 62) +* makfromstrs: Type Conversions. (line 67) +* MAKICHR: Immediates. (line 54) +* MAKIFLAG: Immediates. (line 103) +* MAKINUM: Immediates. (line 29) +* MAKISYM: Immediates. (line 100) +* MAKSPCSYM: Immediates. (line 97) +* mark_locations: Marking Cells. (line 33) +* milli-alarm: Interrupts. (line 30) +* mkdir: I/O-Extensions. (line 131) +* mknod: Unix Extensions. (line 43) +* must_free: Allocating memory. (line 43) +* must_free_argv: Type Conversions. (line 84) +* must_malloc: Allocating memory. (line 14) +* must_malloc_cell: Allocating memory. (line 13) +* must_realloc: Allocating memory. (line 24) +* must_realloc_cell: Allocating memory. (line 22) +* mvwin: Window Manipulation. (line 41) +* NCONSP: Cells. (line 36) +* NEWCELL: Cells. (line 13) +* newwin: Window Manipulation. (line 7) +* nice: Unix Extensions. (line 29) +* NIMP: Immediates. (line 12) +* NINUMP: Immediates. (line 22) * nl: Terminal Mode Setting. - (line 50) | + (line 50) * nocbreak: Terminal Mode Setting. - (line 13) | + (line 13) * nodelay: Output Options Setting. - (line 53) | + (line 53) * noecho: Terminal Mode Setting. - (line 40) | + (line 40) * nonl: Terminal Mode Setting. - (line 51) | + (line 51) * noraw: Terminal Mode Setting. - (line 29) | -* NSTRINGP: Header Cells. (line 45) | -* num2dbl: Type Conversions. (line 28) | -* num2long: Type Conversions. (line 20) | -* num2short: Type Conversions. (line 23) | -* NVECTORP: Header Cells. (line 17) | -* open-file: Opening and Closing. (line 7) | -* open-input-pipe: Posix Extensions. (line 17) | -* open-output-pipe: Posix Extensions. (line 22) | -* open-pipe: Posix Extensions. (line 10) | -* open-ports: Opening and Closing. (line 48) | -* opendir: I/O-Extensions. (line 88) | -* OPENP: Ptob Cells. (line 42) | -* OPFPORTP: Ptob Cells. (line 54) | -* OPINFPORTP: Ptob Cells. (line 55) | -* OPINPORTP: Ptob Cells. (line 35) | -* OPOUTFPORTP: Ptob Cells. (line 56) | -* OPOUTPORTP: Ptob Cells. (line 36) | -* OPPORTP: Ptob Cells. (line 34) | -* out-of-storage: Interrupts. (line 65) | -* OUTPORTP: Ptob Cells. (line 38) | -* overlay: Window Manipulation. (line 46) | -* overwrite: Window Manipulation. (line 47) | -* perror: Errors. (line 101) | -* pi*: Numeric. (line 21) | -* pi/: Numeric. (line 24) | -* pipe: Posix Extensions. (line 40) | -* port-closed?: Port Properties. (line 7) | -* port-column: Port Properties. (line 19) | -* port-filename: Port Properties. (line 14) | -* port-line: Port Properties. (line 18) | -* port-type: Port Properties. (line 10) | -* PORTP: Ptob Cells. (line 33) | -* pp: Debugging Scheme Code. | - (line 79) | -* pprint: Debugging Scheme Code. | - (line 66) | + (line 29) +* NSTRINGP: Header Cells. (line 45) +* num2dbl: Type Conversions. (line 28) +* num2long: Type Conversions. (line 20) +* num2short: Type Conversions. (line 23) +* NVECTORP: Header Cells. (line 17) +* open-file: Opening and Closing. (line 7) +* open-input-pipe: Posix Extensions. (line 17) +* open-output-pipe: Posix Extensions. (line 22) +* open-pipe: Posix Extensions. (line 10) +* open-ports: Opening and Closing. (line 48) +* opendir: I/O-Extensions. (line 88) +* OPENP: Ptob Cells. (line 42) +* OPFPORTP: Ptob Cells. (line 54) +* OPINFPORTP: Ptob Cells. (line 55) +* OPINPORTP: Ptob Cells. (line 35) +* OPOUTFPORTP: Ptob Cells. (line 56) +* OPOUTPORTP: Ptob Cells. (line 36) +* OPPORTP: Ptob Cells. (line 34) +* out-of-storage: Interrupts. (line 65) +* OUTPORTP: Ptob Cells. (line 38) +* overlay: Window Manipulation. (line 46) +* overwrite: Window Manipulation. (line 47) +* perror: Errors. (line 101) +* pi*: Numeric. (line 21) +* pi/: Numeric. (line 24) +* pipe: Posix Extensions. (line 40) +* port-closed?: Port Properties. (line 7) +* port-column: Port Properties. (line 19) +* port-filename: Port Properties. (line 14) +* port-line: Port Properties. (line 18) +* port-type: Port Properties. (line 10) +* PORTP: Ptob Cells. (line 33) +* pp: Debugging Scheme Code. + (line 79) +* pprint: Debugging Scheme Code. + (line 66) * print: Debugging Scheme Code. - (line 58) | + (line 58) * print-args: Debugging Scheme Code. - (line 84) | -* procedure->identifier-macro: Macro Primitives. (line 14) | -* procedure->macro: Macro Primitives. (line 12) | -* procedure->memoizing-macro: Macro Primitives. (line 13) | -* procedure->syntax: Macro Primitives. (line 7) | + (line 84) +* procedure->identifier-macro: Macro Primitives. (line 14) +* procedure->macro: Macro Primitives. (line 12) +* procedure->memoizing-macro: Macro Primitives. (line 13) +* procedure->syntax: Macro Primitives. (line 7) * procedure-documentation: Documentation and Comments. - (line 7) | -* profile-alarm: Interrupts. (line 32) | -* profile-alarm-interrupt: Interrupts. (line 52) | -* program-arguments: SCM Session. (line 30) | -* putenv: I/O-Extensions. (line 223) | -* qase: Define and Set. (line 45) | -* quit: SCM Session. (line 17) | + (line 7) +* profile-alarm: Interrupts. (line 32) +* profile-alarm-interrupt: Interrupts. (line 52) +* program-arguments: SCM Session. (line 30) +* putenv: I/O-Extensions. (line 223) +* qase: Define and Set. (line 45) +* quit: SCM Session. (line 17) * raw: Terminal Mode Setting. - (line 28) | -* read-char <1>: Input. (line 7) | -* read-char: Port Properties. (line 40) | -* read-for-load: Line Numbers. (line 47) | -* read-numbered: Line Numbers. (line 26) | + (line 28) +* read-char <1>: Input. (line 7) +* read-char: Port Properties. (line 40) +* read-for-load: Line Numbers. (line 47) +* read-numbered: Line Numbers. (line 26) * read:sharp: Modifying Read Syntax. - (line 7) | -* readdir: I/O-Extensions. (line 92) | -* readlink: Unix Extensions. (line 19) | -* record-printer-set!: Records. (line 10) | -* redirect-port!: I/O-Extensions. (line 83) | -* refresh: Window Manipulation. (line 29) | + (line 7) +* readdir: I/O-Extensions. (line 92) +* readlink: Unix Extensions. (line 19) +* record-printer-set!: Records. (line 10) +* redirect-port!: I/O-Extensions. (line 83) +* refresh: Window Manipulation. (line 29) * regcomp: Regular Expression Pattern Matching. - (line 12) | + (line 12) * regerror: Regular Expression Pattern Matching. - (line 34) | + (line 34) * regexec: Regular Expression Pattern Matching. - (line 38) | + (line 38) * regmatch: Regular Expression Pattern Matching. - (line 53) | + (line 53) * regmatch?: Regular Expression Pattern Matching. - (line 46) | + (line 46) * regmatchv: Regular Expression Pattern Matching. - (line 54) | + (line 54) * regsearch: Regular Expression Pattern Matching. - (line 51) | + (line 51) * regsearchv: Regular Expression Pattern Matching. - (line 52) | + (line 52) * release-arbiter: Process Synchronization. - (line 43) | -* rename-file: I/O-Extensions. (line 155) | + (line 43) +* rename-file: I/O-Extensions. (line 155) * renamed-identifier: Syntactic Hooks for Hygienic Macros. - (line 26) | + (line 26) * renaming-transformer: Syntactic Hooks for Hygienic Macros. - (line 142) | -* reopen-file: I/O-Extensions. (line 74) | -* require: Dynamic Linking. (line 11) | + (line 142) +* reopen-file: I/O-Extensions. (line 74) +* require: Dynamic Linking. (line 11) * resetty: Terminal Mode Setting. - (line 58) | -* restart: Internal State. (line 18) | -* restore_signals: Embedding SCM. (line 90) | -* rewinddir: I/O-Extensions. (line 97) | -* rmdir: I/O-Extensions. (line 140) | -* room: Internal State. (line 61) | + (line 58) +* restart: Internal State. (line 18) +* restore_signals: Embedding SCM. (line 90) +* rewinddir: I/O-Extensions. (line 97) +* rmdir: I/O-Extensions. (line 140) +* room: Internal State. (line 61) * savetty: Terminal Mode Setting. - (line 59) | -* scalar->array: Array Mapping. (line 51) | -* scm_evstr: Callbacks. (line 24) | -* scm_find_execpath: Embedding SCM. (line 36) | -* scm_find_implpath: Embedding SCM. (line 50) | -* scm_gc_protect: Changing Scm. (line 35) | -* scm_init_from_argv: Embedding SCM. (line 74) | -* scm_ldfile: Callbacks. (line 10) | -* scm_ldprog: Callbacks. (line 15) | -* scm_ldstr: Callbacks. (line 28) | -* scm_protect_temp: Changing Scm. (line 26) | -* scm_top_level: Embedding SCM. (line 93) | -* scope-trace: Debugging Continuations. | - (line 23) | -* script_count_argv: Script Support. (line 31) | -* script_find_executable: Script Support. (line 12) | -* script_process_argv: Script Support. (line 18) | -* scroll: Output. (line 79) | + (line 59) +* scalar->array: Array Mapping. (line 51) +* scm_evstr: Callbacks. (line 24) +* scm_find_execpath: Embedding SCM. (line 36) +* scm_find_implpath: Embedding SCM. (line 50) +* scm_gc_protect: Changing Scm. (line 35) +* scm_init_from_argv: Embedding SCM. (line 74) +* scm_ldfile: Callbacks. (line 10) +* scm_ldprog: Callbacks. (line 15) +* scm_ldstr: Callbacks. (line 28) +* scm_protect_temp: Changing Scm. (line 26) +* scm_top_level: Embedding SCM. (line 93) +* scope-trace: Debugging Continuations. + (line 23) +* script_count_argv: Script Support. (line 31) +* script_find_executable: Script Support. (line 12) +* script_process_argv: Script Support. (line 18) +* scroll: Output. (line 79) * scrollok: Output Options Setting. - (line 40) | -* serial-array-map!: Array Mapping. (line 39) | -* serial-array:copy!: Array Mapping. (line 15) | -* set!: Define and Set. (line 31) | -* setegid: Posix Extensions. (line 77) | -* seteuid: Posix Extensions. (line 81) | -* setgid: Posix Extensions. (line 73) | -* setgrent: Posix Extensions. (line 238) | + (line 40) +* serial-array-map!: Array Mapping. (line 39) +* serial-array:copy!: Array Mapping. (line 15) +* set!: Define and Set. (line 31) +* setegid: Posix Extensions. (line 77) +* seteuid: Posix Extensions. (line 81) +* setgid: Posix Extensions. (line 73) +* setgrent: Posix Extensions. (line 238) * sethostent: Host and Other Inquiries. - (line 26) | + (line 26) * setnetent: Host and Other Inquiries. - (line 47) | + (line 47) * setprotoent: Host and Other Inquiries. - (line 65) | -* setpwent: Posix Extensions. (line 217) | + (line 65) +* setpwent: Posix Extensions. (line 217) * setservent: Host and Other Inquiries. - (line 87) | -* setuid: Posix Extensions. (line 69) | -* short: Type Conversions. (line 25) | -* SHORT_ALIGN: Continuations. (line 28) | -* SIDEVAL: Evaluation. (line 92) | -* sinh: Numeric. (line 27) | + (line 87) +* setuid: Posix Extensions. (line 69) +* short: Type Conversions. (line 25) +* SHORT_ALIGN: Continuations. (line 28) +* SIDEVAL: Evaluation. (line 92) +* sinh: Numeric. (line 27) * socket-name:address: Internet Addresses and Socket Names. - (line 43) | + (line 43) * socket-name:family: Internet Addresses and Socket Names. - (line 37) | + (line 37) * socket-name:port-number: Internet Addresses and Socket Names. - (line 40) | -* socket:accept: Socket. (line 72) | -* socket:bind: Socket. (line 51) | -* socket:connect: Socket. (line 45) | -* socket:listen: Socket. (line 59) | -* socket:shutdown: Socket. (line 33) | -* stack-trace: Errors. (line 132) | -* STACK_GROWS_UP: Continuations. (line 48) | -* stack_size: Continuations. (line 54) | -* stat: I/O-Extensions. (line 10) | -* STREAM: Ptob Cells. (line 46) | + (line 40) +* socket:accept: Socket. (line 72) +* socket:bind: Socket. (line 51) +* socket:connect: Socket. (line 45) +* socket:listen: Socket. (line 59) +* socket:shutdown: Socket. (line 33) +* stack-trace: Errors. (line 132) +* STACK_GROWS_UP: Continuations. (line 48) +* stack_size: Continuations. (line 54) +* stat: I/O-Extensions. (line 10) +* STREAM: Ptob Cells. (line 46) * string-edit: Regular Expression Pattern Matching. - (line 104) | + (line 104) * string-split: Regular Expression Pattern Matching. - (line 96) | + (line 96) * string-splitv: Regular Expression Pattern Matching. - (line 97) | -* STRINGP: Header Cells. (line 44) | -* subwin: Window Manipulation. (line 14) | -* SYMBOLP: Header Cells. (line 32) | -* symlink: Unix Extensions. (line 12) | -* sync: Unix Extensions. (line 50) | + (line 97) +* STRINGP: Header Cells. (line 44) +* subwin: Window Manipulation. (line 14) +* SYMBOLP: Header Cells. (line 32) +* symlink: Unix Extensions. (line 12) +* sync: Unix Extensions. (line 50) * syntax-quote: Syntactic Hooks for Hygienic Macros. - (line 123) | -* syntax-rules: Syntax-Rules. (line 6) | -* tanh: Numeric. (line 29) | + (line 123) +* syntax-rules: Syntax-Rules. (line 6) +* tanh: Numeric. (line 29) * the-macro: Syntactic Hooks for Hygienic Macros. - (line 129) | -* throw_to_continuation: Continuations. (line 84) | -* ticks: Interrupts. (line 7) | -* ticks-interrupt: Interrupts. (line 17) | -* touchline: Window Manipulation. (line 55) | -* touchwin: Window Manipulation. (line 54) | + (line 129) +* throw_to_continuation: Continuations. (line 84) +* ticks: Interrupts. (line 7) +* ticks-interrupt: Interrupts. (line 17) +* touchline: Window Manipulation. (line 55) +* touchwin: Window Manipulation. (line 54) * trace: Debugging Scheme Code. - (line 41) | -* transpose-array: Conventional Arrays. (line 21) | + (line 41) +* transpose-array: Conventional Arrays. (line 21) * try-arbiter: Process Synchronization. - (line 39) | -* try-create-file: I/O-Extensions. (line 67) | -* try-load <1>: Line Numbers. (line 12) | -* try-load: Eval and Load. (line 7) | -* try-open-file: Opening and Closing. (line 8) | -* ttyname: Posix Extensions. (line 262) | -* TYP16: Cells. (line 29) | -* TYP3: Cells. (line 27) | -* TYP7: Cells. (line 28) | -* UCHARS: Header Cells. (line 36) | -* ulong2num: Type Conversions. (line 11) | -* umask: I/O-Extensions. (line 172) | -* uname: Posix Extensions. (line 172) | -* unctrl: Curses Miscellany. (line 30) | -* uniform-array-read!: Uniform Array. (line 67) | -* uniform-array-write: Uniform Array. (line 79) | + (line 39) +* try-create-file: I/O-Extensions. (line 67) +* try-load <1>: Line Numbers. (line 12) +* try-load: Eval and Load. (line 7) +* try-open-file: Opening and Closing. (line 8) +* ttyname: Posix Extensions. (line 262) +* TYP16: Cells. (line 29) +* TYP3: Cells. (line 27) +* TYP7: Cells. (line 28) +* UCHARS: Header Cells. (line 36) +* ulong2num: Type Conversions. (line 11) +* umask: I/O-Extensions. (line 172) +* uname: Posix Extensions. (line 172) +* unctrl: Curses Miscellany. (line 30) +* uniform-array-read!: Uniform Array. (line 67) +* uniform-array-write: Uniform Array. (line 79) * untrace: Debugging Scheme Code. - (line 49) | -* user-interrupt: Interrupts. (line 49) | -* usr:lib: Dynamic Linking. (line 18) | -* utime: I/O-Extensions. (line 167) | -* vector-set-length!: Storage. (line 7) | -* VECTORP: Header Cells. (line 16) | -* VELTS: Header Cells. (line 21) | -* verbose: Internal State. (line 33) | -* virtual-alarm: Interrupts. (line 31) | -* virtual-alarm-interrupt: Interrupts. (line 51) | -* vms-debug: SCM Session. (line 41) | -* void: Sweeping the Heap. (line 15) | -* wadd: Output. (line 11) | -* wait-for-input: Port Properties. (line 55) | -* waitpid: Posix Extensions. (line 124) | -* warn: Errors. (line 109) | -* wclear: Output. (line 41) | -* wclrtobot: Output. (line 47) | -* wclrtoeol: Output. (line 51) | -* wdelch: Output. (line 54) | -* wdeleteln: Output. (line 61) | -* werase: Output. (line 38) | -* winch: Input. (line 19) | -* winsch: Output. (line 67) | -* winsertln: Output. (line 74) | -* with-error-to-file: Port Redirection. (line 10) | -* with-error-to-port: Port Redirection. (line 21) | -* with-input-from-port: Port Redirection. (line 19) | -* with-output-to-port: Port Redirection. (line 20) | -* wmove: Window Manipulation. (line 65) | -* wstandend: Curses Miscellany. (line 8) | -* wstandout: Curses Miscellany. (line 7) | -* x:lib: Dynamic Linking. (line 23) | + (line 49) +* user-interrupt: Interrupts. (line 49) +* usr:lib: Dynamic Linking. (line 18) +* utime: I/O-Extensions. (line 167) +* vector-set-length!: Storage. (line 7) +* VECTORP: Header Cells. (line 16) +* VELTS: Header Cells. (line 21) +* verbose: Internal State. (line 33) +* virtual-alarm: Interrupts. (line 31) +* virtual-alarm-interrupt: Interrupts. (line 51) +* vms-debug: SCM Session. (line 41) +* void: Sweeping the Heap. (line 15) +* wadd: Output. (line 11) +* wait-for-input: Port Properties. (line 55) +* waitpid: Posix Extensions. (line 124) +* warn: Errors. (line 109) +* wclear: Output. (line 41) +* wclrtobot: Output. (line 47) +* wclrtoeol: Output. (line 51) +* wdelch: Output. (line 54) +* wdeleteln: Output. (line 61) +* werase: Output. (line 38) +* winch: Input. (line 19) +* winsch: Output. (line 67) +* winsertln: Output. (line 74) +* with-error-to-file: Port Redirection. (line 10) +* with-error-to-port: Port Redirection. (line 21) +* with-input-from-port: Port Redirection. (line 19) +* with-output-to-port: Port Redirection. (line 20) +* wmove: Window Manipulation. (line 65) +* wstandend: Curses Miscellany. (line 8) +* wstandout: Curses Miscellany. (line 7) +* x:lib: Dynamic Linking. (line 23) Variable Index ************** This is an alphabetical list of all the global variables in SCM. - + * Menu: -* $pi: Numeric. (line 14) | -* *argv*: SCM Variables. (line 25) | -* *execpath: Embedding SCM. (line 19) | -* *interactive* <1>: Internal State. (line 7) | -* *interactive*: SCM Variables. (line 36) | -* *load-pathname*: Eval and Load. (line 15) | -* *load-reader*: Line Numbers. (line 50) | -* *scm-version*: Internal State. (line 66) | -* *slib-load-reader*: Line Numbers. (line 51) | -* *syntax-rules*: SCM Variables. (line 30) | +* $pi: Numeric. (line 14) +* *argv*: SCM Variables. (line 25) +* *execpath: Embedding SCM. (line 19) +* *interactive* <1>: Internal State. (line 7) +* *interactive*: SCM Variables. (line 36) +* *load-pathname*: Eval and Load. (line 15) +* *load-reader*: Line Numbers. (line 50) +* *scm-version*: Internal State. (line 66) +* *slib-load-reader*: Line Numbers. (line 51) +* *syntax-rules*: SCM Variables. (line 30) * af_inet: Host and Other Inquiries. - (line 7) | + (line 7) * af_unix: Host and Other Inquiries. - (line 8) | -* BOOL_F: Immediates. (line 64) | -* BOOL_T: Immediates. (line 61) | -* EDITOR: SCM Variables. (line 18) | -* EOF_VAL: Immediates. (line 71) | -* EOL: Immediates. (line 67) | -* errobj: Errors. (line 82) | -* HOME: SCM Variables. (line 14) | -* internal-time-units-per-second: Time. (line 7) | -* INUM0: Immediates. (line 32) | -* isymnames: Immediates. (line 106) | -* most-negative-fixnum: Numeric. (line 11) | -* most-positive-fixnum: Numeric. (line 7) | -* NUM_ISPCSYM: Immediates. (line 110) | -* NUM_ISYMS: Immediates. (line 111) | -* open_both: Opening and Closing. (line 20) | -* open_read: Opening and Closing. (line 18) | -* open_write: Opening and Closing. (line 19) | -* pi: Numeric. (line 15) | -* SCHEME_LIBRARY_PATH: SCM Variables. (line 11) | -* SCM_INIT_PATH: SCM Variables. (line 7) | -* symhash: Evaluation. (line 51) | -* thrown_value: Continuations. (line 51) | -* UNDEFINED: Immediates. (line 74) | -* UNSPECIFIED: Immediates. (line 78) | + (line 8) +* BOOL_F: Immediates. (line 64) +* BOOL_T: Immediates. (line 61) +* EDITOR: SCM Variables. (line 18) +* EOF_VAL: Immediates. (line 71) +* EOL: Immediates. (line 67) +* errobj: Errors. (line 82) +* HOME: SCM Variables. (line 14) +* internal-time-units-per-second: Time. (line 7) +* INUM0: Immediates. (line 32) +* isymnames: Immediates. (line 106) +* most-negative-fixnum: Numeric. (line 11) +* most-positive-fixnum: Numeric. (line 7) +* NUM_ISPCSYM: Immediates. (line 110) +* NUM_ISYMS: Immediates. (line 111) +* open_both: Opening and Closing. (line 20) +* open_read: Opening and Closing. (line 18) +* open_write: Opening and Closing. (line 19) +* pi: Numeric. (line 15) +* SCHEME_LIBRARY_PATH: SCM Variables. (line 11) +* SCM_INIT_PATH: SCM Variables. (line 7) +* symhash: Evaluation. (line 51) +* thrown_value: Continuations. (line 51) +* UNDEFINED: Immediates. (line 74) +* UNSPECIFIED: Immediates. (line 78) Type Index ********** This is an alphabetical list of data types and feature names in SCM. - + * Menu: * #! <1>: MS-DOS Compatible Scripts. - (line 15) | -* #!: Unix Scheme Scripts. (line 11) | -* array-for-each: Array Mapping. (line 6) | -* CELLPTR: Immediates. (line 129) | -* CONTINUATION: Continuations. (line 22) | -* curses: Dynamic Linking. (line 49) | -* dump: Dump. (line 6) | -* FARLOC: Evaluation. (line 63) | -* GLOC: Evaluation. (line 74) | -* gloc: Immediates. (line 126) | -* i/o-extensions: Socket. (line 10) | -* ichr: Immediates. (line 45) | -* iflags: Immediates. (line 58) | -* ILOC: Evaluation. (line 56) | -* iloc: Immediates. (line 123) | -* inum: Immediates. (line 16) | -* ispcsym: Immediates. (line 120) | -* isym: Immediates. (line 115) | -* meta-argument <1>: Script Support. (line 21) | -* meta-argument: Unix Scheme Scripts. (line 11) | -* ptob: Ptob Cells. (line 6) | -* regex <1>: Sequence Comparison. (line 6) | -* regex: Dynamic Linking. (line 64) | -* rev2-procedures: Dynamic Linking. (line 37) | -* rev3-procedures: Dynamic Linking. (line 38) | + (line 15) +* #!: Unix Scheme Scripts. (line 11) +* array-for-each: Array Mapping. (line 6) +* CELLPTR: Immediates. (line 129) +* CONTINUATION: Continuations. (line 22) +* curses: Dynamic Linking. (line 49) +* dump: Dump. (line 6) +* FARLOC: Evaluation. (line 63) +* GLOC: Evaluation. (line 74) +* gloc: Immediates. (line 126) +* i/o-extensions: Socket. (line 10) +* ichr: Immediates. (line 45) +* iflags: Immediates. (line 58) +* ILOC: Evaluation. (line 56) +* iloc: Immediates. (line 123) +* inum: Immediates. (line 16) +* ispcsym: Immediates. (line 120) +* isym: Immediates. (line 115) +* meta-argument <1>: Script Support. (line 21) +* meta-argument: Unix Scheme Scripts. (line 11) +* ptob: Ptob Cells. (line 6) +* regex <1>: Sequence Comparison. (line 6) +* regex: Dynamic Linking. (line 64) +* rev2-procedures: Dynamic Linking. (line 37) +* rev3-procedures: Dynamic Linking. (line 38) * Scheme Script <1>: MS-DOS Compatible Scripts. - (line 15) | -* Scheme Script: Unix Scheme Scripts. (line 11) | + (line 15) +* Scheme Script: Unix Scheme Scripts. (line 11) * Scheme-Script <1>: MS-DOS Compatible Scripts. - (line 15) | -* Scheme-Script: Unix Scheme Scripts. (line 11) | -* smob: Smob Cells. (line 6) | -* socket: Socket. (line 87) | -* spare: Header Cells. (line 10) | -* STACKITEM: Continuations. (line 33) | -* tc16_arbiter: Smob Cells. (line 72) | -* tc16_array: Smob Cells. (line 78) | -* tc16_bigneg: Smob Cells. (line 37) | -* tc16_bigpos: Smob Cells. (line 36) | -* tc16_flo: Smob Cells. (line 18) | -* tc16_inpipe: Ptob Cells. (line 21) | -* tc16_inport: Ptob Cells. (line 12) | -* tc16_ioport: Ptob Cells. (line 18) | -* tc16_macro: Smob Cells. (line 75) | -* tc16_outpipe: Ptob Cells. (line 24) | -* tc16_outport: Ptob Cells. (line 15) | -* tc16_promise: Smob Cells. (line 69) | -* tc16_sfport: Ptob Cells. (line 30) | -* tc16_strport: Ptob Cells. (line 27) | -* 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_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_msymbol: Header Cells. (line 29) | -* tc7_rpsubr: Subr Cells. (line 47) | -* tc7_specfun: Header Cells. (line 79) | -* 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_vector: Header Cells. (line 13) | -* 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) | + (line 15) +* Scheme-Script: Unix Scheme Scripts. (line 11) +* smob: Smob Cells. (line 6) +* socket: Socket. (line 87) +* spare: Header Cells. (line 10) +* STACKITEM: Continuations. (line 33) +* tc16_arbiter: Smob Cells. (line 72) +* tc16_array: Smob Cells. (line 78) +* tc16_bigneg: Smob Cells. (line 37) +* tc16_bigpos: Smob Cells. (line 36) +* tc16_flo: Smob Cells. (line 18) +* tc16_inpipe: Ptob Cells. (line 21) +* tc16_inport: Ptob Cells. (line 12) +* tc16_ioport: Ptob Cells. (line 18) +* tc16_macro: Smob Cells. (line 75) +* tc16_outpipe: Ptob Cells. (line 24) +* tc16_outport: Ptob Cells. (line 15) +* tc16_promise: Smob Cells. (line 69) +* tc16_sfport: Ptob Cells. (line 30) +* tc16_strport: Ptob Cells. (line 27) +* 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_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_msymbol: Header Cells. (line 29) +* tc7_rpsubr: Subr Cells. (line 47) +* tc7_specfun: Header Cells. (line 79) +* 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_vector: Header Cells. (line 13) +* 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: * !#: MS-DOS Compatible Scripts. - (line 8) | + (line 8) * !#.exe: MS-DOS Compatible Scripts. - (line 8) | + (line 8) * #!: MS-DOS Compatible Scripts. - (line 8) | + (line 8) * #!.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) | -* 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) | -* continuations: Continuations. (line 6) | -* curses: Build Options. (line 237) | -* debug: Build Options. (line 240) | -* differ: Build Options. (line 245) | + (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) +* 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) +* continuations: Continuations. (line 6) +* curses: Build Options. (line 237) +* debug: Build Options. (line 240) +* differ: Build Options. (line 245) * documentation string: Documentation and Comments. - (line 13) | -* dump: Build Options. (line 248) | -* dynamic-linking: Build Options. (line 251) | + (line 13) +* dump: Build Options. (line 248) +* dynamic-linking: Build Options. (line 251) * ecache: Memory Management for Environments. - (line 6) | -* edit-line: Build Options. (line 254) | -* Embedding SCM: Embedding SCM. (line 6) | -* engineering-notation: Build Options. (line 257) | + (line 6) +* edit-line: Build Options. (line 254) +* Embedding SCM: Embedding SCM. (line 6) +* engineering-notation: Build Options. (line 257) * environments: Memory Management for Environments. - (line 6) | + (line 6) * exchanger: Process Synchronization. - (line 6) | -* Exrename: Bibliography. (line 26) | + (line 6) +* Exrename: Bibliography. (line 26) * Extending Scm: Compiling and Linking Custom Files. - (line 13) | + (line 13) * foo.c: Compiling and Linking Custom Files. - (line 13) | -* generalized-c-arguments: Build Options. (line 262) | -* graphics: Packages. (line 23) | -* hobbit: Packages. (line 23) | -* i/o-extensions: Build Options. (line 265) | -* IEEE: Bibliography. (line 7) | -* inexact: Build Options. (line 269) | -* JACAL: Bibliography. (line 49) | -* lit: Build Options. (line 272) | -* macro: Build Options. (line 275) | + (line 13) +* generalized-c-arguments: Build Options. (line 262) +* graphics: Packages. (line 23) +* hobbit: Packages. (line 23) +* i/o-extensions: Build Options. (line 265) +* IEEE: Bibliography. (line 7) +* inexact: Build Options. (line 269) +* JACAL: Bibliography. (line 49) +* lit: Build Options. (line 272) +* macro: Build Options. (line 275) * memory management: Memory Management for Environments. - (line 6) | -* mysql: Build Options. (line 279) | -* no-heap-shrink: Build Options. (line 282) | + (line 6) +* mysql: Build Options. (line 279) +* no-heap-shrink: Build Options. (line 282) * NO_ENV_CACHE: Memory Management for Environments. - (line 89) | -* none: Build Options. (line 287) | -* posix: Posix Extensions. (line 6) | -* Posix: Posix Extensions. (line 6) | -* posix: Build Options. (line 290) | -* 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) | -* 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: Bibliography. (line 30) | -* signals: Signals. (line 6) | -* Simply: Bibliography. (line 35) | -* single-precision-only: Build Options. (line 325) | -* 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) | -* 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) | -* X: Packages. (line 23) | -* x <1>: Packages. (line 23) | -* x: Build Options. (line 359) | -* xlib: Packages. (line 23) | -* Xlib: Packages. (line 23) | -* xlib: Build Options. (line 362) | -* xlibscm: Packages. (line 23) | -* Xlibscm: Packages. (line 23) | + (line 89) +* none: Build Options. (line 287) +* posix: Posix Extensions. (line 6) +* Posix: Posix Extensions. (line 6) +* posix: Build Options. (line 290) +* 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) +* 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: Bibliography. (line 30) +* signals: Signals. (line 6) +* Simply: Bibliography. (line 35) +* single-precision-only: Build Options. (line 325) +* 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) +* 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) +* X: Packages. (line 23) +* x <1>: Packages. (line 23) +* x: Build Options. (line 359) +* xlib: Packages. (line 23) +* Xlib: Packages. (line 23) +* xlib: Build Options. (line 362) +* xlibscm: Packages. (line 23) +* Xlibscm: Packages. (line 23) Tag Table: -Node: Top217 -Node: Overview1536 -Node: SCM Features1989 -Node: SCM Authors4143 -Node: Copying5180 -Node: The SCM License5992 -Node: SIOD copyright11557 -Node: Bibliography13107 -Node: Installing SCM15109 -Node: Making SCM15754 -Node: SLIB16819 -Node: Building SCM18877 -Node: Invoking Build19585 -Node: Build Options22040 -Node: Compiling and Linking Custom Files39431 -Node: Installing Dynamic Linking41522 -Node: Configure Module Catalog43406 -Node: Saving Images45624 -Node: Automatic C Preprocessor Definitions46431 -Node: Problems Compiling50361 -Node: Problems Linking52136 -Node: Problems Running52527 -Node: Testing54761 -Node: Reporting Problems58062 -Node: Operational Features59026 -Node: Invoking SCM59588 -Node: SCM Options61368 -Node: Invocation Examples67150 -Node: SCM Variables68222 -Node: SCM Session70260 -Node: Editing Scheme Code72358 -Node: Debugging Scheme Code74649 -Node: Debugging Continuations80426 -Node: Errors87427 -Node: Memoized Expressions92326 -Node: Internal State94798 -Node: Scripting98885 -Node: Unix Scheme Scripts99319 -Node: MS-DOS Compatible Scripts102600 -Node: Unix Shell Scripts104740 -Node: The Language107016 -Node: Standards Compliance107768 -Node: Storage110334 -Node: Time113210 -Node: Interrupts114573 -Node: Process Synchronization118905 -Node: Files and Ports120751 -Node: Opening and Closing121212 -Node: Port Properties124312 -Node: Port Redirection127860 -Node: Soft Ports129689 -Node: Eval and Load131650 -Node: Line Numbers133499 -Node: Lexical Conventions136895 -Node: Common-Lisp Read Syntax137333 -Node: Load Syntax140333 -Node: Documentation and Comments141730 -Node: Modifying Read Syntax143385 -Node: Syntax145660 -Node: Define and Set146702 -Node: Defmacro150533 -Node: Syntax-Rules151743 -Node: Macro Primitives153671 -Node: Environment Frames155625 -Node: Syntactic Hooks for Hygienic Macros158186 -Node: Packages165692 -Node: Dynamic Linking166822 -Node: Dump171974 -Node: Numeric176337 -Node: Arrays180022 -Node: Conventional Arrays180378 -Node: Uniform Array184368 -Node: Bit Vectors189849 -Node: Array Mapping191571 -Node: Records194838 -Node: I/O-Extensions195880 -Node: Posix Extensions205962 -Node: Unix Extensions217519 -Node: Sequence Comparison219966 -Node: Regular Expression Pattern Matching220814 -Node: Line Editing225399 -Node: Curses227122 -Node: Output Options Setting228310 -Node: Terminal Mode Setting231348 -Node: Window Manipulation235160 -Node: Output239259 -Node: Input243747 -Node: Curses Miscellany245089 -Node: Sockets246858 -Node: Host and Other Inquiries247434 -Node: Internet Addresses and Socket Names251582 -Node: Socket253599 -Node: SCMDB261367 -Node: The Implementation262229 -Node: Data Types262689 -Node: Immediates263648 -Node: Cells269986 -Node: Header Cells273065 -Node: Subr Cells277878 -Node: Ptob Cells280896 -Node: Smob Cells283832 -Node: Data Type Representations287795 -Node: Operations292828 -Node: Garbage Collection293552 -Node: Marking Cells294295 -Node: Sweeping the Heap296714 -Node: Memory Management for Environments297826 -Node: Signals302473 -Node: C Macros304436 -Node: Changing Scm305798 -Node: Defining Subrs310460 -Node: Defining Smobs312471 -Node: Defining Ptobs315703 -Node: Allocating memory317010 -Node: Embedding SCM319539 -Node: Callbacks327837 -Node: Type Conversions329939 -Node: Continuations334522 -Node: Evaluation339275 -Node: Program Self-Knowledge344895 -Node: File-System Habitat345255 -Node: Executable Pathname348997 -Node: Script Support350834 -Node: Improvements To Make352348 -Node: VMS Dynamic Linking354705 -Node: Index359712 +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 End Tag Table @@ -1,5 +1,5 @@ %define name scm -%define version 5e1 +%define version 5e2 %define release 1 %define implpath %{prefix}/lib/scm %define slibpath %{prefix}/lib/slib @@ -533,34 +533,34 @@ low priority. SLIB is available from the same sites as SCM: @ifclear html @itemize @bullet @item -swiss.csail.mit.edu:/pub/scm/slib3a2.tar.gz +swiss.csail.mit.edu:/pub/scm/slib3a3.tar.gz @item -ftp.gnu.org:/pub/gnu/jacal/slib3a2.tar.gz +ftp.gnu.org:/pub/gnu/jacal/slib3a3.tar.gz @item -ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a2.tar.gz +ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib3a3.tar.gz @end itemize @end ifclear @ifset html @itemize @bullet @item -<A HREF="http://swiss.csail.mit.edu/ftpdir/scm/slib3a2.zip"> -http://swiss.csail.mit.edu/ftpdir/scm/slib3a2.zip +<A HREF="http://swiss.csail.mit.edu/ftpdir/scm/slib3a3.zip"> +http://swiss.csail.mit.edu/ftpdir/scm/slib3a3.zip </A> @item -<A HREF="ftp://ftp.gnu.org/pub/gnu/jacal/slib3a2.tar.gz"> -ftp.gnu.org:/pub/gnu/jacal/slib3a2.tar.gz +<A HREF="ftp://ftp.gnu.org/pub/gnu/jacal/slib3a3.tar.gz"> +ftp.gnu.org:/pub/gnu/jacal/slib3a3.tar.gz </A> @item -<A HREF="ftp://ftp.cs.indiana.edu/pub/scheme-repository/code/lib/slib3a2.tar.gz"> -ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/slib3a2.tar.gz +<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> @end itemize @end ifset @noindent -Unpack SLIB (@samp{tar xzf slib3a2.tar.gz} or @samp{unzip -ao -slib3a2.zip}) in an appropriate directory for your system; both +Unpack SLIB (@samp{tar xzf slib3a3.tar.gz} or @samp{unzip -ao +slib3a3.zip}) in an appropriate directory for your system; both @code{tar} and @code{unzip} will create the directory @file{slib}. @noindent @@ -1054,6 +1054,7 @@ the compilation command lines or add a @code{#define @var{flag}} line to ARM_ULIB Huw Rogers free unix library for acorn archimedes AZTEC_C Aztec_C 5.2a __CYGWIN__ Cygwin +__CYGWIN32__ Cygwin _DCC Dice C on AMIGA __GNUC__ Gnu CC (and DJGPP) __EMX__ Gnu C port (gcc/emx 0.8e) to OS/2 2.0 @@ -1083,6 +1084,7 @@ linux Linux macintosh Macintosh (THINK_C and __MWERKS__ define) MCH_AMIGA Aztec_c 5.2a on AMIGA __MACH__ Apple Darwin +__MINGW32__ MinGW - Minimalist GNU for Windows MSDOS Microsoft C 5.10 and 6.00A _MSDOS Microsoft CLARM and CLTHUMB compilers. __MSDOS__ Turbo C, Borland C, and DJGPP @@ -1124,6 +1126,7 @@ sparc SPARC processor sequent Sequent computer tahoe CCI Tahoe processor vax VAX processor +__x86_64 AMD Opteron @end example @node Problems Compiling, Problems Linking, Automatic C Preprocessor Definitions, Installing SCM @@ -4052,7 +4055,7 @@ identifiers defined in the file accessible as Scheme procedures. @defun dyn:main-call name link-token arg1 @dots{} @var{link-token} should be the value returned by a call to @code{dyn:link}. @var{name} should be the name of C function of 2 -arguments, @code{(int argc, char **argv)}, defined in the file named +arguments, @code{(int argc, const char **argv)}, defined in the file named @var{filename} which was succesfully @code{dyn:link}ed in the current SCM session. The @code{dyn:main-call} procedure calls the C function corresponding to @var{name} with @code{argv} style arguments, such as @@ -7865,7 +7868,7 @@ SCM user_main() int main(argc, argv) int argc; - char **argv; + const char **argv; @{ SCM retval; char *implpath, *execpath; @@ -8382,7 +8385,7 @@ for the first occurrence. Thus, it is advisable to invoke @code{dld_init} as: @example -main (int argc, char **argv) +main (int argc, const char **argv) @{ @dots{} if (dld_init (dld_find_executable (argv[0]))) @{ @@ -53,7 +53,7 @@ #endif /* MS Windows signal handling hack added by Rainer Urian */ -/* +/* SCM crashes on WindowsNT after hitting control-c. This is because signal handling in windows console applications is @@ -285,6 +285,10 @@ rgx.c init_rgx(); regcomp and regexec. */ # define SHORT_INT # define CDR_DOUBLES #endif +#ifdef __x86_64 +# define SHORT_INT +# define CDR_DOUBLES +#endif #ifdef MSDOS /* Microsoft C 5.10 and 6.00A */ # ifndef GO32 # define SHORT_INT @@ -373,8 +377,8 @@ rgx.c init_rgx(); regcomp and regexec. */ # define LACK_SBRK #endif -#ifdef __CYGWIN32__ -# define LACK_FTIME +#ifdef __CYGWIN__ +/* # define LACK_FTIME */ # define HAVE_SELECT # define HAVE_SYS_TIME_H # undef MSDOS @@ -447,6 +451,19 @@ rgx.c init_rgx(); regcomp and regexec. */ # endif #endif +#ifndef __builtin_expect +# ifndef __GNUC__ +# define __builtin_expect(expr, expected) (expr) +# else +# if (__GNUC__ < 3) +# define __builtin_expect(expr, expected) (expr) +# endif +# endif +#endif + +#define SCM_EXPECT_TRUE(expr) (__builtin_expect(expr, !0)) +#define SCM_EXPECT_FALSE(expr) (__builtin_expect(expr, 0)) + #ifdef __GNUC__ # define FENCE asm volatile ("") #else @@ -533,9 +550,9 @@ extern ints_infot *ints_info; /* FIXABLE is non-null if its long argument can be encoded in an INUM. */ -#define POSFIXABLE(n) ((n) <= MOST_POSITIVE_FIXNUM) -#define NEGFIXABLE(n) ((n) >= MOST_NEGATIVE_FIXNUM) -#define UNEGFIXABLE(n) ((n) <= -MOST_NEGATIVE_FIXNUM) +#define POSFIXABLE(n) SCM_EXPECT_TRUE((n) <= MOST_POSITIVE_FIXNUM) +#define NEGFIXABLE(n) SCM_EXPECT_TRUE((n) >= MOST_NEGATIVE_FIXNUM) +#define UNEGFIXABLE(n) SCM_EXPECT_TRUE((n) <= -MOST_NEGATIVE_FIXNUM) #define FIXABLE(n) (POSFIXABLE(n) && NEGFIXABLE(n)) /* The following 8 definitions are defined automatically by the C @@ -664,6 +681,13 @@ extern ints_infot *ints_info; # endif #endif +#ifdef FLOATS +# ifndef __MINGW32__ +/* Also asinh and acosh */ +# define HAVE_ATANH +# endif +#endif + #ifdef unix # define HAVE_UNIX #endif @@ -71,7 +71,7 @@ #endif char *scm_find_implpath(execpath) - char *execpath; + const char *execpath; { char *implpath = 0; #ifndef nosve @@ -97,7 +97,7 @@ char *scm_find_implpath(execpath) #endif return implpath; } -char *generic_name[] = { GENERIC_NAME }; +const char * const generic_name[] = { GENERIC_NAME }; #ifdef WINSIGNALS SCM_EXPORT HANDLE scm_hMainThread; @@ -107,7 +107,7 @@ void scmmain_init_user_scm(); int main(argc, argv) int argc; - char **argv; + const char **argv; { char *script_arg = 0; /* location of SCSH style script file or 0. */ char *implpath = 0, **nargv; @@ -166,7 +166,7 @@ char *script_find_executable(name) string if successful, 0 if not */ char *find_impl_file(exec_path, generic_name, initname, sep) - char *exec_path; + const char *exec_path; const char *generic_name, *initname, *sep; { char *sepptr = strrchr(exec_path, sep[0]); @@ -361,7 +361,7 @@ endarg: } int script_meta_arg_P(arg) - char *arg; + const char *arg; { if ('\\' != arg[0]) return 0L; #ifdef MSDOS @@ -377,7 +377,7 @@ int script_meta_arg_P(arg) char **script_process_argv(argc, argv) int argc; - char **argv; + const char **argv; { int nargc = argc, argi = 1, nargi = 1; char *narg, **nargv; @@ -406,7 +406,7 @@ char **script_process_argv(argc, argv) } int script_count_argv(argv) - char **argv; + const char **argv; { int argc = 0; while (argv[argc]) argc++; @@ -115,6 +115,7 @@ SCM l_network (host) return ulong2num(0L+inet_netof(addr)); } +#ifndef __CYGWIN__ static char s_lna[] = "inet:local-network-address"; SCM l_lna (host) SCM host; @@ -123,6 +124,7 @@ SCM l_lna (host) addr.s_addr = htonl(num2ulong(host, (char *)ARG1, s_lna)); return ulong2num(0L+inet_lnaof(addr)); } +#endif static char s_makaddr[] = "inet:make-address"; SCM l_makaddr (net, lna) @@ -135,6 +137,7 @@ SCM l_makaddr (net, lna) return ulong2num(ntohl(addr.s_addr)); } +#ifndef __CYGWIN__ static char s_hostinfo[] = "gethost"; SCM l_hostinfo(name) SCM name; @@ -144,15 +147,15 @@ SCM l_hostinfo(name) SCM lst = EOL; struct hostent *entry; struct in_addr inad; - char **argv; + const char **argv; int i = 0; -#ifndef linux - if UNBNDP(name) { +# ifndef linux + if (UNBNDP(name)) { DEFER_INTS; SYSCALL(entry = gethostent();); } else -#endif +# endif if (NIMP(name) && STRINGP(name)) { DEFER_INTS; SYSCALL(entry = gethostbyname(CHARS(name));); @@ -185,7 +188,7 @@ SCM l_netinfo(name) SCM ans = make_vector(MAKINUM(4), UNSPECIFIED); SCM *ve = VELTS(ans); struct netent *entry; - if UNBNDP(name) { + if (UNBNDP(name)) { DEFER_INTS; SYSCALL(entry = getnetent();); } @@ -207,6 +210,7 @@ SCM l_netinfo(name) ve[ 3] = ulong2num(entry->n_net + 0L); return ans; } +#endif static char s_protoinfo[] = "getproto"; SCM l_protoinfo(name) SCM name; @@ -214,7 +218,7 @@ SCM l_protoinfo(name) SCM ans = make_vector(MAKINUM(3), UNSPECIFIED); SCM *ve = VELTS(ans); struct protoent *entry; - if UNBNDP(name) { + if (UNBNDP(name)) { DEFER_INTS; SYSCALL(entry = getprotoent();); } @@ -243,7 +247,7 @@ SCM l_servinfo(args) SCM *ve = VELTS(ans); SCM name, proto; struct servent *entry; - if NULLP(args) { + if (NULLP(args)) { DEFER_INTS; SYSCALL(entry = getservent();); goto comlab; @@ -273,28 +277,30 @@ SCM l_servinfo(args) SCM l_sethost(arg) SCM arg; { - if UNBNDP(arg) endhostent(); + if (UNBNDP(arg)) endhostent(); else sethostent(NFALSEP(arg)); return UNSPECIFIED; } +#ifndef __CYGWIN__ SCM l_setnet(arg) SCM arg; { - if UNBNDP(arg) endnetent(); + if (UNBNDP(arg)) endnetent(); else setnetent(NFALSEP(arg)); return UNSPECIFIED; } +#endif SCM l_setproto(arg) SCM arg; { - if UNBNDP(arg) endprotoent(); + if (UNBNDP(arg)) endprotoent(); else setprotoent(NFALSEP(arg)); return UNSPECIFIED; } SCM l_setserv(arg) SCM arg; { - if UNBNDP(arg) endservent(); + if (UNBNDP(arg)) endservent(); else setservent(NFALSEP(arg)); return UNSPECIFIED; } @@ -307,7 +313,7 @@ SCM l_socket(fam, proto) FILE* f; SCM port; ASRTER(INUMP(fam), fam, ARG1, s_socket); - if UNBNDP(proto) proto = INUM0; + if (UNBNDP(proto)) proto = INUM0; else ASRTER(INUMP(proto), proto, ARG2, s_socket); NEWCELL(port); DEFER_INTS; @@ -342,7 +348,7 @@ SCM l_socketpair(fam, proto) FILE* f[2]; SCM port[2]; ASRTER(INUMP(fam), fam, ARG1, s_socketpair); - if UNBNDP(proto) proto = INUM0; + if (UNBNDP(proto)) proto = INUM0; else ASRTER(INUMP(proto), proto, ARG2, s_socketpair); NEWCELL(port[0]); NEWCELL(port[1]); DEFER_INTS; @@ -383,7 +389,7 @@ SCM l_shutdown(port, how) break; case 2: CAR(port) &= ~(RDNG | WRTNG); } - if SOCKP(port) close_port(port); /* can't read or write */ + if (SOCKP(port)) close_port(port); /* can't read or write */ return port; } static char s_unkfam[] = "unknown-family"; @@ -627,8 +633,9 @@ static iproc subr1s[] = { {s_inetaddr, l_inetaddr}, {s_inetstr, l_inetstr}, {s_network, l_network}, +#ifndef __CYGWIN__ {s_lna, l_lna}, - +#endif {s_accept, l_accept}, {s_sknm_family, l_sknm_family}, {s_sknm_port_num, l_sknm_port_num}, @@ -638,11 +645,13 @@ static iproc subr1s[] = { {0, 0}}; static iproc subr1os[] = { + {s_protoinfo, l_protoinfo}, +#ifndef __CYGWIN__ {s_hostinfo, l_hostinfo}, {s_netinfo, l_netinfo}, - {s_protoinfo, l_protoinfo}, - {"sethostent", l_sethost}, {"setnetent", l_setnet}, +#endif + {"sethostent", l_sethost}, {"setprotoent", l_setproto}, {"setservent", l_setserv}, {0, 0}}; @@ -60,7 +60,7 @@ static char s_symbol2string[] = "symbol->string", extern char s_inexactp[]; #define s_exactp (s_inexactp+2) static char s_oddp[] = "odd?", s_evenp[] = "even?"; -static char s_abs[] = "abs", s_quotient[] = "quotient", +static char s_quotient[] = "quotient", s_remainder[] = "remainder", s_modulo[] = "modulo"; static char s_gcd[] = "gcd"; @@ -108,7 +108,7 @@ SCM eq(x, y) SCM consp(x) SCM x; { - if IMP(x) return BOOL_F; + if (IMP(x)) return BOOL_F; return CONSP(x) ? BOOL_T : BOOL_F; } SCM setcar(pair, value) @@ -136,12 +136,12 @@ long ilength(sx) register long i = 0; register SCM x = sx; do { - if IMP(x) return NULLP(x) ? i : -1; - if NCONSP(x) return -2; + if (IMP(x)) return NULLP(x) ? i : -1; + if (NCONSP(x)) return -2; x = CDR(x); i++; - if IMP(x) return NULLP(x) ? i : -1; - if NCONSP(x) return -2; + if (IMP(x)) return NULLP(x) ? i : -1; + if (NCONSP(x)) return -2; x = CDR(x); i++; sx = CDR(sx); @@ -172,7 +172,7 @@ SCM append(args) { SCM res = EOL; SCM *lloc = &res, arg; - if IMP(args) { + if (IMP(args)) { ASRTER(NULLP(args), args, ARGn, s_append); return res; } @@ -180,7 +180,7 @@ SCM append(args) while (1) { arg = CAR(args); args = CDR(args); - if IMP(args) { + if (IMP(args)) { *lloc = arg; ASRTER(NULLP(args), args, ARGn, s_append); return res; @@ -236,7 +236,7 @@ SCM member(x, lst) { for(;NIMP(lst);lst = CDR(lst)) { ASRTER(CONSP(lst), lst, ARG2, s_member); - if NFALSEP(equal(CAR(lst), x)) return lst; + if (NFALSEP(equal(CAR(lst), x))) return lst; } ASRTER(NULLP(lst), lst, ARG2, s_member); return BOOL_F; @@ -262,7 +262,7 @@ SCM assoc(x, alist) ASRTER(CONSP(alist), alist, ARG2, s_assoc); tmp = CAR(alist); ASRTER(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assoc); - if NFALSEP(equal(CAR(tmp), x)) return tmp; + if (NFALSEP(equal(CAR(tmp), x))) return tmp; } ASRTER(NULLP(alist), alist, ARG2, s_assoc); return BOOL_F; @@ -278,7 +278,7 @@ SCM promisep(x) SCM symbolp(x) SCM x; { - if IMP(x) return BOOL_F; + if (IMP(x)) return BOOL_F; return SYMBOLP(x) ? BOOL_T : BOOL_F; } SCM symbol2string(s) @@ -298,7 +298,7 @@ SCM string2symbol(s) SCM exactp(x) SCM x; { - if INUMP(x) return BOOL_T; + if (INUMP(x)) return BOOL_T; #ifdef BIGDIG if (NIMP(x) && BIGP(x)) return BOOL_T; #endif @@ -308,7 +308,7 @@ SCM oddp(n) SCM n; { #ifdef BIGDIG - if NINUMP(n) { + if (NINUMP(n)) { ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_oddp); return (1 & BDIGITS(n)[0]) ? BOOL_T : BOOL_F; } @@ -321,7 +321,7 @@ SCM evenp(n) SCM n; { #ifdef BIGDIG - if NINUMP(n) { + if (NINUMP(n)) { ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_evenp); return (1 & BDIGITS(n)[0]) ? BOOL_F : BOOL_T; } @@ -330,37 +330,15 @@ SCM evenp(n) #endif return (4 & (int)n) ? BOOL_F : BOOL_T; } -SCM absval(x) - SCM x; -{ -#ifdef BIGDIG - if NINUMP(x) { - ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_abs); - if (TYP16(x)==tc16_bigpos) return x; - return copybig(x, 0); - } -#else - ASRTER(INUMP(x), x, ARG1, s_abs); -#endif - if (INUM(x) >= 0) return x; - x = -INUM(x); - if (!POSFIXABLE(x)) -#ifdef BIGDIG - return long2big(x); -#else - wta(MAKINUM(-x), (char *)OVFLOW, s_abs); -#endif - return MAKINUM(x); -} SCM lquotient(x, y) SCM x, y; { register long z; #ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { long w; ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_quotient); - if NINUMP(y) { + if (NINUMP(y)) { ASRTGO(NIMP(y) && BIGP(y), bady); return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), BIGSIGN(x) ^ BIGSIGN(y), 2); @@ -386,7 +364,7 @@ SCM lquotient(x, y) } # endif } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) bady: wta(y, (char *)ARG2, s_quotient); @@ -427,9 +405,9 @@ SCM lremainder(x, y) { register long z; #ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_remainder); - if NINUMP(y) { + if (NINUMP(y)) { ASRTGO(NIMP(y) && BIGP(y), bady); return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), BIGSIGN(x), 0); @@ -437,7 +415,7 @@ SCM lremainder(x, y) if (!(z = INUM(y))) goto ov; return divbigint(x, z, BIGSIGN(x), 0); } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) bady: wta(y, (char *)ARG2, s_remainder); @@ -468,9 +446,9 @@ SCM modulo(x, y) { register long yy, z; #ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_modulo); - if NINUMP(y) { + if (NINUMP(y)) { ASRTGO(NIMP(y) && BIGP(y), bady); return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y), BIGSIGN(y), (BIGSIGN(x) ^ BIGSIGN(y)) ? 1 : 0); @@ -478,7 +456,7 @@ SCM modulo(x, y) if (!(z = INUM(y))) goto ov; return divbigint(x, z, z < 0, (BIGSIGN(x) ? (z > 0) : (z < 0)) ? 1 : 0); } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) bady: wta(y, (char *)ARG2, s_modulo); @@ -505,16 +483,16 @@ SCM lgcd(x, y) { register long u, v, k, t; tailrec: - if UNBNDP(y) return UNBNDP(x) ? INUM0 : x; + if (UNBNDP(y)) return UNBNDP(x) ? INUM0 : x; #ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { big_gcd: ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_gcd); - if BIGSIGN(x) x = copybig(x, 0); + if (BIGSIGN(x)) x = copybig(x, 0); newy: - if NINUMP(y) { + if (NINUMP(y)) { ASRTER(NIMP(y) && BIGP(y), y, ARG2, s_gcd); - if BIGSIGN(y) y = copybig(y, 0); + if (BIGSIGN(y)) y = copybig(y, 0); switch (bigcomp(x, y)) { case -1: swaprec: t = lremainder(x, y); x = y; y = t; goto tailrec; @@ -525,7 +503,7 @@ SCM lgcd(x, y) } if (INUM0==y) return x; goto swaprec; } - if NINUMP(y) { t=x; x=y; y=t; goto big_gcd;} + if (NINUMP(y)) { t=x; x=y; y=t; goto big_gcd;} #else ASRTER(INUMP(x), x, ARG1, s_gcd); ASRTER(INUMP(y), y, ARG2, s_gcd); @@ -562,13 +540,13 @@ SCM llcm(n1, n2) SCM n1, n2; { SCM d; - if UNBNDP(n2) { + if (UNBNDP(n2)) { n2 = MAKINUM(1L); - if UNBNDP(n1) return n2; + if (UNBNDP(n1)) return n2; } d = lgcd(n1, n2); if (INUM0==d) return d; - return absval(product(n1, lquotient(n2, d))); + return scm_iabs(product(n1, lquotient(n2, d))); } /* Emulating 2's complement bignums with sign magnitude arithmetic: @@ -624,7 +602,7 @@ SCM scm_copy_big_dec(b, sign) sizet i = 0; SCM ans = mkbig(nx, sign); BIGDIG *src = BDIGITS(b), *dst = BDIGITS(ans); - if BIGSIGN(b) do { + if (BIGSIGN(b)) do { num += src[i]; if (num < 0) {dst[i] = num + BIGRAD; num = -1;} else {dst[i] = BIGLO(num); num = 0;} @@ -784,7 +762,7 @@ SCM scm_big_test(x, nx, xsgn, bigy) num = 0; } } while (++i < nx); - else if BIGSIGN(bigy) + else if (BIGSIGN(bigy)) do { num += y[i]; if (num < 0) { @@ -814,7 +792,7 @@ static SCM scm_copy_big_2scomp(x, blen, sign) BIGDIG *rds; long num = 0; sizet i; - if INUMP(x) { + if (INUMP(x)) { long lx = INUM(x); if (nres < (LONG_BIT + BITSPERDIG - 1)/BITSPERDIG) nres = (LONG_BIT + BITSPERDIG - 1)/BITSPERDIG; @@ -849,7 +827,7 @@ static SCM scm_copy_big_2scomp(x, blen, sign) nres = nx; res = mkbig(nres, sign); rds = BDIGITS(res); - if BIGSIGN(x) { + if (BIGSIGN(x)) { for (i = 0; i < nx; i++) { num -= xds[i]; if (num < 0) { @@ -901,7 +879,7 @@ SCM scm_big_ash(x, cnt) unsigned long d; int sign, ishf; long i, fshf, blen, n; - if INUMP(x) { + if (INUMP(x)) { blen = LONG_BIT; sign = INUM(x) < 0 ? 0x0100 : 0; } @@ -962,8 +940,8 @@ static char s_logand[] = "logand", s_lognot[] = "lognot", SCM scm_logior(x, y) SCM x, y; { - if UNBNDP(y) { - if UNBNDP(x) return INUM0; + if (UNBNDP(y)) { + if (UNBNDP(x)) return INUM0; #ifndef RECKLESS if (!(NUMBERP(x))) badx: wta(x, (char *)ARG1, s_logior); @@ -971,17 +949,17 @@ SCM scm_logior(x, y) return x; } #ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { SCM t; ASRTGO(NIMP(x) && BIGP(x), badx); - if INUMP(y) {t = x; x = y; y = t; goto intbig;} + if (INUMP(y)) {t = x; x = y; y = t; goto intbig;} ASRTGO(NIMP(y) && BIGP(y), bady); if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;} if ((!BIGSIGN(x)) && !BIGSIGN(y)) return scm_big_ior(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y); return scm_big_and(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0x0100); } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) bady: wta(y, (char *)ARG2, s_logior); @@ -1011,8 +989,8 @@ SCM scm_logior(x, y) SCM scm_logand(x, y) SCM x, y; { - if UNBNDP(y) { - if UNBNDP(x) return MAKINUM(-1); + if (UNBNDP(y)) { + if (UNBNDP(x)) return MAKINUM(-1); #ifndef RECKLESS if (!(NUMBERP(x))) badx: wta(x, (char *)ARG1, s_logand); @@ -1020,17 +998,17 @@ SCM scm_logand(x, y) return x; } #ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { SCM t; ASRTGO(NIMP(x) && BIGP(x), badx); - if INUMP(y) {t = x; x = y; y = t; goto intbig;} + if (INUMP(y)) {t = x; x = y; y = t; goto intbig;} ASRTGO(NIMP(y) && BIGP(y), bady); if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;} if ((BIGSIGN(x)) && BIGSIGN(y)) return scm_big_ior(BDIGITS(x), NUMDIGS(x), 0x0100, y); return scm_big_and(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y, 0); } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) bady: wta(y, (char *)ARG2, s_logand); @@ -1060,8 +1038,8 @@ SCM scm_logand(x, y) SCM scm_logxor(x, y) SCM x, y; { - if UNBNDP(y) { - if UNBNDP(x) return INUM0; + if (UNBNDP(y)) { + if (UNBNDP(x)) return INUM0; #ifndef RECKLESS if (!(NUMBERP(x))) badx: wta(x, (char *)ARG1, s_logxor); @@ -1069,15 +1047,15 @@ SCM scm_logxor(x, y) return x; } #ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { SCM t; ASRTGO(NIMP(x) && BIGP(x), badx); - if INUMP(y) {t = x; x = y; y = t; goto intbig;} + if (INUMP(y)) {t = x; x = y; y = t; goto intbig;} ASRTGO(NIMP(y) && BIGP(y), bady); if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;} return scm_big_xor(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y); } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) bady: wta(y, (char *)ARG2, s_logxor); @@ -1107,15 +1085,15 @@ SCM scm_logtest(x, y) badx: wta(x, (char *)ARG1, s_logtest); #endif #ifdef BIGDIG - if NINUMP(x) { + if (NINUMP(x)) { SCM t; ASRTGO(NIMP(x) && BIGP(x), badx); - if INUMP(y) {t = x; x = y; y = t; goto intbig;} + if (INUMP(y)) {t = x; x = y; y = t; goto intbig;} ASRTGO(NIMP(y) && BIGP(y), bady); if (NUMDIGS(x) > NUMDIGS(y)) {t = x; x = y; y = t;} return scm_big_test(BDIGITS(x), NUMDIGS(x), BIGSIGN(x), y); } - if NINUMP(y) { + if (NINUMP(y)) { # ifndef RECKLESS if (!(NIMP(y) && BIGP(y))) bady: wta(y, (char *)ARG2, s_logtest); @@ -1142,10 +1120,10 @@ SCM scm_logbitp(index, j1) { ASRTER(INUMP(index) && INUM(index) >= 0, index, ARG1, s_logbitp); #ifdef BIGDIG - if NINUMP(j1) { + if (NINUMP(j1)) { ASRTER(NIMP(j1) && BIGP(j1), j1, ARG2, s_logbitp); if (NUMDIGS(j1) * BITSPERDIG < INUM(index)) return BOOL_F; - else if BIGSIGN(j1) { + else if (BIGSIGN(j1)) { long num = -1; sizet i = 0; BIGDIG *x = BDIGITS(j1); @@ -1200,7 +1178,7 @@ SCM scm_copybit(index, j1, bit) ASRTER(INUMP(j1), j1, ARG2, s_copybit); ASRTER(INUM(index) < LONG_BIT - 3, index, OUTOFRANGE, s_copybit); #endif - if NFALSEP(bit) + if (NFALSEP(bit)) return MAKINUM(INUM(j1) | (1L << INUM(index))); else return MAKINUM(INUM(j1) & (~(1L << INUM(index)))); @@ -1340,10 +1318,10 @@ SCM scm_logcount(n) register unsigned long c = 0; register long nn; #ifdef BIGDIG - if NINUMP(n) { + if (NINUMP(n)) { sizet i; BIGDIG *ds, d; ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_logcount); - if BIGSIGN(n) return scm_logcount(difference(MAKINUM(-1L), n)); + if (BIGSIGN(n)) return scm_logcount(difference(MAKINUM(-1L), n)); ds = BDIGITS(n); for(i = NUMDIGS(n); i--; ) for(d = ds[i]; d; d >>= 4) c += logtab[15 & d]; @@ -1365,10 +1343,10 @@ SCM scm_intlength(n) register long nn; unsigned int l = 4; #ifdef BIGDIG - if NINUMP(n) { + if (NINUMP(n)) { BIGDIG *ds, d; ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_intlength); - if BIGSIGN(n) return scm_intlength(difference(MAKINUM(-1L), n)); + if (BIGSIGN(n)) return scm_intlength(difference(MAKINUM(-1L), n)); ds = BDIGITS(n); d = ds[c = NUMDIGS(n)-1]; for(c *= BITSPERDIG; d; d >>= 4) {c += 4; l = ilentab[15 & d];} @@ -1510,7 +1488,7 @@ SCM char_downcase(chr) SCM stringp(x) SCM x; { - if IMP(x) return BOOL_F; + if (IMP(x)) return BOOL_F; return STRINGP(x) ? BOOL_T : BOOL_F; } SCM string(chrs) @@ -1579,7 +1557,7 @@ SCM st_equal(s1, s2) if (LENGTH(s1) != i) return BOOL_F; c1 = UCHARS(s1); c2 = UCHARS(s2); - while(0 != i--) if(*c1++ != *c2++) return BOOL_F; + while(0 != i--) if (*c1++ != *c2++) return BOOL_F; return BOOL_T; } SCM stci_equal(s1, s2) @@ -1593,7 +1571,7 @@ SCM stci_equal(s1, s2) if (LENGTH(s1) != i) return BOOL_F; c1 = UCHARS(s1); c2 = UCHARS(s2); - while(0 != i--) if(upcase[*c1++] != upcase[*c2++]) return BOOL_F; + while(0 != i--) if (upcase[*c1++] != upcase[*c2++]) return BOOL_F; return BOOL_T; } SCM st_lessp(s1, s2) @@ -1706,7 +1684,7 @@ SCM st_append(args) SCM vectorp(x) SCM x; { - if IMP(x) return BOOL_F; + if (IMP(x)) return BOOL_F; return VECTORP(x) ? BOOL_T : BOOL_F; } SCM vector_length(v) @@ -1756,7 +1734,7 @@ SCM make_vector(k, fill) #else ASRTER(INUMP(k) && (!(~LENGTH_MAX & INUM(k))), k, ARG1, s_make_vector); #endif - if UNBNDP(fill) fill = UNSPECIFIED; + if (UNBNDP(fill)) fill = UNSPECIFIED; i = INUM(k); DEFER_INTS; v = must_malloc_cell(i ? i*sizeof(SCM) : 1L, @@ -1789,9 +1767,9 @@ SCM big2inum(b, l) BIGDIG *tmp = BDIGITS(b); while (l--) num = BIGUP(num) + tmp[l]; if (TYP16(b)==tc16_bigpos) { - if POSFIXABLE(num) return MAKINUM(num); + if (POSFIXABLE(num)) return MAKINUM(num); } - else if UNEGFIXABLE(num) return MAKINUM(-(long)num); + else if (UNEGFIXABLE(num)) return MAKINUM(-(long)num); return b; } char s_adjbig[] = "adjbig"; @@ -1820,7 +1798,7 @@ SCM normbig(b) BIGDIG *zds = BDIGITS(b); while (nlen-- && !zds[nlen]); nlen++; if (nlen * BITSPERDIG/CHAR_BIT <= sizeof(SCM)) - if INUMP(b = big2inum(b, (sizet)nlen)) return b; + if (INUMP(b = big2inum(b, (sizet)nlen))) return b; if (NUMDIGS(b)==nlen) return b; return adjbig(b, (sizet)nlen); } @@ -2114,7 +2092,7 @@ SCM divbigbig(x, nx, y, ny, sgn, modes) doadj: for(j = ny;j && !zds[j-1];--j) ; if (j * BITSPERDIG <= sizeof(SCM)*CHAR_BIT) - if INUMP(z = big2inum(z, j)) return z; + if (INUMP(z = big2inum(z, j))) return z; return adjbig(z, j); } #endif @@ -2145,7 +2123,6 @@ static iproc subr1s[] = { {s_exactp, exactp}, {s_oddp, oddp}, {s_evenp, evenp}, - {s_abs, absval}, {s_lognot, scm_lognot}, {s_logcount, scm_logcount}, {s_intlength, scm_intlength}, @@ -50,7 +50,7 @@ # include <io.h> #endif -void igc P((char *what, STACKITEM *stackbase)); +void igc P((const char *what, STACKITEM *stackbase)); void lfflush P((SCM port)); /* internal SCM call */ SCM *loc_open_file; /* for open-file callback */ SCM *loc_try_create_file; @@ -218,7 +218,7 @@ SCM close_port(port) sizet i; SCM ret = UNSPECIFIED; ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_close_port); - if CLOSEDP(port) return UNSPECIFIED; + if (CLOSEDP(port)) return UNSPECIFIED; i = PTOBNUM(port); DEFER_INTS; if (ptobs[i].fclose) { @@ -240,20 +240,20 @@ SCM close_port(port) SCM input_portp(x) SCM x; { - if IMP(x) return BOOL_F; + if (IMP(x)) return BOOL_F; return INPORTP(x) ? BOOL_T : BOOL_F; } SCM output_portp(x) SCM x; { - if IMP(x) return BOOL_F; + if (IMP(x)) return BOOL_F; return OUTPORTP(x) ? BOOL_T : BOOL_F; } SCM port_closedp(port) SCM port; { ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_port_closedp); - if CLOSEDP(port) return BOOL_T; + if (CLOSEDP(port)) return BOOL_T; return BOOL_F; } SCM scm_port_type(port) @@ -353,7 +353,7 @@ void prinport(exp, port, type) SCM exp; SCM port; char *type; { lputs("#<", port); - if CLOSEDP(exp) lputs("closed-", port); + if (CLOSEDP(exp)) lputs("closed-", port); else { if (RDNG & CAR(exp)) lputs("input-", port); if (WRTNG & CAR(exp)) lputs("output-", port); @@ -709,7 +709,7 @@ static sizet syswrite(str, siz, num, p) errbuf_end = dst; } else { - if NIMP(cur_outp) lflush(cur_outp); + if (NIMP(cur_outp)) lflush(cur_outp); if (errbuf_end > 0) { if (errbuf_end > SYS_ERRP_SIZE) { scm_warn("output buffer", " overflowed", UNDEFINED); @@ -772,7 +772,7 @@ SCM mksafeport(maxlen, port) SCM port; { SCM z; - if UNBNDP(port) port = cur_errp; + if (UNBNDP(port)) port = cur_errp; ASRTER(NIMP(port) && OPPORTP(port), port, ARG2, s_msp); z = must_malloc_cell(sizeof(safeport)+0L, tc16_safeport | OPN | WRTNG, @@ -787,7 +787,7 @@ int reset_safeport(sfp, maxlen, port) { if (NIMP(sfp) && tc16_safeport==TYP16(sfp)) { ((safeport *)STREAM(sfp))->ccnt = maxlen; - if NIMP(port) + if (NIMP(port)) ((safeport *)STREAM(sfp))->port = port; return !0; } @@ -996,10 +996,10 @@ static SCM make_stk_seg(size, contents) } estk_pool = SCM_ESTK_PARENT(estk_pool); } - if IMP(seg) seg = must_malloc_cell((long)size*sizeof(SCM), + if (IMP(seg)) seg = must_malloc_cell((long)size*sizeof(SCM), MAKE_LENGTH(size, tc7_vector), s_estk); dst = VELTS(seg); - if NIMP(contents) { + if (NIMP(contents)) { src = VELTS(contents); for (i = size; i--;) dst[i] = src[i]; } @@ -1055,7 +1055,7 @@ void scm_estk_shrink() sizet i; parent = SCM_ESTK_PARENT(scm_estk); i = INUM(SCM_ESTK_PARENT_INDEX(scm_estk)); - if IMP(parent) wta(UNDEFINED, "underflow", s_estk); + if (IMP(parent)) wta(UNDEFINED, "underflow", s_estk); if (BOOL_F==SCM_ESTK_PARENT_WRITABLEP(scm_estk)) { parent = make_stk_seg((sizet)LENGTH(parent), parent); SCM_ESTK_PARENT_WRITABLEP(parent) = BOOL_F; @@ -1257,7 +1257,7 @@ static char *igc_for_alloc(where, olen, size, what) char *where; long olen; sizet size; - char *what; + const char *what; { char *ptr; long nm; @@ -1283,7 +1283,7 @@ static char *igc_for_alloc(where, olen, size, what) } char *must_malloc(len, what) long len; - char *what; + const char *what; { char *ptr; sizet size = len; @@ -1302,7 +1302,7 @@ char *must_malloc(len, what) SCM must_malloc_cell(len, c, what) long len; SCM c; - char *what; + const char *what; { SCM z; char *ptr; @@ -1325,7 +1325,7 @@ SCM must_malloc_cell(len, c, what) char *must_realloc(where, olen, len, what) char *where; long olen, len; - char *what; + const char *what; { char *ptr; sizet size = len; @@ -1346,7 +1346,7 @@ char *must_realloc(where, olen, len, what) void must_realloc_cell(z, olen, len, what) SCM z; long olen, len; - char *what; + const char *what; { char *ptr, *where = CHARS(z); sizet size = len; @@ -1753,8 +1753,8 @@ SCM obunhash(obj) ASRTER(INUMP(obj), obj, ARG1, s_obunhash); obj = SRS(obj, 1) & ~1L; comm: - if IMP(obj) return obj; - if NCELLP(obj) return BOOL_F; + if (IMP(obj)) return obj; + if (NCELLP(obj)) return BOOL_F; { /* This code is adapted from mark_locations() in "sys.c" and scm_cell_p() in "rope.c", which means that changes to these @@ -1762,12 +1762,12 @@ comm: register CELLPTR ptr = (CELLPTR)SCM2PTR(obj); register sizet i = 0, j = hplim_ind; do { - if PTR_GT(hplims[i++], ptr) break; - if PTR_LE(hplims[--j], ptr) break; + if (PTR_GT(hplims[i++], ptr)) break; + if (PTR_LE(hplims[--j], ptr)) break; if ((i != j) && PTR_LE(hplims[i++], ptr) && PTR_GT(hplims[--j], ptr)) continue; - if NFREEP(obj) return obj; + if (NFREEP(obj)) return obj; break; } while(i<j); } @@ -1898,7 +1898,7 @@ badhplims: void scm_init_gra(gra, eltsize, len, maxlen, what) scm_gra *gra; sizet eltsize, len, maxlen; - char *what; + const char *what; { char *nelts; /* DEFER_INTS; */ @@ -2296,7 +2296,7 @@ SCM gc(arg) SCM arg; { DEFER_INTS; - if UNBNDP(arg) + if (UNBNDP(arg)) igc("call", CONT(rootcont)->stkbse); else scm_egc(); @@ -2321,13 +2321,13 @@ void scm_run_finalizers(exiting) } while (!0) { DEFER_INTS; - if NIMP(gc_finalizers_pending) { + if (NIMP(gc_finalizers_pending)) { f = CAR(gc_finalizers_pending); gc_finalizers_pending = CDR(gc_finalizers_pending); } else f = BOOL_F; ALLOW_INTS; - if IMP(f) break; + if (IMP(f)) break; apply(f, EOL, EOL); } } @@ -2347,7 +2347,7 @@ void scm_gc_hook () } void igc(what, stackbase) - char *what; + const char *what; STACKITEM *stackbase; { int j = num_protects; @@ -2485,7 +2485,7 @@ void gc_mark(p) register SCM ptr = p; CHECK_STACK; gc_mark_loop: - if IMP(ptr) return; + if (IMP(ptr)) return; gc_mark_nimp: if (NCELLP(ptr) /* #ifndef RECKLESS */ @@ -2495,9 +2495,9 @@ void gc_mark(p) ) wta(ptr, "rogue pointer in ", s_heap); switch TYP7(ptr) { case tcs_cons_nimcar: - if GCMARKP(ptr) break; + if (GCMARKP(ptr)) break; SETGCMARK(ptr); - if IMP(CDR(ptr)) { /* IMP works even with a GC mark */ + if (IMP(CDR(ptr))) { /* IMP works even with a GC mark */ ptr = CAR(ptr); goto gc_mark_nimp; } @@ -2506,14 +2506,14 @@ void gc_mark(p) goto gc_mark_nimp; case tcs_cons_imcar: case tcs_cons_gloc: - if GCMARKP(ptr) break; + if (GCMARKP(ptr)) break; SETGCMARK(ptr); ptr = GCCDR(ptr); goto gc_mark_loop; case tcs_closures: - if GCMARKP(ptr) break; + if (GCMARKP(ptr)) break; SETGCMARK(ptr); - if IMP(GCENV(ptr)) { + if (IMP(GCENV(ptr))) { ptr = CODE(ptr); goto gc_mark_nimp; } @@ -2521,13 +2521,13 @@ void gc_mark(p) ptr = GCENV(ptr); goto gc_mark_nimp; case tc7_specfun: - if GC8MARKP(ptr) break; + if (GC8MARKP(ptr)) break; SETGC8MARK(ptr); #ifdef CCLO if (tc16_cclo==GCTYP16(ptr)) { i = CCLO_LENGTH(ptr); if (i==0) break; - while(--i>0) if NIMP(VELTS(ptr)[i]) gc_mark(VELTS(ptr)[i]); + while(--i>0) if (NIMP(VELTS(ptr)[i])) gc_mark(VELTS(ptr)[i]); ptr = VELTS(ptr)[0]; } else @@ -2535,15 +2535,15 @@ void gc_mark(p) ptr = CDR(ptr); goto gc_mark_loop; case tc7_vector: - if GC8MARKP(ptr) break; + if (GC8MARKP(ptr)) break; SETGC8MARK(ptr); i = LENGTH(ptr); if (i==0) break; - while(--i>0) if NIMP(VELTS(ptr)[i]) gc_mark(VELTS(ptr)[i]); + while(--i>0) if (NIMP(VELTS(ptr)[i])) gc_mark(VELTS(ptr)[i]); ptr = VELTS(ptr)[0]; goto gc_mark_loop; case tc7_contin: - if GC8MARKP(ptr) break; + if (GC8MARKP(ptr)) break; SETGC8MARK(ptr); mark_locations((STACKITEM *)VELTS(ptr), (sizet)(LENGTH(ptr) + @@ -2552,7 +2552,7 @@ void gc_mark(p) break; case tc7_string: case tc7_msymbol: - if GC8MARKP(ptr) break; + if (GC8MARKP(ptr)) break; ASRTER(!(CHARS(ptr)[HUGE_LENGTH(ptr)]), MAKINUM(HUGE_LENGTH(ptr)), s_wrong_length, s_gc); case tc7_ssymbol: @@ -2567,7 +2567,7 @@ void gc_mark(p) case tcs_subrs: break; case tc7_port: - if GC8MARKP(ptr) break; + if (GC8MARKP(ptr)) break; SETGC8MARK(ptr); i = PTOBNUM(ptr); if (!(i < numptob)) goto def; @@ -2576,7 +2576,7 @@ void gc_mark(p) ptr = (ptobs[i].mark)(ptr); goto gc_mark_loop; case tc7_smob: - if GC8MARKP(ptr) break; + if (GC8MARKP(ptr)) break; SETGC8MARK(ptr); switch TYP16(ptr) { /* should be faster than going through smobs */ case tc_free_cell: @@ -2618,17 +2618,17 @@ void mark_locations(x, n) register long m = n; register int i, j; register CELLPTR ptr; - while(0 <= --m) if CELLP(*(SCM **)&x[m]) { + while(0 <= --m) if (CELLP(*(SCM **)&x[m])) { ptr = (CELLPTR)SCM2PTR((SCM)(*(SCM **)&x[m])); i = 0; j = hplim_ind; do { - if PTR_GT(hplims[i++], ptr) break; - if PTR_LE(hplims[--j], ptr) break; + if (PTR_GT(hplims[i++], ptr)) break; + if (PTR_LE(hplims[--j], ptr)) break; if ((i != j) && PTR_LE(hplims[i++], ptr) && PTR_GT(hplims[--j], ptr)) continue; - /* if NFREEP(*(SCM **)&x[m]) */ gc_mark(*(SCM *)&x[m]); + /* if (NFREEP(*(SCM **)&x[m])) */ gc_mark(*(SCM *)&x[m]); break; } while(i<j); } @@ -2661,10 +2661,10 @@ static void gc_sweep(contin_bad) case tcs_cons_nimcar: case tcs_cons_gloc: case tcs_closures: - if GCMARKP(scmptr) goto cmrkcontinue; + if (GCMARKP(scmptr)) goto cmrkcontinue; break; case tc7_specfun: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; #ifdef CCLO if (tc16_cclo==GCTYP16(scmptr)) { minc = (CCLO_LENGTH(scmptr)*sizeof(SCM)); @@ -2673,47 +2673,47 @@ static void gc_sweep(contin_bad) #endif break; case tc7_vector: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = (LENGTH(scmptr)*sizeof(SCM)); freechars: must_free(CHARS(scmptr), minc); /* SETCHARS(scmptr, 0);*/ break; case tc7_bvect: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = sizeof(long)*((HUGE_LENGTH(scmptr)+LONG_BIT-1)/LONG_BIT); goto freechars; case tc7_ivect: case tc7_uvect: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*sizeof(long); goto freechars; case tc7_svect: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*sizeof(short); goto freechars; case tc7_fvect: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*sizeof(float); goto freechars; case tc7_dvect: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*sizeof(double); goto freechars; case tc7_cvect: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)*2*sizeof(double); goto freechars; case tc7_string: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = HUGE_LENGTH(scmptr)+1; goto freechars; case tc7_msymbol: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = LENGTH(scmptr)+1; goto freechars; case tc7_contin: - if GC8MARKP(scmptr) { + if (GC8MARKP(scmptr)) { if (contin_bad && CONT(scmptr)->length) scm_warn("uncollected ", "", scmptr); goto c8mrkcontinue; @@ -2722,15 +2722,15 @@ static void gc_sweep(contin_bad) mallocated = mallocated - minc; free_continuation(CONT(scmptr)); break; /* goto freechars; */ case tc7_ssymbol: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; /* Do not free storage because tc7_ssymbol means scmptr's storage was not created by a call to malloc(). */ break; case tcs_subrs: continue; case tc7_port: - if GC8MARKP(scmptr) goto c8mrkcontinue; - if OPENP(scmptr) { + if (GC8MARKP(scmptr)) goto c8mrkcontinue; + if (OPENP(scmptr)) { int k = PTOBNUM(scmptr); if (!(k < numptob)) goto sweeperr; /* Yes, I really do mean ptobs[k].free */ @@ -2745,17 +2745,17 @@ static void gc_sweep(contin_bad) case tc7_smob: switch GCTYP16(scmptr) { case tc_free_cell: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; break; #ifdef BIGDIG case tcs_bignums: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; minc = (NUMDIGS(scmptr)*sizeof(BIGDIG)); goto freechars; #endif /* def BIGDIG */ #ifdef FLOATS case tc16_flo: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; switch ((int)(CAR(scmptr)>>16)) { case (IMAG_PART | REAL_PART)>>16: minc = 2*sizeof(double); @@ -2772,7 +2772,7 @@ static void gc_sweep(contin_bad) break; #endif /* def FLOATS */ default: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if (GC8MARKP(scmptr)) goto c8mrkcontinue; { int k = SMOBNUM(scmptr); if (!(k < numsmob)) goto sweeperr; @@ -2862,7 +2862,7 @@ static void mark_sym_values(v) while (k--) for (al = VELTS(v)[k]; NIMP(al); al = GCCDR(al)) { x = GCCDR(CAR(al)); - if IMP(x) continue; + if (IMP(x)) continue; gc_mark(x); } } @@ -2877,7 +2877,7 @@ static void sweep_symhash(v) lloc = &(VELTS(v)[k]); while NIMP(al = (*lloc & ~1L)) { x = CAR(al); - if GC8MARKP(CAR(x)) { + if (GC8MARKP(CAR(x))) { lloc = &(CDR(al)); SETGCMARK(x); } @@ -2983,13 +2983,13 @@ static void egc_mark() int i; gc_mark(scm_env); gc_mark(scm_env_tmp); - if IMP(scm_estk) return; /* Can happen when moving estk. */ - if GC8MARKP(scm_estk) return; + if (IMP(scm_estk)) return; /* Can happen when moving estk. */ + if (GC8MARKP(scm_estk)) return; v = VELTS(scm_estk); SETGC8MARK(scm_estk); i = scm_estk_ptr - v + SCM_ESTK_FRLEN; while(--i >= 0) - if NIMP(v[i]) + if (NIMP(v[i])) gc_mark(v[i]); } static void egc_sweep() @@ -2998,7 +2998,7 @@ static void egc_sweep() int i; for (i = scm_ecache_index; i < scm_ecache_len; i++) { z = PTR2SCM(&(scm_ecache[i])); - if CONSP(z) { + if (CONSP(z)) { CLRGCMARK(z); } else { @@ -3025,7 +3025,7 @@ static void egc_copy(px) *px = CDR(x); return; } - if IMP(freelist) wta(freelist, "empty freelist", "ecache gc"); + if (IMP(freelist)) wta(freelist, "empty freelist", "ecache gc"); z = freelist; freelist = CDR(freelist); ++cells_allocated; @@ -3065,7 +3065,7 @@ static void egc_copy_stack(stk, len) egc_copy_locations(VELTS(stk), len); len = INUM(SCM_ESTK_PARENT_INDEX(stk)) + SCM_ESTK_FRLEN; stk =SCM_ESTK_PARENT(stk); - if IMP(stk) return; + if (IMP(stk)) return; /* len = LENGTH(stk); */ } } @@ -3079,7 +3079,7 @@ static void egc_copy_roots() wta(MAKINUM(scm_egc_root_index), "egc-root-index", "corrupted"); while (len--) { x = roots[len]; - if IMP(x) continue; + if (IMP(x)) continue; switch TYP3(x) { clo: case tc3_closure: @@ -3095,7 +3095,7 @@ static void egc_copy_roots() LETREC. This is only a problem if a non-cache cell was made to point into the cache. */ - if ECACHEP(x) break; + if (ECACHEP(x)) break; e = CAR(x); if (NIMP(e) && ECACHEP(e)) egc_copy(&(CAR(x))); @@ -3133,7 +3133,7 @@ static int egc_need_gc() /* Interrupting a NEWCELL could leave cells_allocated inconsistent with freelist, see handle_it() in repl.c */ for (n = 4; n; n--) { - if IMP(fl) return 1; + if (IMP(fl)) return 1; fl = CDR(fl); } return 0; @@ -264,17 +264,17 @@ static long mytime() long sec, mic, mili = 0; struct timerequest *timermsg; struct MsgPort *timerport; - if(!(timerport = (struct MsgPort *)CreatePort(0, 0))){ + if (!(timerport = (struct MsgPort *)CreatePort(0, 0))){ lputs("No mem for port.\n", cur_errp); return mili; } - if(!(timermsg = (struct timerequest *) + if (!(timermsg = (struct timerequest *) CreateExtIO(timerport, sizeof(struct timerequest)))){ lputs("No mem for timerequest.\n", cur_errp); DeletePort(timermsg->tr_node.io_Message.mn_ReplyPort); return mili; } - if(!(OpenDevice(TIMERNAME, UNIT_MICROHZ, timermsg, 0))){ + if (!(OpenDevice(TIMERNAME, UNIT_MICROHZ, timermsg, 0))){ timermsg->tr_node.io_Command = TR_GETSYSTIME; timermsg->tr_node.io_Flags = 0; DoIO(timermsg); @@ -0,0 +1,20 @@ +#define turtle_width 40 +#define turtle_height 40 +static char turtle_bits[] = { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, + 0xff, 0x00, 0x00, 0x00, 0xe0, 0x84, 0x07, 0x00, 0x00, 0x10, 0x0c, 0x78, + 0x00, 0x00, 0x0c, 0x08, 0xc0, 0x00, 0x00, 0x02, 0x18, 0x40, 0x03, 0x00, + 0x01, 0x28, 0x40, 0x02, 0x80, 0x0f, 0xcc, 0x7f, 0x02, 0xc0, 0xf8, 0x07, + 0x10, 0x06, 0x40, 0x00, 0x04, 0x30, 0x0c, 0x60, 0x00, 0x04, 0x7c, 0x08, + 0xf8, 0x00, 0x04, 0xc2, 0x0f, 0x8c, 0x01, 0x0f, 0x01, 0x0b, 0x26, 0x01, + 0xf1, 0x01, 0x11, 0x03, 0x81, 0x01, 0x81, 0x20, 0x07, 0x83, 0x80, 0x80, + 0x40, 0x9a, 0x83, 0x00, 0x8f, 0xf8, 0x42, 0xc6, 0xff, 0xe3, 0x0f, 0x7e, + 0x63, 0x18, 0x22, 0x00, 0xc0, 0x31, 0xf0, 0x13, 0x00, 0x00, 0x11, 0x00, + 0x11, 0x00, 0x00, 0x0f, 0x00, 0x1b, 0x00, 0x00, 0x06, 0x00, 0x0e, 0x0e, + 0x00, 0x00, 0x00, 0x80, 0x09, 0x00, 0x00, 0x00, 0xc0, 0x88, 0x00, 0x00, + 0x00, 0x00, 0xff, 0x00, 0x00, 0x02, 0x00, 0x08, 0x00, 0x00, 0x05, 0x38, + 0x08, 0x00, 0x80, 0x08, 0x44, 0x08, 0x00, 0x40, 0x04, 0x44, 0x08, 0x00, + 0x20, 0x02, 0x48, 0x04, 0x00, 0x10, 0x01, 0x70, 0x06, 0x00, 0x88, 0x00, + 0xc0, 0x01, 0x00, 0x44, 0x00, 0x40, 0x00, 0x00, 0x22, 0x0e, 0x40, 0x00, + 0x00, 0x11, 0x0a, 0x40, 0x00, 0x00, 0x09, 0x0c, 0x40, 0x00, 0x80, 0x06, + 0x3e, 0x20, 0x00, 0x80, 0xf1, 0xc1, 0x1f, 0x00}; diff --git a/turtlegr.c b/turtlegr.c new file mode 100644 index 0000000..c0245c8 --- /dev/null +++ b/turtlegr.c @@ -0,0 +1,1298 @@ + +/* file turtlegr.c * + * Copyright (C) 1992 sjm@ee.tut.fi * + * jtl@cc.tut.fi * + * * + * Turtlegraphics primitives for the * + * SCM interpreter by Aubrey Jaffer * + * * + * Last modification: 13.10.1992 * + * * + * Versions: * + * 12.3.1992 The first version. * + * 13.3.1992 Added the possibility to pass * + * floating point args. * + * 15.3.1992 Graphics cards other than EGA * + * are now supported. * + * 9.4.1992 The internal representation * + * of X & Y is now float. * + * 13.10.1992 Added X11 support. * + * A major rewrite of certain * + * parts. * + * Put -DX11 -DFLOATS to CFLAGS * + * in Makefile to get it. * + * * + * REMEMBER to define INITS=init_turtlegr() * + * in the Makefile. * + * */ + +/* * + * This code tries to compromise between two very different * + * systems: MSDOS and UNIX with the X11 windowing system. * + * The MSDOS version was build first and it really shows. :) * + * The X port is a partial rewrite of the old MSDOS stuff * + * and plays around with #ifdef's a lot. The result is, * + * eventually, a C source which is expected to compile * + * under both MSDOS and UNIX (X11). * + * The X code handles colors emulating CGA palette. It tries * + * to act sensibly even on a monochrome screen and when the * + * color palette is full. * + * X event handling is implemented with polling whenever * + * appropriate. This is not The Right Way to do it in X, but * + * it was easiest to adopt in this case. * + * Another solution would have been to make the X graphics * + * a separate process, but I didn't want to because I wanted * + * to keep it simple. I can't tell how good an example of porting * + * MSDOS software to X this is, but it works. * + * * + * This has been tested with SunOs 4.1.2 with X11R5, Linux 0.98.1 * + * with Xfree86 1.1 (X11R5 port) and in MSDOS with BC 3.1. * + * Because the code uses only the basic Xlib calls, it should * + * compile without problems under _any_ UNIX with X11R4 or newer. * + * * + * Please send bugreports to sjm@ee.tut.fi. * + * I'm especially interested in hearing about ports to other * + * platforms than those tested by me. * + * * + * - sjm * + * */ + + +/****************************************************/ +/***** GENERIC includes & defines *****/ +/****************************************************/ +#include "scm.h" /* includes scmfig.h as well */ +#include "patchlvl.h" /* Guess... */ +#include <math.h> /* sin(), cos(), fmod() */ +#include <stdlib.h> /* atexit() */ + +/****************************************************/ +/***** X11 specific includes & defines *****/ +/****************************************************/ +#ifdef X11 + +/* Xlib include files */ +# include <X11/Xlib.h> +# include <X11/Xutil.h> +# include <X11/Xatom.h> +# include <stdio.h> + +# include "turtle" +# define BITMAPDEPTH 1 + +# define PROGNAME "scm" +# define CLASSNAME "Scm" +# define WINDOWNAME "TurtleSCM graphics window" +# define ICONNAME "TurtleSCM" + +# define GR_MAX_XSIZE 1024 +# define GR_MAX_YSIZE 1024 +# define GR_DEF_XSIZE 640 +# define GR_DEF_YSIZE 480 +# define GR_MIN_XSIZE 64 +# define GR_MIN_YSIZE 64 + +/* Fake CGA colormap with X - yuk! */ +# define GR_COLORS 16 /* CGA/EGA counterpart */ +# define GR_COLOR00 "black" /* black */ +# define GR_COLOR01 "blue2" /* blue */ +# define GR_COLOR02 "green2" /* green */ +# define GR_COLOR03 "cyan2" /* cyan */ +# define GR_COLOR04 "red3" /* red */ +# define GR_COLOR05 "magenta2" /* magenta */ +# define GR_COLOR06 "yellow2" /* brown */ +# define GR_COLOR07 "light gray" /* white */ +# define GR_COLOR08 "gray" /* gray */ +# define GR_COLOR09 "blue1" /* light blue */ +# define GR_COLOR10 "green1" /* light green */ +# define GR_COLOR11 "cyan1" /* light cyan */ +# define GR_COLOR12 "red1" /* light red */ +# define GR_COLOR13 "magenta1" /* light magenta */ +# define GR_COLOR14 "yellow1" /* yellow */ +# define GR_COLOR15 "white" /* bright white */ + +# ifdef __STDC__ +static void gr_events( int ); +# else +static void gr_events(); +# endif + +#else +/****************************************************/ +/***** PC specific includes & defines *****/ +/****************************************************/ +# include <graphics.h> +# include <stdlib.h> /* for getenv() */ +# include <stdio.h> /* for fputs() */ +# define BGIDIR_ENVSTRING "BGIDIR" +#endif + +/********************************************/ +/***** GENERIC code, declarations *****/ +/********************************************/ +#define SIN( x ) \ + sin( ((x)/180.0) * M_PI ) +#define COS( x ) \ + cos( ((x)/180.0) * M_PI ) + +static int gr_graphicsavail = 0; +static int gr_grmode_on = 0; +static float gr_dir = 0.0; +static int gr_max_x=0, gr_max_y=0, gr_max_color=0; +static float gr_x=0.0, gr_y=0.0; +static int gr_color = 0; + +static char s_gr_draw[] = "draw"; +static char s_gr_move[] = "move"; +static char s_gr_setcolor[] = "set-color!"; +static char s_gr_turnright[] = "turn-right"; +static char s_gr_turnleft[] = "turn-left"; +static char s_gr_turnto[] = "turn-to!"; + +static char s_gr_getdot[] = "get-dot"; +static char s_gr_drawTo[] = "draw-to!"; +static char s_gr_drawto[] = "draw-to"; +static char s_gr_moveTo[] = "move-to!"; + +static char s_gr_setdot[] = "set-dot!"; +static char s_gr_validXYC[] = "valid-xyc?"; + +#ifdef __GNUC__ +inline +#else +static +#endif +int valid_XYC( x, y, color ) +int x, y, color; +{ +#ifdef X11 + /* Check for changed window size */ + gr_events(0); +#endif + if( (x <= gr_max_x) && (y <= gr_max_y) && (color <= gr_max_color) + && (x >= 0) && (y >= 0) && (color >= 0) ) + return( 1 ); + else + return( 0 ); +} /* valid_XYC() */ + + +/********************************************************************/ +/***** X11 specific variable and function declarations *****/ +/********************************************************************/ +#ifdef X11 +static Display *gr_display; /* The X display */ +static int gr_screen; /* The X screen number */ +static Window gr_win; /* The drawable Window */ +static GC gr_gc; /* Graphics Context */ +static unsigned long gr_colortbl[GR_COLORS]; /* Color table */ +static XEvent gr_event; /* Event structure */ + +/* These are needed for XSetWMProperties */ +static char *gr_windowname = WINDOWNAME; +static char *gr_iconname = ICONNAME; +static char gr_progname[] = PROGNAME; +static char gr_classname[] = CLASSNAME; +static int gr_argc = 1; +static char *gr_argv[] = { gr_progname, NULL }; + +static void gr_eventhandler( event ) +XEvent event; +{ + switch( event.type ) { + + case ConfigureNotify: +# ifdef TESTING + fputs( "Received ConfigureNotify event\n", stderr ); +# endif + gr_max_x = event.xconfigure.width - 1; + gr_max_y = event.xconfigure.height - 1; + break; + + case MapNotify: +# ifdef TESTING + fputs( "Received MapNotify event\n", stderr ); +# endif + break; + + case DestroyNotify: +# ifdef TESTING + fputs( "Received DestroyNotify event\n", stderr ); +# endif + break; + + case UnmapNotify: +# ifdef TESTING + fputs( "Received UnmapNotify event\n", stderr ); +# endif + break; + + case Expose: +# ifdef TESTING + fputs( "Received Expose event\n", stderr ); +# endif + if( event.xexpose.count != 0 ) + break; + break; + + case ClientMessage: +# ifdef TESTING + fputs( "Received ClientMessage event\n", stderr ); +# endif + break; + + default: + /* Throw away any unknown events */ + break; + + } /* switch */ +} + +static void gr_events( expected ) +int expected; +{ +int i; + + /* Get at least 'expected' events */ + for( i = 0; i < expected; ++i ) { + XNextEvent( gr_display, &gr_event ); + gr_eventhandler( gr_event ); + } + /* Handle all remaining events if there are any */ + /* XPending will call XFlush() if it doesn't find events at once */ + while( XPending(gr_display) ) { + XNextEvent( gr_display, &gr_event ); + gr_eventhandler( gr_event ); + } /* while */ +} /* gr_events() */ + +static void gr_typedevent( type ) +int type; +{ + do { + XNextEvent( gr_display, &gr_event ); + gr_eventhandler( gr_event ); + } while( gr_event.type != type ); + /* Handle all remaining events if there are any */ + /* XPending will call XFlush() if it doesn't find events at once */ + while( XPending(gr_display) ) { + XNextEvent( gr_display, &gr_event ); + gr_eventhandler( gr_event ); + } /* while */ +} + + +/********************************************************************/ +/***** PC specific variable and function declarations *****/ +/********************************************************************/ +#else + +static int gr_max_display_mode; +static int gr_drivernum; + +#endif + + +/********************************************************************/ +/********************************************************************/ +/*** User callable SCM routines begin here *** + *** *** + *** ***/ + + +SCM gr_helpgr() +{ + fputs( "\ +Ret Name nargs args returns\n\ +---------------------------------------------------------\n\ +B graphics-avail? 0 - #t if graphics available\n\ +B graphics-mode! 0 - #f if no graphics\n\ +B text-mode! 0 - #t on success\n\ +B clear-graphics! 0 - #f if not in graphics mode\n\ +i max-x 0 - maximum value of x\n\ +i max-y 0 - maximum value of y\n\ +i max-color 0 - maximum value of color\n\ +B valid-xyc? 3 x y color #t if valid\n\ +B set-dot! 3 x y color #t on success\n\ +i get-dot 2 x y color of the dot in (x,y)\n\ + or #f if (x,y) not legal\n\ +\n\ +NOTE: Origin (0,0) is in the upper left corner.\n\n\ +", stdout ); + return BOOL_T; +} /* gr_helpgr() */ + + +SCM gr_helpturtlegr() +{ + fputs( "\ +Ret Name nargs args returns\n\ +---------------------------------------------------------\n\ +B goto-home! 0 - #f if not in graphics mode\n\ +B goto-center! 0 - #f if not in graphics mode\n\ +B goto-nw! 0 - #f if not in graphics mode\n\ +B goto-ne! 0 - #f if not in graphics mode\n\ +B goto-sw! 0 - #f if not in graphics mode\n\ +B goto-se! 0 - #f if not in graphics mode\n\ +B draw 1 length #t if target within drawing area\n\ +B draw-to 2 x y #t if (x,y) within drawing area\n\ +B draw-to! 2 x y #t if (x,y) within drawing area\n\ +B move 1 length #t if target within drawing area\n\ +B move-to! 2 x y #t if (x,y) within drawing area\n\ +i where-x 0 - current x-coordinate\n\ +i where-y 0 - current y-coordinate\n\ +i turn-right 1 angle drawing direction in degrees\n\ +i turn-left 1 angle drawing direction in degrees\n\ +i turn-to! 1 angle drawing direction in degrees\n\ +i what-direction 0 - drawing direction in degrees\n\ +B set-color! 1 color #t if color valid\n\ +i what-color 0 - current drawing color\n\n\ +", stdout ); + return BOOL_T; +} /* gr_helpturtlegr() */ + + +SCM gr_available() +{ + if( gr_graphicsavail ) + return BOOL_T; + else + return BOOL_F; +} /* gr_available() */ + + +SCM gr_maxx() +{ + if( !gr_grmode_on ) + return BOOL_F; +#ifdef X11 + /* Check for changed window size */ + gr_events(0); +#endif + return MAKINUM( (long)gr_max_x ); +} /* gr_maxx() */ + + +SCM gr_maxy() +{ + if( !gr_grmode_on ) + return BOOL_F; +#ifdef X11 + /* Check for changed window size */ + gr_events(0); +#endif + return MAKINUM( (long)gr_max_y ); +} /* gr_maxy() */ + +SCM gr_maxc() +{ + if( !gr_grmode_on ) + return BOOL_F; + return MAKINUM( (long)gr_max_color ); +} /* gr_maxc() */ + + +SCM gr_validXYC( x, y, c ) +SCM x, y, c; +{ +int xi, yi, ci; + + ASRTER( NUMBERP(x), x, ARG1, s_gr_validXYC ); + ASRTER( NUMBERP(y), y, ARG2, s_gr_validXYC ); + ASRTER( NUMBERP(c), c, ARG3, s_gr_validXYC ); + if( !gr_grmode_on ) + return BOOL_F; + + if( INUMP(x) ) + xi = (int)(INUM(x)); + else + xi = (int)(REALPART(x)); + + if( INUMP(y) ) + yi = (int)(INUM(y)); + else + yi = (int)(REALPART(y)); + + if( INUMP(c) ) + ci = (int)(INUM(c)); + else + ci = (int)(REALPART(c)); + +/* valid_XYC() calls gr_events() */ + + if( valid_XYC( xi, yi, ci ) ) + return BOOL_T; + else + return BOOL_F; +} /* gr_validXYC() */ + + +SCM gr_grmode() +{ + if( !gr_graphicsavail ) + return BOOL_F; +#ifdef X11 + /* bwuah... but it works :) */ + if( !gr_grmode_on ) { + XMapWindow( gr_display, gr_win ); + gr_typedevent( MapNotify ); + } +#else /* PC version */ + setgraphmode( gr_max_display_mode ); +#endif + gr_grmode_on = 1; + return BOOL_T; +} /* gr_grmode() */ + +SCM gr_txtmode() +{ + if( !gr_graphicsavail ) + return BOOL_F; +#ifdef X11 + /* bwuah... but it works :) */ + if( gr_grmode_on ) { + XUnmapWindow( gr_display, gr_win ); + gr_typedevent( UnmapNotify ); + } +#else /* PC version */ + restorecrtmode(); +#endif + gr_grmode_on = 0; + return BOOL_T; +} /* gr_txtmode() */ + + +SCM gr_cleargraph() +{ + if( !gr_grmode_on ) + return BOOL_F; +#ifdef X11 + XClearWindow( gr_display, gr_win ); + gr_events(0); +#else /* PC version */ + cleardevice(); +#endif + return BOOL_T; +} /* gr_cleargraph() */ + + +SCM gr_setdot( x, y, c ) +SCM x, y, c; +{ +int xi, yi, ci; + + ASRTER( NUMBERP(x), x, ARG1, s_gr_setdot ); + ASRTER( NUMBERP(y), y, ARG2, s_gr_setdot ); + ASRTER( NUMBERP(c), c, ARG3, s_gr_setdot ); + if( !gr_grmode_on ) + return BOOL_F; + + if( INUMP(x) ) + xi = (int)(INUM(x)); + else + xi = (int)(REALPART(x)); + + if( INUMP(y) ) + yi = (int)(INUM(y)); + else + yi = (int)(REALPART(y)); + + if( INUMP(c) ) + ci = (int)(INUM(c)); + else + ci = (int)(REALPART(c)); +#ifdef TESTING + fprintf( stderr, "set-dot! called (%d,%d,%d)\n", xi, yi, ci ); +#endif + if( !valid_XYC( xi, yi, ci ) ) + return BOOL_F; +#ifdef X11 + /* Set the drawing color */ + XSetForeground( gr_display, gr_gc, gr_colortbl[ ci ] ); + XDrawPoint( gr_display, gr_win, gr_gc, xi, yi ); + /* Restore the drawing color */ + XSetForeground( gr_display, gr_gc, gr_colortbl[ gr_color ] ); + gr_events(0); +#else /* PC version */ + putpixel( xi, yi, ci ); +#endif + return BOOL_T; +} /* gr_setdot() */ + + +SCM gr_getdot( x, y ) +SCM x, y; +{ +int xi, yi; +#ifdef X11 +XImage *xim; +XWindowAttributes wattr; +unsigned long dot; +int i; +#endif + ASRTER( NUMBERP(x), x, ARG1, s_gr_getdot ); + ASRTER( NUMBERP(y), y, ARG2, s_gr_getdot ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(x) ) + xi = (int)(INUM(x)); + else + xi = (int)(REALPART(x)); + + if( INUMP(y) ) + yi = (int)(INUM(y)); + else + yi = (int)(REALPART(y)); +#ifdef TESTING + fprintf( stderr, "get-dot called (%d,%d)\n", xi, yi ); +#endif + if( !valid_XYC( xi, yi, 0 ) ) + return BOOL_F; +#ifdef X11 + /* Now, this IS ugly. But it's there if you need it. */ + + /* Have to make sure that the window is mapped. Tough... */ + XGetWindowAttributes( gr_display, gr_win, &wattr ); + if( wattr.map_state == IsUnmapped ) { + XMapWindow( gr_display, gr_win ); + gr_typedevent( MapNotify ); + } + /* I KNOW this sucks. */ + xim = XGetImage( gr_display, gr_win, xi, yi, 1, 1, AllPlanes, XYPixmap ); + dot = XGetPixel( xim, 0, 0 ); + for( i = 0; i < GR_COLORS; ++i ) { + if( gr_colortbl[i] == dot ) + return MAKINUM( (long)i ); + } + /* This should never happen. There's garbage in the window! */ + fprintf( stderr, "%s: %s: Got an illegal pixel value %lu. \ +Is there garbage?\n", gr_progname, s_gr_getdot, dot ); + return BOOL_F; +#else /* PC version */ + return MAKINUM( (long)getpixel( xi, yi ) ); +#endif +} /* gr_getdot() */ + +SCM gr_draw( S ) +SCM S; +{ +float xf, yf; +float sf; +int ok; + + ASRTER( NUMBERP(S), S, ARG1, s_gr_draw ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(S) ) + sf = (float)(INUM(S)); + else + sf = REALPART(S); +#ifdef TESTING + fprintf( stderr, "draw called (%f)\n", sf ); +#endif + ok = 1; + xf = gr_x + ( COS( gr_dir ) * sf ); + yf = gr_y + ( SIN( gr_dir ) * sf ); + if( (int)xf > gr_max_x ) { + xf = (float)gr_max_x; + ok = 0; + } + else if( xf < 0.0 ) { + xf = 0.0; + ok = 0; + } + if( (int)yf > gr_max_y ) { + yf = (float)gr_max_y; + ok = 0; + } + else if( yf < 0.0 ) { + yf = 0.0; + ok = 0; + } +#ifdef X11 + XDrawLine( gr_display, gr_win, gr_gc, + (int)gr_x, (int)gr_y, + (int)xf, (int)yf ); + gr_events(0); +#else /* PC version */ + line( (int)gr_x, (int)gr_y, (int)xf, (int)yf ); +#endif + gr_x = xf; + gr_y = yf; + if( ok ) + return BOOL_T; + else + return BOOL_F; +} /* gr_draw() */ + + +SCM gr_move( S ) +SCM S; +{ +float xf, yf; +float sf; +int ok; + + ASRTER( NUMBERP(S), S, ARG1, s_gr_move ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(S) ) + sf = (float)(INUM(S)); + else + sf = REALPART(S); +#ifdef TESTING + fprintf( stderr, "move called (%f)\n", sf ); +#endif + ok = 1; + xf = gr_x + ( COS( gr_dir ) * sf ); + yf = gr_y + ( SIN( gr_dir ) * sf ); + + if( (int)xf > gr_max_x ) { + xf = (float)gr_max_x; + ok = 0; + } + else if( xf < 0.0 ) { + xf = 0.0; + ok = 0; + } + if( (int)yf > gr_max_y ) { + yf = (float)gr_max_y; + ok = 0; + } + else if( yf < 0.0 ) { + yf = 0.0; + ok = 0; + } + gr_x = xf; + gr_y = yf; + if( ok ) + return BOOL_T; + else + return BOOL_F; +} /* gr_move() */ + + +SCM gr_drawto( x, y ) +SCM x, y; +{ +int xi, yi; + + ASRTER( NUMBERP(x), x, ARG1, s_gr_drawto ); + ASRTER( NUMBERP(y), y, ARG2, s_gr_drawto ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(x) ) + xi = (int)(INUM(x)); + else + xi = (int)(REALPART(x)); + + if( INUMP(y) ) + yi = (int)(INUM(y)); + else + yi = (int)(REALPART(y)); +#ifdef TESTING + fprintf( stderr, "draw-to called (%d,%d)\n", xi, yi ); +#endif + if( !valid_XYC( xi, yi, 0 ) ) + return BOOL_F; +#ifdef X11 + XDrawLine( gr_display, gr_win, gr_gc, + (int)gr_x, (int)gr_y, xi, yi ); + gr_events(0); +#else /* PC version */ + line( (int)gr_x, (int)gr_y, xi, yi ); +#endif + return BOOL_T; +} /* gr_drawto() */ + + +SCM gr_drawTo( x, y ) +SCM x, y; +{ +float xf, yf; + + ASRTER( NUMBERP(x), x, ARG1, s_gr_drawTo ); + ASRTER( NUMBERP(y), y, ARG2, s_gr_drawTo ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(x) ) + xf = (float)(INUM(x)); + else + xf = (REALPART(x)); + + if( INUMP(y) ) + yf = (float)(INUM(y)); + else + yf = (REALPART(y)); +#ifdef TESTING + fprintf( stderr, "draw-to! called (%d,%d)\n", (int)xf, (int)yf ); +#endif + if( !valid_XYC( (int)xf, (int)yf, 0 ) ) + return BOOL_F; +#ifdef X11 + XDrawLine( gr_display, gr_win, gr_gc, + (int)gr_x, (int)gr_y, + (int)xf, (int)yf ); + gr_events(0); +#else /* PC version */ + line( (int)gr_x, (int)gr_y, (int)xf, (int)yf ); +#endif + gr_x = xf; + gr_y = yf; + return BOOL_T; +} /* gr_drawTo() */ + + +SCM gr_moveTo( x, y ) +SCM x, y; +{ +float xf, yf; + + ASRTER( NUMBERP(x), x, ARG1, s_gr_moveTo ); + ASRTER( NUMBERP(y), y, ARG2, s_gr_moveTo ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(x) ) + xf = (float)(INUM(x)); + else + xf = (REALPART(x)); + + if( INUMP(y) ) + yf = (float)(INUM(y)); + else + yf = (REALPART(y)); +#ifdef TESTING + fprintf( stderr, "move-to! called (%d,%d)\n", (int)xf, (int)yf ); +#endif + if( !valid_XYC( (int)xf, (int)yf, 0 ) ) + return BOOL_F; + gr_x = xf; + gr_y = yf; + return BOOL_T; +} /* gr_moveTo() */ + + +SCM gr_setcolor( c ) +SCM c; +{ +int color; + + ASRTER( NUMBERP(c), c, ARG1, s_gr_setcolor ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(c) ) + color = (int)(INUM(c)); + else + color = (int)(REALPART(c)); +#ifdef TESTING + fprintf( stderr, "set-color! called (%d)\n", color ); +#endif + if( !valid_XYC( 0, 0, color ) ) + return BOOL_F; + gr_color = color; +#ifdef X11 + /* Set the drawing color */ + XSetForeground( gr_display, gr_gc, gr_colortbl[ gr_color ] ); + gr_events(0); +#else /* PC version */ + setcolor( gr_color ); +#endif + return BOOL_T; +} /* gr_setcolor() */ + + +SCM gr_turnright( d ) +SCM d; +{ +float df; + + ASRTER( NUMBERP(d), d, ARG1, s_gr_turnright ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(d) ) + df = (float)(INUM(d)); + else + df = REALPART(d); + df = fmod( df, 360.0 ); + gr_dir -= df; + gr_dir = fmod( gr_dir, 360.0 ); + return MAKINUM( (long)(gr_dir+.5) ); +} /* gr_turnright() */ + + +SCM gr_turnleft( d ) +SCM d; +{ +float df; + + ASRTER( NUMBERP(d), d, ARG1, s_gr_turnleft ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(d) ) + df = (float)(INUM(d)); + else + df = REALPART(d); + df = fmod( df, 360.0 ); + gr_dir += df; + gr_dir = fmod( gr_dir, 360.0 ); + return MAKINUM( (long)(gr_dir+.5) ); +} /* gr_turnleft() */ + + +SCM gr_turnto( d ) +SCM d; +{ +float df; + + ASRTER( NUMBERP(d), d, ARG1, s_gr_turnto ); + if( !gr_grmode_on ) + return BOOL_F; + if( INUMP(d) ) + df = (float)(INUM(d)); + else + df = REALPART(d); + df = fmod( df, 360.0 ); + gr_dir = df; + return MAKINUM( (long)(gr_dir+.5) ); +} /* gr_turnto() */ + + +SCM gr_gotohome() +{ + if( !gr_grmode_on ) + return BOOL_F; + gr_x = gr_y = 0.0; + return BOOL_T; +} /* gr_gotohome() */ + + +SCM gr_gotocenter() +{ + if( !gr_grmode_on ) + return BOOL_F; +#ifdef X11 + /* Check for changed window size */ + gr_events(0); +#endif + gr_x = ((float)gr_max_x+1.0) / 2.0; + gr_y = ((float)gr_max_y+1.0) / 2.0; + return BOOL_T; +} /* gr_gotocenter() */ + + +SCM gr_gotonw() +{ + if( !gr_grmode_on ) + return BOOL_F; +#ifdef X11 + /* Check for changed window size */ + gr_events(0); +#endif + gr_x = 0.0; + gr_y = 0.0; + return BOOL_T; +} /* gr_gotonw() */ + + +SCM gr_gotosw() +{ + if( !gr_grmode_on ) + return BOOL_F; +#ifdef X11 + /* Check for changed window size */ + gr_events(0); +#endif + gr_x = 0.0; + gr_y = (float)gr_max_y; + return BOOL_T; +} /* gr_gotosw() */ + + +SCM gr_gotone() +{ + if( !gr_grmode_on ) + return BOOL_F; +#ifdef X11 + /* Check for changed window size */ + gr_events(0); +#endif + gr_x = (float)gr_max_x; + gr_y = 0.0; + return BOOL_T; +} /* gr_gotone() */ + + +SCM gr_gotose() +{ + if( !gr_grmode_on ) + return BOOL_F; +#ifdef X11 + /* Check for changed window size */ + gr_events(0); +#endif + gr_x = (float)gr_max_x; + gr_y = (float)gr_max_y; + return BOOL_T; +} /* gr_gotose() */ + + +SCM gr_whatcolor() +{ + if( !gr_grmode_on ) + return BOOL_F; + return MAKINUM( (long)gr_color ); +} /* gr_whatcolor() */ + + +SCM gr_whatdirection() +{ + if( !gr_grmode_on ) + return BOOL_F; + return MAKINUM( (long)(gr_dir+.5) ); +} /* gr_whatdirection() */ + + +SCM gr_wherex() +{ + if( !gr_grmode_on ) + return BOOL_F; + return MAKINUM( (long)gr_x ); +} /* gr_wherex() */ + + +SCM gr_wherey() +{ + if( !gr_grmode_on ) + return BOOL_F; + return MAKINUM( (long)gr_y ); +} /* gr_wherey() */ + + +static iproc graph0[] = { + { "help-gr", gr_helpgr }, + { "help-turtlegr", gr_helpturtlegr }, + { "graphics-mode!", gr_grmode }, + { "text-mode!", gr_txtmode }, + { "clear-graphics!", gr_cleargraph }, + { "graphics-avail?", gr_available }, + { "max-x", gr_maxx }, + { "max-y", gr_maxy }, + { "max-color", gr_maxc }, + { "what-color", gr_whatcolor }, + { "what-direction", gr_whatdirection }, + { "where-x", gr_wherex }, + { "where-y", gr_wherey }, + { "goto-home!", gr_gotohome }, + { "goto-center!", gr_gotocenter }, + { "goto-nw!", gr_gotonw }, + { "goto-sw!", gr_gotosw }, + { "goto-ne!", gr_gotone }, + { "goto-se!", gr_gotose }, + {0, 0} + }; + +static iproc graph1[] = { + { s_gr_draw, gr_draw }, + { s_gr_move, gr_move }, + { s_gr_setcolor, gr_setcolor }, + { s_gr_turnright, gr_turnright }, + { s_gr_turnleft, gr_turnleft }, + { s_gr_turnto, gr_turnto }, + {0, 0} + }; + +static iproc graph2[] = { + { s_gr_getdot, gr_getdot }, + { s_gr_drawTo, gr_drawTo }, + { s_gr_drawto, gr_drawto }, + { s_gr_moveTo, gr_moveTo }, + {0, 0} + }; + +static iproc graph3[] = { + { s_gr_setdot, gr_setdot }, + { s_gr_validXYC, gr_validXYC }, + {0, 0} + }; + +#if defined __STDC__ || defined __TURBOC__ +void close_turtlegr() +{ +# ifdef X11 + gr_events(0); + XFreeColors( gr_display, DefaultColormap(gr_display, gr_screen), + gr_colortbl, GR_COLORS, AllPlanes ); + XFreeGC( gr_display, gr_gc ); + XUnmapWindow( gr_display, gr_win ); + XDestroyWindow( gr_display, gr_win ); +# else /* PC version */ + closegraph(); +# endif +} /* close_turtlegr() */ +#endif + +void init_banner(); /* from scm.c */ + +void init_turtlegr() /* detects if graphics is available; must be + called among program initializations */ +{ +#ifdef X11 + char *display_name = NULL; /* Server to connect to */ + Pixmap icon_pixmap; /* Icon */ + XSizeHints size_hints; /* Preferred sizes */ + XSetWindowAttributes win_attribs; /* Window attributes */ + XWMHints wm_hints; /* Window manager hints */ + XClassHint class_hints; /* Class hints */ + XTextProperty window_name, icon_name; /* Names for Icon & Window */ + XGCValues gc_values; /* Graphics Context values */ + static char *colorname[GR_COLORS] = { + GR_COLOR00, GR_COLOR01, GR_COLOR02, GR_COLOR03, + GR_COLOR04, GR_COLOR05, GR_COLOR06, GR_COLOR07, + GR_COLOR08, GR_COLOR09, GR_COLOR10, GR_COLOR11, + GR_COLOR12, GR_COLOR13, GR_COLOR14, GR_COLOR15 + }; + XColor x_color; /* X11 Color structure */ + unsigned long mask; /* Mask for selections */ + int i; /* loop counter variable */ + +#else /* PC version */ +int errcode; +#endif + +/***************************/ +/* generic initializations */ +/***************************/ + gr_x = gr_y = gr_dir = 0.0; + gr_max_x = gr_max_y = gr_max_color = 0; + + gr_graphicsavail = 0; /* DEFAULT is no graphics - you can do without */ + +/********************************************/ +/***** Initialize X11 turtlegraphics *****/ +/********************************************/ +#ifdef X11 + /* connect to X server */ + if( (gr_display = XOpenDisplay(display_name)) != NULL ) + { + + /*****************************/ + /* connection to X server OK */ + /*****************************/ + + gr_screen = DefaultScreen( gr_display ); /* X screen number */ + + /* Create a window with Black background and border */ + gr_win + = XCreateSimpleWindow( gr_display, + RootWindow( gr_display, gr_screen), + 0, 0, /* initial placement */ + GR_DEF_XSIZE, GR_DEF_YSIZE, + 3, /* border width */ + /* border pixel value */ + BlackPixel(gr_display, gr_screen), + /* background pixel value */ + BlackPixel(gr_display, gr_screen) ); + + /* Select input (events) for the window */ + XSelectInput( gr_display, gr_win, + StructureNotifyMask|ExposureMask ); + + /* Check for backing store capability */ + if( !DoesBackingStore(DefaultScreenOfDisplay(gr_display)) ) + { + fprintf( stderr, "%s: Warning: \ +X server does not offer backing store capability.\n\ +Window cannot be redrawn if obscured. Sorry...\n", gr_progname ); + } + else + { + /* Enable the backing store feature of X server + and set bit gravity */ + win_attribs.bit_gravity = NorthWestGravity; + win_attribs.backing_store = Always; + mask = CWBitGravity | CWBackingStore; + XChangeWindowAttributes( gr_display, gr_win, mask, &win_attribs ); + } + + /* Make names of Window and Icon for window manager */ + if( XStringListToTextProperty(&gr_windowname, 1, &window_name) == 0 ) { + (void)fprintf( stderr, "%s: Structure allocation for windowName\ + failed.\n", gr_progname ); + exit( 42 ); + } + if( XStringListToTextProperty(&gr_iconname, 1, &icon_name) == 0 ) { + (void)fprintf( stderr, "%s: Structure allocation for iconName\ + failed.\n", gr_progname ); + exit( 42 ); + } + + /* Create the icon */ + icon_pixmap = XCreateBitmapFromData( gr_display, gr_win, turtle_bits, + turtle_width, turtle_height ); + + /* Window size, state, icon etc. hints for the window manager */ + size_hints.flags = PPosition | PMaxSize | PMinSize | USSize; + /* position and desired size are given to XCreateSimpleWindow call */ + size_hints.min_width = GR_MIN_XSIZE; + size_hints.min_height = GR_MIN_YSIZE; + size_hints.max_width = GR_MAX_XSIZE; + size_hints.max_height = GR_MAX_YSIZE; + wm_hints.flags = StateHint | IconPixmapHint | InputHint; + wm_hints.initial_state = NormalState; + wm_hints.input = False; + wm_hints.icon_pixmap = icon_pixmap; + class_hints.res_name = gr_progname; + class_hints.res_class = gr_classname; + XSetWMProperties( gr_display, gr_win, &window_name, &icon_name, + gr_argv, gr_argc, + &size_hints, &wm_hints, &class_hints ); + + + /* Handle colors; this is quite complicated in X11 */ + + if( DefaultDepth( gr_display, gr_screen ) == 1 ) + { + /* Only 1 bitplane, BW screen */ + /* Emulate colors with 0 as Black and 1-15 White */ + gr_colortbl[0] = BlackPixel( gr_display, gr_screen ); + for( i = 1; i < GR_COLORS; ++i ) + gr_colortbl[i] = WhitePixel( gr_display, gr_screen ); +# ifdef TESTING + fprintf( stderr, "%s: 1-plane system, substituting White for \ +colors 1-15.\n", gr_progname ); + fprintf( stderr, "%s: Pixel value is %lu for Black, \ +%lu for White\n", gr_progname, gr_colortbl[0], gr_colortbl[1] ); +# endif + } + else + { + /* more than 1 bitplane */ + for( i = 0; i < GR_COLORS; ++i ) + { + /* Initialize the colortable using named colors */ + if( XParseColor( gr_display, + DefaultColormap(gr_display, gr_screen), + colorname[ i ], &x_color ) ) + { + if( !XAllocColor( gr_display, + DefaultColormap(gr_display, gr_screen), + &x_color ) ) + { + fprintf( stderr, "%s: Can't allocate color \ +\"%s\" (%d). Substituting White.\n", + gr_progname, + colorname[ i ], i ); + gr_colortbl[i] = WhitePixel( gr_display, gr_screen ); + } + else + { + /* succeeded in allocating color */ + gr_colortbl[ i ] = x_color.pixel; +# ifdef TESTING + fprintf( stderr, "%s: Pixel value is %lu for %s.\n", + gr_progname, gr_colortbl[i], colorname[i] ); +# endif + } + } + else + { + /* could not parse color */ + fprintf( stderr, + "%s: Color name \"%s\" (%d) not in database. \ +Substituting White.\n", + gr_progname, colorname[i], i ); + gr_colortbl[i] = WhitePixel( gr_display, gr_screen ); + } + } /* for */ + } /* else */ + gr_max_color = GR_COLORS - 1; + + /* Create and initialize a default GC */ + gr_gc = XCreateGC( gr_display, gr_win, 0L, &gc_values ); + + /* Initialize the drawing color, default's black */ + XSetForeground( gr_display, gr_gc, gr_colortbl[ 0 ] ); + XSetBackground( gr_display, gr_gc, gr_colortbl[ 0 ] ); + gr_color = 0; + + /* OK, we _do_ have graphics available */ + gr_graphicsavail = 1; + +# ifdef __STDC__ + /* Let's do the Right Thing if possible :) */ + atexit( close_turtlegr ); +# endif + } /* if */ + else { + gr_graphicsavail = 0; + } +/********************************************/ +/***** Initialize PC turtlegraphics *****/ +/********************************************/ +#else /* PC version */ + gr_drivernum = DETECT; + + detectgraph( &gr_drivernum, &gr_max_display_mode ); + if( gr_drivernum != grNotDetected ) { + if( !getenv( BGIDIR_ENVSTRING ) ) + fprintf( stderr, + "You really should set the %s environment variable.\n", + BGIDIR_ENVSTRING ); + initgraph( &gr_drivernum, &gr_max_display_mode, + getenv( BGIDIR_ENVSTRING ) ); + errcode = graphresult(); + if( errcode != grOk ) { + fputs( "Graphics error: ", stderr ); + fputs( grapherrormsg( errcode ), stderr ); + exit( EXIT_FAILURE ); + } + moveto( 0, 0 ); + gr_x = gr_y = 0.0; + setcolor( 0 ); + gr_color = 0; + gr_max_x = getmaxx(); + gr_max_y = getmaxy(); + gr_max_color = getmaxcolor(); + gr_max_display_mode = getmaxmode(); + restorecrtmode(); + gr_graphicsavail = 1; + atexit( close_turtlegr ); + } + else { + gr_graphicsavail = 0; + } +#endif + +/* generic */ + init_iprocs( graph0, tc7_subr_0 ); + init_iprocs( graph1, tc7_subr_1 ); + init_iprocs( graph2, tc7_subr_2 ); + init_iprocs( graph3, tc7_subr_3 ); + gr_grmode_on = 0; + +#ifndef X11 + /* PC version clears screen so this must be repeated */ + init_banner(); +#endif + + fputs("\nSCM Turtlegraphics Copyright (C) 1992 sjm@cc.tut.fi, jtl@cc.tut.fi\n\ +Type `(help-gr)' or `(help-turtlegr)' for a quick reference of\n\ +the new primitives.\n", stderr); + + if( !gr_graphicsavail ) { +#ifdef X11 + fprintf( stderr, "%s: No X server found. \ +Turtlegraphics not available.\n", gr_progname ); +#else + fputs( "No graphics adapter detected. \ +Turtlegraphics not available.\n", stderr ); +#endif + } + else { +#ifdef X11 + gr_events(0); +#else + ; +#endif + } +} /* init_turtlegr() */ @@ -1,5 +1,5 @@ -/* Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992 - Free Software Foundation, Inc. +/* Copyright (C) 1985, 1986, 1987, 1988, 1990, 1992, 1999, 2000, 2001, + 2002, 2003, 2004, 2005 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,8 +15,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. In other words, you are welcome to use, share and improve this program. You are forbidden to forbid anyone else to use, share and improve @@ -27,20 +27,20 @@ what you give them. Help stamp out software-hoarding! */ * unexec.c - Convert a running program into an a.out file. * * Author: Spencer W. Thomas - * Computer Science Dept. - * University of Utah + * Computer Science Dept. + * University of Utah * Date: Tue Mar 2 1982 * Modified heavily since then. * * Synopsis: - * unexec (new_name, a_name, data_start, bss_start, entry_address) - * char *new_name, *a_name; + * unexec (new_name, old_name, data_start, bss_start, entry_address) + * char *new_name, *old_name; * unsigned data_start, bss_start, entry_address; * * Takes a snapshot of the program and makes an a.out format file in the * file named by the string argument new_name. - * If a_name is non-NULL, the symbol table will be taken from the given file. - * On some machines, an existing a_name file is required. + * If old_name is non-NULL, the symbol table will be taken from the given file. + * On some machines, an existing old_name file is required. * * The boundaries within the a.out file may be adjusted with the data_start * and bss_start arguments. Either or both may be given as 0 for defaults. @@ -52,11 +52,6 @@ what you give them. Help stamp out software-hoarding! */ * The value you specify may be rounded down to a suitable boundary * as required by the machine you are using. * - * Specifying zero for data_start means the boundary between text and data - * should not be the same as when the program was loaded. - * If NO_REMAP is defined, the argument data_start is ignored and the - * segment boundaries are never changed. - * * Bss_start indicates how much of the data segment is to be saved in the * a.out file and restored when the program is executed. It gives the lowest * unsaved address, and is rounded up to a page boundary. The default when 0 @@ -66,9 +61,6 @@ what you give them. Help stamp out software-hoarding! */ * * The new file is set up to start at entry_address. * - * If you make improvements I'd like to get them too. - * harpo!utah-cs!thomas, thomas@Utah-20 - * */ /* Even more heavily modified by james@bigtex.cactus.org of Dell Computer Co. @@ -97,224 +89,224 @@ raid:/nfs/raid/src/dist-18.56/src> dump -h temacs temacs: **** SECTION HEADER TABLE **** -[No] Type Flags Addr Offset Size Name - Link Info Adralgn Entsize + [No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize -[1] 1 2 0x80480d4 0xd4 0x13 .interp - 0 0 0x1 0 + [1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 -[2] 5 2 0x80480e8 0xe8 0x388 .hash - 3 0 0x4 0x4 + [2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 -[3] 11 2 0x8048470 0x470 0x7f0 .dynsym - 4 1 0x4 0x10 + [3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 -[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr - 0 0 0x1 0 + [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 -[5] 9 2 0x8049010 0x1010 0x338 .rel.plt - 3 7 0x4 0x8 + [5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 -[6] 1 6 0x8049348 0x1348 0x3 .init - 0 0 0x4 0 + [6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 -[7] 1 6 0x804934c 0x134c 0x680 .plt - 0 0 0x4 0x4 + [7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 -[8] 1 6 0x80499cc 0x19cc 0x3c56f .text - 0 0 0x4 0 + [8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 -[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini - 0 0 0x4 0 + [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 -[10] 1 2 0x8085f40 0x3df40 0x69c .rodata - 0 0 0x4 0 + [10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 -[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 - 0 0 0x4 0 + [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 -[12] 1 3 0x8088330 0x3f330 0x20afc .data - 0 0 0x4 0 + [12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 -[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 - 0 0 0x4 0 + [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 -[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got - 0 0 0x4 0x4 + [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 -[15] 6 3 0x80a9874 0x60874 0x80 .dynamic - 4 0 0x4 0x8 + [15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 -[16] 8 3 0x80a98f4 0x608f4 0x449c .bss - 0 0 0x4 0 + [16] 8 3 0x80a98f4 0x608f4 0x449c .bss + 0 0 0x4 0 -[17] 2 0 0 0x608f4 0x9b90 .symtab - 18 371 0x4 0x10 + [17] 2 0 0 0x608f4 0x9b90 .symtab + 18 371 0x4 0x10 -[18] 3 0 0 0x6a484 0x8526 .strtab - 0 0 0x1 0 + [18] 3 0 0 0x6a484 0x8526 .strtab + 0 0 0x1 0 -[19] 3 0 0 0x729aa 0x93 .shstrtab - 0 0 0x1 0 + [19] 3 0 0 0x729aa 0x93 .shstrtab + 0 0 0x1 0 -[20] 1 0 0 0x72a3d 0x68b7 .comment - 0 0 0x1 0 + [20] 1 0 0 0x72a3d 0x68b7 .comment + 0 0 0x1 0 -raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs + raid:/nfs/raid/src/dist-18.56/src> dump -h xemacs -xemacs: + xemacs: - **** SECTION HEADER TABLE **** -[No] Type Flags Addr Offset Size Name - Link Info Adralgn Entsize + **** SECTION HEADER TABLE **** + [No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize -[1] 1 2 0x80480d4 0xd4 0x13 .interp - 0 0 0x1 0 + [1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 -[2] 5 2 0x80480e8 0xe8 0x388 .hash - 3 0 0x4 0x4 + [2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 -[3] 11 2 0x8048470 0x470 0x7f0 .dynsym - 4 1 0x4 0x10 + [3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 -[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr - 0 0 0x1 0 + [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 -[5] 9 2 0x8049010 0x1010 0x338 .rel.plt - 3 7 0x4 0x8 + [5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 -[6] 1 6 0x8049348 0x1348 0x3 .init - 0 0 0x4 0 + [6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 -[7] 1 6 0x804934c 0x134c 0x680 .plt - 0 0 0x4 0x4 + [7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 -[8] 1 6 0x80499cc 0x19cc 0x3c56f .text - 0 0 0x4 0 + [8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 -[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini - 0 0 0x4 0 + [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 -[10] 1 2 0x8085f40 0x3df40 0x69c .rodata - 0 0 0x4 0 + [10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 -[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 - 0 0 0x4 0 + [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 -[12] 1 3 0x8088330 0x3f330 0x20afc .data - 0 0 0x4 0 + [12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 -[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 - 0 0 0x4 0 + [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 -[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got - 0 0 0x4 0x4 + [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 -[15] 6 3 0x80a9874 0x60874 0x80 .dynamic - 4 0 0x4 0x8 + [15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 -[16] 8 3 0x80c6800 0x7d800 0 .bss - 0 0 0x4 0 + [16] 8 3 0x80c6800 0x7d800 0 .bss + 0 0 0x4 0 -[17] 2 0 0 0x7d800 0x9b90 .symtab - 18 371 0x4 0x10 + [17] 2 0 0 0x7d800 0x9b90 .symtab + 18 371 0x4 0x10 -[18] 3 0 0 0x87390 0x8526 .strtab - 0 0 0x1 0 + [18] 3 0 0 0x87390 0x8526 .strtab + 0 0 0x1 0 -[19] 3 0 0 0x8f8b6 0x93 .shstrtab - 0 0 0x1 0 + [19] 3 0 0 0x8f8b6 0x93 .shstrtab + 0 0 0x1 0 -[20] 1 0 0 0x8f949 0x68b7 .comment - 0 0 0x1 0 + [20] 1 0 0 0x8f949 0x68b7 .comment + 0 0 0x1 0 -[21] 1 3 0x80a98f4 0x608f4 0x1cf0c .data - 0 0 0x4 0 + [21] 1 3 0x80a98f4 0x608f4 0x1cf0c .data + 0 0 0x4 0 - * This is an example of how the file header is changed. "Shoff" is - * the section header offset within the file. Since that table is - * after the new .data section, it is moved. "Shnum" is the number of - * sections, which we increment. - * - * "Phoff" is the file offset to the program header. "Phentsize" and - * "Shentsz" are the program and section header entries sizes respectively. - * These can be larger than the apparent struct sizes. + * This is an example of how the file header is changed. "Shoff" is + * the section header offset within the file. Since that table is + * after the new .data section, it is moved. "Shnum" is the number of + * sections, which we increment. + * + * "Phoff" is the file offset to the program header. "Phentsize" and + * "Shentsz" are the program and section header entries sizes respectively. + * These can be larger than the apparent struct sizes. -raid:/nfs/raid/src/dist-18.56/src> dump -f temacs + raid:/nfs/raid/src/dist-18.56/src> dump -f temacs -temacs: + temacs: - **** ELF HEADER **** -Class Data Type Machine Version -Entry Phoff Shoff Flags Ehsize -Phentsize Phnum Shentsz Shnum Shstrndx + **** ELF HEADER **** + Class Data Type Machine Version + Entry Phoff Shoff Flags Ehsize + Phentsize Phnum Shentsz Shnum Shstrndx -1 1 2 3 1 -0x80499cc 0x34 0x792f4 0 0x34 -0x20 5 0x28 21 19 + 1 1 2 3 1 + 0x80499cc 0x34 0x792f4 0 0x34 + 0x20 5 0x28 21 19 -raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs + raid:/nfs/raid/src/dist-18.56/src> dump -f xemacs -xemacs: + xemacs: - **** ELF HEADER **** -Class Data Type Machine Version -Entry Phoff Shoff Flags Ehsize -Phentsize Phnum Shentsz Shnum Shstrndx + **** ELF HEADER **** + Class Data Type Machine Version + Entry Phoff Shoff Flags Ehsize + Phentsize Phnum Shentsz Shnum Shstrndx -1 1 2 3 1 -0x80499cc 0x34 0x96200 0 0x34 -0x20 5 0x28 22 19 + 1 1 2 3 1 + 0x80499cc 0x34 0x96200 0 0x34 + 0x20 5 0x28 22 19 - * These are the program headers. "Offset" is the file offset to the - * segment. "Vaddr" is the memory load address. "Filesz" is the - * segment size as it appears in the file, and "Memsz" is the size in - * memory. Below, the third segment is the code and the fourth is the - * data: the difference between Filesz and Memsz is .bss + * These are the program headers. "Offset" is the file offset to the + * segment. "Vaddr" is the memory load address. "Filesz" is the + * segment size as it appears in the file, and "Memsz" is the size in + * memory. Below, the third segment is the code and the fourth is the + * data: the difference between Filesz and Memsz is .bss -raid:/nfs/raid/src/dist-18.56/src> dump -o temacs + raid:/nfs/raid/src/dist-18.56/src> dump -o temacs -temacs: - ***** PROGRAM EXECUTION HEADER ***** -Type Offset Vaddr Paddr -Filesz Memsz Flags Align + temacs: + ***** PROGRAM EXECUTION HEADER ***** + Type Offset Vaddr Paddr + Filesz Memsz Flags Align -6 0x34 0x8048034 0 -0xa0 0xa0 5 0 + 6 0x34 0x8048034 0 + 0xa0 0xa0 5 0 -3 0xd4 0 0 -0x13 0 4 0 + 3 0xd4 0 0 + 0x13 0 4 0 -1 0x34 0x8048034 0 -0x3f2f9 0x3f2f9 5 0x1000 + 1 0x34 0x8048034 0 + 0x3f2f9 0x3f2f9 5 0x1000 -1 0x3f330 0x8088330 0 -0x215c4 0x25a60 7 0x1000 + 1 0x3f330 0x8088330 0 + 0x215c4 0x25a60 7 0x1000 -2 0x60874 0x80a9874 0 -0x80 0 7 0 + 2 0x60874 0x80a9874 0 + 0x80 0 7 0 -raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs + raid:/nfs/raid/src/dist-18.56/src> dump -o xemacs -xemacs: - ***** PROGRAM EXECUTION HEADER ***** -Type Offset Vaddr Paddr -Filesz Memsz Flags Align + xemacs: + ***** PROGRAM EXECUTION HEADER ***** + Type Offset Vaddr Paddr + Filesz Memsz Flags Align -6 0x34 0x8048034 0 -0xa0 0xa0 5 0 + 6 0x34 0x8048034 0 + 0xa0 0xa0 5 0 -3 0xd4 0 0 -0x13 0 4 0 + 3 0xd4 0 0 + 0x13 0 4 0 -1 0x34 0x8048034 0 -0x3f2f9 0x3f2f9 5 0x1000 + 1 0x34 0x8048034 0 + 0x3f2f9 0x3f2f9 5 0x1000 -1 0x3f330 0x8088330 0 -0x3e4d0 0x3e4d0 7 0x1000 + 1 0x3f330 0x8088330 0 + 0x3e4d0 0x3e4d0 7 0x1000 -2 0x60874 0x80a9874 0 -0x80 0 7 0 + 2 0x60874 0x80a9874 0 + 0x80 0 7 0 */ @@ -344,90 +336,213 @@ Filesz Memsz Flags Align * The above example now should look like: **** SECTION HEADER TABLE **** -[No] Type Flags Addr Offset Size Name - Link Info Adralgn Entsize + [No] Type Flags Addr Offset Size Name + Link Info Adralgn Entsize -[1] 1 2 0x80480d4 0xd4 0x13 .interp - 0 0 0x1 0 + [1] 1 2 0x80480d4 0xd4 0x13 .interp + 0 0 0x1 0 -[2] 5 2 0x80480e8 0xe8 0x388 .hash - 3 0 0x4 0x4 + [2] 5 2 0x80480e8 0xe8 0x388 .hash + 3 0 0x4 0x4 -[3] 11 2 0x8048470 0x470 0x7f0 .dynsym - 4 1 0x4 0x10 + [3] 11 2 0x8048470 0x470 0x7f0 .dynsym + 4 1 0x4 0x10 -[4] 3 2 0x8048c60 0xc60 0x3ad .dynstr - 0 0 0x1 0 + [4] 3 2 0x8048c60 0xc60 0x3ad .dynstr + 0 0 0x1 0 -[5] 9 2 0x8049010 0x1010 0x338 .rel.plt - 3 7 0x4 0x8 + [5] 9 2 0x8049010 0x1010 0x338 .rel.plt + 3 7 0x4 0x8 -[6] 1 6 0x8049348 0x1348 0x3 .init - 0 0 0x4 0 + [6] 1 6 0x8049348 0x1348 0x3 .init + 0 0 0x4 0 -[7] 1 6 0x804934c 0x134c 0x680 .plt - 0 0 0x4 0x4 + [7] 1 6 0x804934c 0x134c 0x680 .plt + 0 0 0x4 0x4 -[8] 1 6 0x80499cc 0x19cc 0x3c56f .text - 0 0 0x4 0 + [8] 1 6 0x80499cc 0x19cc 0x3c56f .text + 0 0 0x4 0 -[9] 1 6 0x8085f3c 0x3df3c 0x3 .fini - 0 0 0x4 0 + [9] 1 6 0x8085f3c 0x3df3c 0x3 .fini + 0 0 0x4 0 -[10] 1 2 0x8085f40 0x3df40 0x69c .rodata - 0 0 0x4 0 + [10] 1 2 0x8085f40 0x3df40 0x69c .rodata + 0 0 0x4 0 -[11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 - 0 0 0x4 0 + [11] 1 2 0x80865dc 0x3e5dc 0xd51 .rodata1 + 0 0 0x4 0 -[12] 1 3 0x8088330 0x3f330 0x20afc .data - 0 0 0x4 0 + [12] 1 3 0x8088330 0x3f330 0x20afc .data + 0 0 0x4 0 -[13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 - 0 0 0x4 0 + [13] 1 3 0x80a8e2c 0x5fe2c 0x89d .data1 + 0 0 0x4 0 -[14] 1 3 0x80a96cc 0x606cc 0x1a8 .got - 0 0 0x4 0x4 + [14] 1 3 0x80a96cc 0x606cc 0x1a8 .got + 0 0 0x4 0x4 -[15] 6 3 0x80a9874 0x60874 0x80 .dynamic - 4 0 0x4 0x8 + [15] 6 3 0x80a9874 0x60874 0x80 .dynamic + 4 0 0x4 0x8 -[16] 1 3 0x80a98f4 0x608f4 0x1cf0c .data - 0 0 0x4 0 + [16] 1 3 0x80a98f4 0x608f4 0x1cf0c .data + 0 0 0x4 0 -[17] 8 3 0x80c6800 0x7d800 0 .bss - 0 0 0x4 0 + [17] 8 3 0x80c6800 0x7d800 0 .bss + 0 0 0x4 0 -[18] 2 0 0 0x7d800 0x9b90 .symtab - 19 371 0x4 0x10 + [18] 2 0 0 0x7d800 0x9b90 .symtab + 19 371 0x4 0x10 -[19] 3 0 0 0x87390 0x8526 .strtab - 0 0 0x1 0 + [19] 3 0 0 0x87390 0x8526 .strtab + 0 0 0x1 0 -[20] 3 0 0 0x8f8b6 0x93 .shstrtab - 0 0 0x1 0 + [20] 3 0 0 0x8f8b6 0x93 .shstrtab + 0 0 0x1 0 -[21] 1 0 0 0x8f949 0x68b7 .comment - 0 0 0x1 0 + [21] 1 0 0 0x8f949 0x68b7 .comment + 0 0 0x1 0 */ +/* We do not use mmap because that fails with NFS. + Instead we read the whole file, modify it, and write it out. */ + +#ifndef emacs +#define fatal(a, b, c) fprintf (stderr, a, b, c), exit (1) +#include <string.h> +#else +#include <config.h> +extern void fatal (const char *msgid, ...); +#endif + #include <sys/types.h> #include <stdio.h> #include <sys/stat.h> #include <memory.h> -#include <string.h> #include <errno.h> #include <unistd.h> #include <fcntl.h> +#if !defined (__NetBSD__) && !defined (__OpenBSD__) #include <elf.h> +#endif #include <sys/mman.h> - -#ifndef emacs -#define fatal(a, b, c) fprintf (stderr, a, b, c), exit (1) +#if defined (__sony_news) && defined (_SYSTYPE_SYSV) +#include <sys/elf_mips.h> +#include <sym.h> +#endif /* __sony_news && _SYSTYPE_SYSV */ +#if __sgi +#include <syms.h> /* for HDRR declaration */ +#endif /* __sgi */ + +#ifndef MAP_ANON +#ifdef MAP_ANONYMOUS +#define MAP_ANON MAP_ANONYMOUS #else -#include <config.h> -extern void fatal (char *, ...); +#define MAP_ANON 0 +#endif +#endif + +#ifndef MAP_FAILED +#define MAP_FAILED ((void *) -1) +#endif + +#if defined (__alpha__) && !defined (__NetBSD__) && !defined (__OpenBSD__) +/* Declare COFF debugging symbol table. This used to be in + /usr/include/sym.h, but this file is no longer included in Red Hat + 5.0 and presumably in any other glibc 2.x based distribution. */ +typedef struct { + short magic; + short vstamp; + int ilineMax; + int idnMax; + int ipdMax; + int isymMax; + int ioptMax; + int iauxMax; + int issMax; + int issExtMax; + int ifdMax; + int crfd; + int iextMax; + long cbLine; + long cbLineOffset; + long cbDnOffset; + long cbPdOffset; + long cbSymOffset; + long cbOptOffset; + long cbAuxOffset; + long cbSsOffset; + long cbSsExtOffset; + long cbFdOffset; + long cbRfdOffset; + long cbExtOffset; +} HDRR, *pHDRR; +#define cbHDRR sizeof(HDRR) +#define hdrNil ((pHDRR)0) +#endif + +#ifdef __NetBSD__ +/* + * NetBSD does not have normal-looking user-land ELF support. + */ +# if defined __alpha__ || defined __sparc_v9__ +# define ELFSIZE 64 +# else +# define ELFSIZE 32 +# endif +# include <sys/exec_elf.h> + +# ifndef PT_LOAD +# define PT_LOAD Elf_pt_load +# if 0 /* was in pkgsrc patches for 20.7 */ +# define SHT_PROGBITS Elf_sht_progbits +# endif +# define SHT_SYMTAB Elf_sht_symtab +# define SHT_DYNSYM Elf_sht_dynsym +# define SHT_NULL Elf_sht_null +# define SHT_NOBITS Elf_sht_nobits +# define SHT_REL Elf_sht_rel +# define SHT_RELA Elf_sht_rela + +# define SHN_UNDEF Elf_eshn_undefined +# define SHN_ABS Elf_eshn_absolute +# define SHN_COMMON Elf_eshn_common +# endif /* !PT_LOAD */ + +# ifdef __alpha__ +# include <sys/exec_ecoff.h> +# define HDRR struct ecoff_symhdr +# define pHDRR HDRR * +# endif /* __alpha__ */ + +#ifdef __mips__ /* was in pkgsrc patches for 20.7 */ +# define SHT_MIPS_DEBUG DT_MIPS_FLAGS +# define HDRR struct Elf_Shdr +#endif /* __mips__ */ +#endif /* __NetBSD__ */ + +#ifdef __OpenBSD__ +# include <sys/exec_elf.h> +#endif + +#if __GNU_LIBRARY__ - 0 >= 6 +# include <link.h> /* get ElfW etc */ +#endif + +#ifndef ElfW +# ifdef __STDC__ +# define ElfBitsW(bits, type) Elf##bits##_##type +# else +# define ElfBitsW(bits, type) Elf/**/bits/**/_/**/type +# endif +# ifdef _LP64 +# define ELFSIZE 64 +# else +# define ELFSIZE 32 +# endif + /* This macro expands `bits' before invoking ElfBitsW. */ +# define ElfExpandBitsW(bits, type) ElfBitsW (bits, type) +# define ElfW(type) ElfExpandBitsW (ELFSIZE, type) #endif #ifndef ELF_BSS_SECTION_NAME @@ -437,7 +552,7 @@ extern void fatal (char *, ...); /* Get the address of a particular section or program header entry, * accounting for the size of the entries. */ -/* +/* On PPC Reference Platform running Solaris 2.5.1 the plt section is also of type NOBI like the bss section. (not really stored) and therefore sections after the bss @@ -446,7 +561,7 @@ extern void fatal (char *, ...); Thus, we modify the test from if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset) to - if (NEW_SECTION_H (nn).sh_offset >= + if (NEW_SECTION_H (nn).sh_offset >= OLD_SECTION_H (old_bss_index-1).sh_offset) This is just a hack. We should put the new data section before the .plt section. @@ -462,13 +577,13 @@ extern void fatal (char *, ...); */ #define OLD_SECTION_H(n) \ - (*(Elf32_Shdr *) ((byte *) old_section_h + old_file_h->e_shentsize * (n))) + (*(ElfW(Shdr) *) ((byte *) old_section_h + old_file_h->e_shentsize * (n))) #define NEW_SECTION_H(n) \ - (*(Elf32_Shdr *) ((byte *) new_section_h + new_file_h->e_shentsize * (n))) + (*(ElfW(Shdr) *) ((byte *) new_section_h + new_file_h->e_shentsize * (n))) #define OLD_PROGRAM_H(n) \ - (*(Elf32_Phdr *) ((byte *) old_program_h + old_file_h->e_phentsize * (n))) + (*(ElfW(Phdr) *) ((byte *) old_program_h + old_file_h->e_phentsize * (n))) #define NEW_PROGRAM_H(n) \ - (*(Elf32_Phdr *) ((byte *) new_program_h + new_file_h->e_phentsize * (n))) + (*(ElfW(Phdr) *) ((byte *) new_program_h + new_file_h->e_phentsize * (n))) #define PATCH_INDEX(n) \ do { \ @@ -478,9 +593,9 @@ typedef unsigned char byte; /* Round X up to a multiple of Y. */ -int +static ElfW(Addr) round_up (x, y) - int x, y; + ElfW(Addr) x, y; { int rem = x % y; if (rem == 0) @@ -488,6 +603,45 @@ round_up (x, y) return x - rem + y; } +/* Return the index of the section named NAME. + SECTION_NAMES, FILE_NAME and FILE_H give information + about the file we are looking in. + + If we don't find the section NAME, that is a fatal error + if NOERROR is 0; we return -1 if NOERROR is nonzero. */ + +static int +find_section (name, section_names, file_name, old_file_h, old_section_h, noerror) + char *name; + char *section_names; + char *file_name; + ElfW(Ehdr) *old_file_h; + ElfW(Shdr) *old_section_h; + int noerror; +{ + int idx; + + for (idx = 1; idx < old_file_h->e_shnum; idx++) + { +#ifdef DEBUG + fprintf (stderr, "Looking for %s - found %s\n", name, + section_names + OLD_SECTION_H (idx).sh_name); +#endif + if (!strcmp (section_names + OLD_SECTION_H (idx).sh_name, + name)) + break; + } + if (idx == old_file_h->e_shnum) + { + if (noerror) + return -1; + else + fatal ("Can't find %s in %s.\n", name, file_name); + } + + return idx; +} + /* **************************************************************** * unexec * @@ -504,28 +658,38 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) { int new_file, old_file, new_file_size; - /* Pointers to the base of the image of the two files. */ + /* Pointers to the base of the image of the two files. */ caddr_t old_base, new_base; - /* Pointers to the file, program and section headers for the old and new - * files. - */ - Elf32_Ehdr *old_file_h, *new_file_h; - Elf32_Phdr *old_program_h, *new_program_h; - Elf32_Shdr *old_section_h, *new_section_h; +#if MAP_ANON == 0 + int mmap_fd; +#else +# define mmap_fd -1 +#endif + + /* Pointers to the file, program and section headers for the old and + new files. */ + ElfW(Ehdr) *old_file_h, *new_file_h; + ElfW(Phdr) *old_program_h, *new_program_h; + ElfW(Shdr) *old_section_h, *new_section_h; - /* Point to the section name table in the old file */ + /* Point to the section name table in the old file. */ char *old_section_names; - Elf32_Addr old_bss_addr, new_bss_addr; - Elf32_Word old_bss_size, new_data2_size; - Elf32_Off new_data2_offset; - Elf32_Addr new_data2_addr; + ElfW(Addr) old_bss_addr, new_bss_addr; + ElfW(Word) old_bss_size, new_data2_size; + ElfW(Off) new_data2_offset; + ElfW(Addr) new_data2_addr; - int n, nn, old_bss_index, old_data_index; + int n, nn; + int old_bss_index, old_sbss_index; + int old_data_index, new_data2_index; + int old_mdebug_index; struct stat stat_buf; + int old_file_size; - /* Open the old file & map it into the address space. */ + /* Open the old file, allocate a buffer of the right size, and read + in the file contents. */ old_file = open (old_name, O_RDONLY); @@ -535,52 +699,79 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) if (fstat (old_file, &stat_buf) == -1) fatal ("Can't fstat (%s): errno %d\n", old_name, errno); - old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0); +#if MAP_ANON == 0 + mmap_fd = open ("/dev/zero", O_RDONLY); + if (mmap_fd < 0) + fatal ("Can't open /dev/zero for reading: errno %d\n", errno, 0); +#endif - if (old_base == (caddr_t) -1) - fatal ("Can't mmap (%s): errno %d\n", old_name, errno); + /* We cannot use malloc here because that may use sbrk. If it does, + we'd dump our temporary buffers with Emacs, and we'd have to be + extra careful to use the correct value of sbrk(0) after + allocating all buffers in the code below, which we aren't. */ + old_file_size = stat_buf.st_size; + old_base = mmap (NULL, old_file_size, PROT_READ | PROT_WRITE, + MAP_ANON | MAP_PRIVATE, mmap_fd, 0); + if (old_base == MAP_FAILED) + fatal ("Can't allocate buffer for %s\n", old_name, 0); -#ifdef DEBUG - fprintf (stderr, "mmap (%s, %x) -> %x\n", old_name, stat_buf.st_size, - old_base); -#endif + if (read (old_file, old_base, stat_buf.st_size) != stat_buf.st_size) + fatal ("Didn't read all of %s: errno %d\n", old_name, errno); /* Get pointers to headers & section names */ - old_file_h = (Elf32_Ehdr *) old_base; - old_program_h = (Elf32_Phdr *) ((byte *) old_base + old_file_h->e_phoff); - old_section_h = (Elf32_Shdr *) ((byte *) old_base + old_file_h->e_shoff); + old_file_h = (ElfW(Ehdr) *) old_base; + old_program_h = (ElfW(Phdr) *) ((byte *) old_base + old_file_h->e_phoff); + old_section_h = (ElfW(Shdr) *) ((byte *) old_base + old_file_h->e_shoff); old_section_names = (char *) old_base + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset; + /* Find the mdebug section, if any. */ + + old_mdebug_index = find_section (".mdebug", old_section_names, + old_name, old_file_h, old_section_h, 1); + /* Find the old .bss section. Figure out parameters of the new - * data2 and bss sections. - */ + data2 and bss sections. */ + + old_bss_index = find_section (".bss", old_section_names, + old_name, old_file_h, old_section_h, 0); - for (old_bss_index = 1; old_bss_index < (int) old_file_h->e_shnum; - old_bss_index++) + old_sbss_index = find_section (".sbss", old_section_names, + old_name, old_file_h, old_section_h, 1); + if (old_sbss_index != -1) + if (OLD_SECTION_H (old_sbss_index).sh_type == SHT_PROGBITS) + old_sbss_index = -1; + + if (old_sbss_index == -1) { -#ifdef DEBUG - fprintf (stderr, "Looking for .bss - found %s\n", - old_section_names + OLD_SECTION_H (old_bss_index).sh_name); -#endif - if (!strcmp (old_section_names + OLD_SECTION_H (old_bss_index).sh_name, - ELF_BSS_SECTION_NAME)) - break; + old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr; + old_bss_size = OLD_SECTION_H (old_bss_index).sh_size; + new_data2_index = old_bss_index; } - if (old_bss_index == old_file_h->e_shnum) - fatal ("Can't find .bss in %s.\n", old_name, 0); + else + { + old_bss_addr = OLD_SECTION_H (old_sbss_index).sh_addr; + old_bss_size = OLD_SECTION_H (old_bss_index).sh_size + + OLD_SECTION_H (old_sbss_index).sh_size; + new_data2_index = old_sbss_index; + } + + /* Find the old .data section. Figure out parameters of + the new data2 and bss sections. */ + + old_data_index = find_section (".data", old_section_names, + old_name, old_file_h, old_section_h, 0); - old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr; - old_bss_size = OLD_SECTION_H (old_bss_index).sh_size; -#if defined(emacs) || !defined(DEBUG) - new_bss_addr = (Elf32_Addr) sbrk (0); +#if defined (emacs) || !defined (DEBUG) + new_bss_addr = (ElfW(Addr)) sbrk (0); #else new_bss_addr = old_bss_addr + old_bss_size + 0x1234; #endif new_data2_addr = old_bss_addr; new_data2_size = new_bss_addr - old_bss_addr; - new_data2_offset = OLD_SECTION_H (old_bss_index).sh_offset; + new_data2_offset = OLD_SECTION_H (old_data_index).sh_offset + + (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr); #ifdef DEBUG fprintf (stderr, "old_bss_index %d\n", old_bss_index); @@ -595,10 +786,9 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) fatal (".bss shrank when undumping???\n", 0, 0); - /* Set the output file to the right size and mmap it. Set - * pointers to various interesting objects. stat_buf still has - * old_file data. - */ + /* Set the output file to the right size. Allocate a buffer to hold + the image of the new file. Set pointers to various interesting + objects. stat_buf still has old_file data. */ new_file = open (new_name, O_RDWR | O_CREAT, 0666); if (new_file < 0) @@ -609,25 +799,18 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) if (ftruncate (new_file, new_file_size)) fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); -#ifdef UNEXEC_USE_MAP_PRIVATE - new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_PRIVATE, - new_file, 0); -#else - new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED, - new_file, 0); -#endif - - if (new_base == (caddr_t) -1) - fatal ("Can't mmap (%s): errno %d\n", new_name, errno); + new_base = mmap (NULL, new_file_size, PROT_READ | PROT_WRITE, + MAP_ANON | MAP_PRIVATE, mmap_fd, 0); + if (new_base == MAP_FAILED) + fatal ("Can't allocate buffer for %s\n", old_name, 0); - new_file_h = (Elf32_Ehdr *) new_base; - new_program_h = (Elf32_Phdr *) ((byte *) new_base + old_file_h->e_phoff); - new_section_h = (Elf32_Shdr *) + new_file_h = (ElfW(Ehdr) *) new_base; + new_program_h = (ElfW(Phdr) *) ((byte *) new_base + old_file_h->e_phoff); + new_section_h = (ElfW(Shdr) *) ((byte *) new_base + old_file_h->e_shoff + new_data2_size); /* Make our new file, program and section headers as copies of the - * originals. - */ + originals. */ memcpy (new_file_h, old_file_h, old_file_h->e_ehsize); memcpy (new_program_h, old_program_h, @@ -637,8 +820,7 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) PATCH_INDEX (new_file_h->e_shstrndx); /* Fix up file header. We'll add one section. Section header is - * further away now. - */ + further away now. */ new_file_h->e_shoff += new_data2_size; new_file_h->e_shnum += 1; @@ -651,22 +833,31 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) #endif /* Fix up a new program header. Extend the writable data segment so - * that the bss area is covered too. Find that segment by looking - * for a segment that ends just before the .bss area. Make sure - * that no segments are above the new .data2. Put a loop at the end - * to adjust the offset and address of any segment that is above - * data2, just in case we decide to allow this later. - */ + that the bss area is covered too. Find that segment by looking + for a segment that ends just before the .bss area. Make sure + that no segments are above the new .data2. Put a loop at the end + to adjust the offset and address of any segment that is above + data2, just in case we decide to allow this later. */ for (n = new_file_h->e_phnum - 1; n >= 0; n--) { /* Compute maximum of all requirements for alignment of section. */ - int alignment = (NEW_PROGRAM_H (n)).p_align; + ElfW(Word) alignment = (NEW_PROGRAM_H (n)).p_align; if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment) alignment = OLD_SECTION_H (old_bss_index).sh_addralign; - if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr) - fatal ("Program segment above .bss in %s\n", old_name, 0); +#ifdef __sgi + /* According to r02kar@x4u2.desy.de (Karsten Kuenne) + and oliva@gnu.org (Alexandre Oliva), on IRIX 5.2, we + always get "Program segment above .bss" when dumping + when the executable doesn't have an sbss section. */ + if (old_sbss_index != -1) +#endif /* __sgi */ + if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz + > (old_sbss_index == -1 + ? old_bss_addr + : round_up (old_bss_addr, alignment))) + fatal ("Program segment above .bss in %s\n", old_name, 0); if (NEW_PROGRAM_H (n).p_type == PT_LOAD && (round_up ((NEW_PROGRAM_H (n)).p_vaddr @@ -678,7 +869,9 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) if (n < 0) fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0); - NEW_PROGRAM_H (n).p_filesz += new_data2_size; + /* Make sure that the size includes any padding before the old .bss + section. */ + NEW_PROGRAM_H (n).p_filesz = new_bss_addr - NEW_PROGRAM_H (n).p_vaddr; NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz; #if 0 /* Maybe allow section after data2 - does this ever happen? */ @@ -694,11 +887,10 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) #endif /* Fix up section headers based on new .data2 section. Any section - * whose offset or virtual address is after the new .data2 section - * gets its value adjusted. .bss size becomes zero and new address - * is set. data2 section header gets added by copying the existing - * .data header and modifying the offset, address and size. - */ + whose offset or virtual address is after the new .data2 section + gets its value adjusted. .bss size becomes zero and new address + is set. data2 section header gets added by copying the existing + .data header and modifying the offset, address and size. */ for (old_data_index = 1; old_data_index < (int) old_file_h->e_shnum; old_data_index++) if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name, @@ -712,8 +904,10 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) for (n = 1, nn = 1; n < (int) old_file_h->e_shnum; n++, nn++) { caddr_t src; - /* If it is bss section, insert the new data2 section before it. */ - if (n == old_bss_index) + /* If it is (s)bss section, insert the new data2 section before it. */ + /* new_data2_index is the index of either old_sbss or old_bss, that was + chosen as a section for new_data2. */ + if (n == new_data2_index) { /* Steal the data section header for this data2 section. */ memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index), @@ -737,13 +931,17 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n), old_file_h->e_shentsize); - /* The new bss section's size is zero, and its file offset and virtual - address should be off by NEW_DATA2_SIZE. */ - if (n == old_bss_index) + if (n == old_bss_index + /* The new bss and sbss section's size is zero, and its file offset + and virtual address should be off by NEW_DATA2_SIZE. */ + || n == old_sbss_index + ) { - /* NN should be `old_bss_index + 1' at this point. */ - NEW_SECTION_H (nn).sh_offset += new_data2_size; - NEW_SECTION_H (nn).sh_addr += new_data2_size; + /* NN should be `old_s?bss_index + 1' at this point. */ + NEW_SECTION_H (nn).sh_offset = + NEW_SECTION_H (new_data2_index).sh_offset + new_data2_size; + NEW_SECTION_H (nn).sh_addr = + NEW_SECTION_H (new_data2_index).sh_addr + new_data2_size; /* Let the new bss section address alignment be the same as the section address alignment followed the old bss section, so this section will be placed in exactly the same place. */ @@ -752,8 +950,13 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) } else { - /* Any section that was original placed AFTER the bss - section should now be off by NEW_DATA2_SIZE. */ + /* Any section that was originally placed after the .bss + section should now be off by NEW_DATA2_SIZE. If a + section overlaps the .bss section, consider it to be + placed after the .bss section. Overlap can occur if the + section just before .bss has less-strict alignment; this + was observed between .symtab and .bss on Solaris 2.5.1 + (sparc) with GCC snapshot 960602. */ #ifdef SOLARIS_POWERPC /* On PPC Reference Platform running Solaris 2.5.1 the plt section is also of type NOBI like the bss section. @@ -767,9 +970,8 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) >= OLD_SECTION_H (old_bss_index-1).sh_offset) NEW_SECTION_H (nn).sh_offset += new_data2_size; #else - if (round_up (NEW_SECTION_H (nn).sh_offset, - OLD_SECTION_H (old_bss_index).sh_addralign) - >= new_data2_offset) + if (NEW_SECTION_H (nn).sh_offset + NEW_SECTION_H (nn).sh_size + > new_data2_offset) NEW_SECTION_H (nn).sh_offset += new_data2_size; #endif /* Any section that was originally placed after the section @@ -790,6 +992,15 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM) PATCH_INDEX (NEW_SECTION_H (nn).sh_info); + if (old_sbss_index != -1) + if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".sbss")) + { + NEW_SECTION_H (nn).sh_offset = + round_up (NEW_SECTION_H (nn).sh_offset, + NEW_SECTION_H (nn).sh_addralign); + NEW_SECTION_H (nn).sh_type = SHT_PROGBITS; + } + /* Now, start to copy the content of sections. */ if (NEW_SECTION_H (nn).sh_type == SHT_NULL || NEW_SECTION_H (nn).sh_type == SHT_NOBITS) @@ -800,7 +1011,41 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) instead of the old file. */ if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data") || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), - ".data1")) + ".sdata") + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".lit4") + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".lit8") + /* The conditional bit below was in Oliva's original code + (1999-08-25) and seems to have been dropped by mistake + subsequently. It prevents a crash at startup under X in + `IRIX64 6.5 6.5.17m', whether compiled on that relase or + an earlier one. It causes no trouble on the other ELF + platforms I could test (Irix 6.5.15m, Solaris 8, Debian + Potato x86, Debian Woody SPARC); however, it's reported + to cause crashes under some version of GNU/Linux. It's + not yet clear what's changed in that Irix version to + cause the problem, or why the fix sometimes fails under + GNU/Linux. There's probably no good reason to have + something Irix-specific here, but this will have to do + for now. IRIX6_5 is the most specific macro we have to + test. -- fx 2002-10-01 + + The issue _looks_ as though it's gone away on 6.5.18m, + but maybe it's still lurking, to be triggered by some + change in the binary. It appears to concern the dynamic + loader, but I never got anywhere with an SGI support call + seeking clues. -- fx 2002-11-29. */ +#ifdef IRIX6_5 + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".got") +#endif + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".sdata1") + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".data1") + || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name), + ".sbss")) src = (caddr_t) OLD_SECTION_H (n).sh_addr; else src = old_base + OLD_SECTION_H (n).sh_offset; @@ -808,13 +1053,114 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src, NEW_SECTION_H (nn).sh_size); +#ifdef __alpha__ + /* Update Alpha COFF symbol table: */ + if (strcmp (old_section_names + OLD_SECTION_H (n).sh_name, ".mdebug") + == 0) + { + pHDRR symhdr = (pHDRR) (NEW_SECTION_H (nn).sh_offset + new_base); + + symhdr->cbLineOffset += new_data2_size; + symhdr->cbDnOffset += new_data2_size; + symhdr->cbPdOffset += new_data2_size; + symhdr->cbSymOffset += new_data2_size; + symhdr->cbOptOffset += new_data2_size; + symhdr->cbAuxOffset += new_data2_size; + symhdr->cbSsOffset += new_data2_size; + symhdr->cbSsExtOffset += new_data2_size; + symhdr->cbFdOffset += new_data2_size; + symhdr->cbRfdOffset += new_data2_size; + symhdr->cbExtOffset += new_data2_size; + } +#endif /* __alpha__ */ + +#if defined (__sony_news) && defined (_SYSTYPE_SYSV) + if (NEW_SECTION_H (nn).sh_type == SHT_MIPS_DEBUG + && old_mdebug_index != -1) + { + int diff = NEW_SECTION_H(nn).sh_offset + - OLD_SECTION_H(old_mdebug_index).sh_offset; + HDRR *phdr = (HDRR *)(NEW_SECTION_H (nn).sh_offset + new_base); + + if (diff) + { + phdr->cbLineOffset += diff; + phdr->cbDnOffset += diff; + phdr->cbPdOffset += diff; + phdr->cbSymOffset += diff; + phdr->cbOptOffset += diff; + phdr->cbAuxOffset += diff; + phdr->cbSsOffset += diff; + phdr->cbSsExtOffset += diff; + phdr->cbFdOffset += diff; + phdr->cbRfdOffset += diff; + phdr->cbExtOffset += diff; + } + } +#endif /* __sony_news && _SYSTYPE_SYSV */ + +#if __sgi + /* Adjust the HDRR offsets in .mdebug and copy the + line data if it's in its usual 'hole' in the object. + Makes the new file debuggable with dbx. + patches up two problems: the absolute file offsets + in the HDRR record of .mdebug (see /usr/include/syms.h), and + the ld bug that gets the line table in a hole in the + elf file rather than in the .mdebug section proper. + David Anderson. davea@sgi.com Jan 16,1994. */ + if (n == old_mdebug_index) + { +#define MDEBUGADJUST(__ct,__fileaddr) \ + if (n_phdrr->__ct > 0) \ + { \ + n_phdrr->__fileaddr += movement; \ + } + + HDRR * o_phdrr = (HDRR *)((byte *)old_base + OLD_SECTION_H (n).sh_offset); + HDRR * n_phdrr = (HDRR *)((byte *)new_base + NEW_SECTION_H (nn).sh_offset); + unsigned movement = new_data2_size; + + MDEBUGADJUST (idnMax, cbDnOffset); + MDEBUGADJUST (ipdMax, cbPdOffset); + MDEBUGADJUST (isymMax, cbSymOffset); + MDEBUGADJUST (ioptMax, cbOptOffset); + MDEBUGADJUST (iauxMax, cbAuxOffset); + MDEBUGADJUST (issMax, cbSsOffset); + MDEBUGADJUST (issExtMax, cbSsExtOffset); + MDEBUGADJUST (ifdMax, cbFdOffset); + MDEBUGADJUST (crfd, cbRfdOffset); + MDEBUGADJUST (iextMax, cbExtOffset); + /* The Line Section, being possible off in a hole of the object, + requires special handling. */ + if (n_phdrr->cbLine > 0) + { + if (o_phdrr->cbLineOffset > (OLD_SECTION_H (n).sh_offset + + OLD_SECTION_H (n).sh_size)) + { + /* line data is in a hole in elf. do special copy and adjust + for this ld mistake. + */ + n_phdrr->cbLineOffset += movement; + + memcpy (n_phdrr->cbLineOffset + new_base, + o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine); + } + else + { + /* somehow line data is in .mdebug as it is supposed to be. */ + MDEBUGADJUST (cbLine, cbLineOffset); + } + } + } +#endif /* __sgi */ + /* If it is the symbol table, its st_shndx field needs to be patched. */ if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM) { - Elf32_Shdr *spt = &NEW_SECTION_H (nn); + ElfW(Shdr) *spt = &NEW_SECTION_H (nn); unsigned int num = spt->sh_size / spt->sh_entsize; - Elf32_Sym * sym = (Elf32_Sym *) (NEW_SECTION_H (nn).sh_offset + + ElfW(Sym) * sym = (ElfW(Sym) *) (NEW_SECTION_H (nn).sh_offset + new_base); for (; num--; sym++) { @@ -832,7 +1178,7 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) for (n = new_file_h->e_shnum - 1; n; n--) { byte *symnames; - Elf32_Sym *symp, *symendp; + ElfW(Sym) *symp, *symendp; if (NEW_SECTION_H (n).sh_type != SHT_DYNSYM && NEW_SECTION_H (n).sh_type != SHT_SYMTAB) @@ -840,12 +1186,14 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) symnames = ((byte *) new_base + NEW_SECTION_H (NEW_SECTION_H (n).sh_link).sh_offset); - symp = (Elf32_Sym *) (NEW_SECTION_H (n).sh_offset + new_base); - symendp = (Elf32_Sym *) ((byte *)symp + NEW_SECTION_H (n).sh_size); + symp = (ElfW(Sym) *) (NEW_SECTION_H (n).sh_offset + new_base); + symendp = (ElfW(Sym) *) ((byte *)symp + NEW_SECTION_H (n).sh_size); for (; symp < symendp; symp ++) if (strcmp ((char *) (symnames + symp->st_name), "_end") == 0 - || strcmp ((char *) (symnames + symp->st_name), "_edata") == 0) + || strcmp ((char *) (symnames + symp->st_name), "end") == 0 + || strcmp ((char *) (symnames + symp->st_name), "_edata") == 0 + || strcmp ((char *) (symnames + symp->st_name), "edata") == 0) memcpy (&symp->st_value, &new_bss_addr, sizeof (new_bss_addr)); } @@ -853,44 +1201,78 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) that it can undo relocations performed by the runtime linker. */ for (n = new_file_h->e_shnum - 1; n; n--) { - Elf32_Shdr section = NEW_SECTION_H (n); - switch (section.sh_type) { - default: - break; - case SHT_REL: - case SHT_RELA: - /* This code handles two different size structs, but there should - be no harm in that provided that r_offset is always the first - member. */ - nn = section.sh_info; - if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data") - || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), - ".data1")) - { - Elf32_Addr offset = NEW_SECTION_H (nn).sh_addr - - NEW_SECTION_H (nn).sh_offset; - caddr_t reloc = old_base + section.sh_offset, end; - for (end = reloc + section.sh_size; reloc < end; - reloc += section.sh_entsize) - { - Elf32_Addr addr = ((Elf32_Rel *) reloc)->r_offset - offset; - memcpy (new_base + addr, old_base + addr, 4); - } - } - break; - } + ElfW(Shdr) section = NEW_SECTION_H (n); + + /* Cause a compilation error if anyone uses n instead of nn below. */ + struct {int a;} n; + (void)n.a; /* Prevent `unused variable' warnings. */ + + switch (section.sh_type) + { + default: + break; + case SHT_REL: + case SHT_RELA: + /* This code handles two different size structs, but there should + be no harm in that provided that r_offset is always the first + member. */ + nn = section.sh_info; + if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".sdata") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".lit4") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".lit8") +#ifdef IRIX6_5 /* see above */ + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".got") +#endif + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".sdata1") + || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name), + ".data1")) + { + ElfW(Addr) offset = (NEW_SECTION_H (nn).sh_addr + - NEW_SECTION_H (nn).sh_offset); + caddr_t reloc = old_base + section.sh_offset, end; + for (end = reloc + section.sh_size; reloc < end; + reloc += section.sh_entsize) + { + ElfW(Addr) addr = ((ElfW(Rel) *) reloc)->r_offset - offset; +#ifdef __alpha__ + /* The Alpha ELF binutils currently have a bug that + sometimes results in relocs that contain all + zeroes. Work around this for now... */ + if (((ElfW(Rel) *) reloc)->r_offset == 0) + continue; +#endif + memcpy (new_base + addr, old_base + addr, sizeof(ElfW(Addr))); + } + } + break; + } } -#ifdef UNEXEC_USE_MAP_PRIVATE - if (lseek (new_file, 0, SEEK_SET) == -1) - fatal ("Can't rewind (%s): errno %d\n", new_name, errno); + /* Write out new_file, and free the buffers. */ if (write (new_file, new_base, new_file_size) != new_file_size) - fatal ("Can't write (%s): errno %d\n", new_name, errno); +#ifndef emacs + fatal ("Didn't write %d bytes: errno %d\n", + new_file_size, errno); +#else + fatal ("Didn't write %d bytes to %s: errno %d\n", + new_file_size, new_base, errno); #endif + munmap (old_base, old_file_size); + munmap (new_base, new_file_size); /* Close the files and make the new file executable. */ +#if MAP_ANON == 0 + close (mmap_fd); +#endif + if (close (old_file)) fatal ("Can't close (%s): errno %d\n", old_name, errno); @@ -906,3 +1288,6 @@ unexec (new_name, old_name, data_start, bss_start, entry_address) if (chmod (new_name, stat_buf.st_mode) == -1) fatal ("Can't chmod (%s): errno %d\n", new_name, errno); } + +/* arch-tag: e02e1512-95e2-4ef0-bba7-b6bce658f1e3 + (do not change this comment) */ @@ -114,10 +114,10 @@ SCM resizuve(vect, len) if (siz != l * sz) wta(MAKINUM(l * sz), (char *) NALLOC, s_resizuve); DEFER_INTS; must_realloc_cell(vect, ol*sz, (long)siz, s_resizuve); - if VECTORP(vect) + if (VECTORP(vect)) while(l > ol) VELTS(vect)[--l] = UNSPECIFIED; - else if STRINGP(vect) + else if (STRINGP(vect)) CHARS(vect)[l-1] = 0; SETLENGTH(vect, INUM(len), TYP7(vect)); ALLOW_INTS; @@ -148,7 +148,7 @@ SCM makflo (x) long scm_prot2type(prot) SCM prot; { - if ICHRP(prot) return tc7_string; + if (ICHRP(prot)) return tc7_string; switch (prot) { case BOOL_T: return tc7_bvect; case MAKINUM(8L): @@ -158,12 +158,12 @@ long scm_prot2type(prot) case MAKINUM(-16L): return tc7_svect; case MAKINUM(-8L): return tc7_svect; } - /* if INUMP(prot) return INUM(prot) > 0 ? tc7_uvect : tc7_ivect; */ - if IMP(prot) return tc7_vector; + /* if (INUMP(prot)) return INUM(prot) > 0 ? tc7_uvect : tc7_ivect; */ + if (IMP(prot)) return tc7_vector; # ifdef FLOATS - if INEXP(prot) { + if (INEXP(prot)) { double x; - if CPLXP(prot) return tc7_cvect; + if (CPLXP(prot)) return tc7_cvect; x = REALPART(prot); if (32.0==x) return tc7_fvect; if (64.0==x) return tc7_dvect; @@ -223,7 +223,7 @@ SCM arrayp(v, prot) { int enclosed = 0; long typ; - if IMP(v) return BOOL_F; + if (IMP(v)) return BOOL_F; loop: typ = TYP7(v); switch (typ) { @@ -249,14 +249,14 @@ SCM arrayp(v, prot) SCM array_rank(ra) SCM ra; { - if IMP(ra) return INUM0; + if (IMP(ra)) return INUM0; switch (TYP7(ra)) { default: return INUM0; case tc7_vector: case tcs_uves: return MAKINUM(1L); case tc7_smob: - if ARRAYP(ra) return MAKINUM(ARRAY_NDIM(ra)); + if (ARRAYP(ra)) return MAKINUM(ARRAY_NDIM(ra)); return INUM0; } } @@ -267,7 +267,7 @@ SCM array_dims(ra) SCM res=EOL; sizet k; array_dim *s; - if IMP(ra) return BOOL_F; + if (IMP(ra)) return BOOL_F; switch (TYP7(ra)) { default: return BOOL_F; case tc7_vector: @@ -287,14 +287,14 @@ SCM array_dims(ra) static char s_bad_ind[] = "Bad array index"; long aind(ra, args, what) SCM ra, args; - char *what; + const char *what; { SCM ind; register long j; register sizet pos = ARRAY_BASE(ra); register sizet k = ARRAY_NDIM(ra); array_dim *s = ARRAY_DIMS(ra); - if INUMP(args) { + if (INUMP(args)) { ASRTER(1==k, UNDEFINED, WNA, what); j = INUM(args); ASRTER(j >= (s->lbnd) && j <= (s->ubnd), args, OUTOFRANGE, what); @@ -333,7 +333,7 @@ static char s_bad_spec[] = "Bad array dimension"; /* Increments will still need to be set. */ SCM shap2ra(args, what) SCM args; - char *what; + const char *what; { array_dim *s; SCM ra, spec, sp; @@ -344,7 +344,7 @@ SCM shap2ra(args, what) s = ARRAY_DIMS(ra); for (; NIMP(args); s++, args = CDR(args)) { spec = CAR(args); - if IMP(spec) { + if (IMP(spec)) { ASRTER(INUMP(spec)&&INUM(spec)>=0, spec, s_bad_spec, what); s->lbnd = 0; s->ubnd = INUM(spec) - 1; @@ -371,7 +371,7 @@ int rafill(ra, fill, ignore) sizet i, n; long inc = 1; sizet base = 0; - if ARRAYP(ra) { + if (ARRAYP(ra)) { n = ARRAY_DIMS(ra)->ubnd - ARRAY_DIMS(ra)->lbnd + 1; inc = ARRAY_DIMS(ra)->inc; base = ARRAY_BASE(ra); @@ -486,10 +486,10 @@ SCM dims2ura(dims, prot, fill) long rlen = 1; array_dim *s; SCM ra; - if INUMP(dims) { + if (INUMP(dims)) { if (INUM(dims) < LENGTH_MAX) { ra = make_uve(INUM(dims), prot); - if NNULLP(fill) + if (NNULLP(fill)) rafill(ra, CAR(fill), UNDEFINED); return ra; } @@ -526,7 +526,7 @@ SCM dims2ura(dims, prot, fill) ARRAY_V(ra) = make_uve(rlen, prot); *((long *)VELTS(ARRAY_V(ra))) = rlen; } - if NNULLP(fill) { + if (NNULLP(fill)) { ASRTER(1==ilength(fill), UNDEFINED, WNA, s_dims2ura); rafill(ARRAY_V(ra), CAR(fill), UNDEFINED); } @@ -601,10 +601,10 @@ SCM make_sh_array(oldra, mapfunc, dims) } } imap = scm_cvapply(mapfunc, ARRAY_NDIM(ra), indv); - if ARRAYP(oldra) + if (ARRAYP(oldra)) i = (sizet)aind(oldra, imap, s_make_sh_array); else { - if NINUMP(imap) { + if (NINUMP(imap)) { ASRTER(1==ilength(imap) && INUMP(CAR(imap)), imap, s_bad_ind, s_make_sh_array); imap = CAR(imap); @@ -619,10 +619,10 @@ SCM make_sh_array(oldra, mapfunc, dims) imap = apply(mapfunc, reverse(inds), EOL); */ indv[k] = MAKINUM(INUM(indv[k]) + 1); imap = scm_cvapply(mapfunc, ARRAY_NDIM(ra), indv); - if ARRAYP(oldra) + if (ARRAYP(oldra)) s[k].inc = aind(oldra, imap, s_make_sh_array) - i; else { - if NINUMP(imap) { + if (NINUMP(imap)) { ASRTER(1==ilength(imap) && INUMP(CAR(imap)), imap, s_bad_ind, s_make_sh_array); imap = CAR(imap); @@ -723,7 +723,7 @@ SCM encl_array(axes) ASRTER(NIMP(axes), UNDEFINED, WNA, s_encl_array); ra = CAR(axes); axes = CDR(axes); - if NULLP(axes) + if (NULLP(axes)) axes = cons((ARRAYP(ra) ? MAKINUM(ARRAY_NDIM(ra) - 1) : INUM0), EOL); ninr = ilength(axes); ra_inr = make_ra(ninr); @@ -780,11 +780,11 @@ SCM array_inbp(args) ASRTGO(NIMP(args), wna); v = CAR(args); args = CDR(args); - if IMP(v) goto scalar; + if (IMP(v)) goto scalar; switch TYP7(v) { wna: wta(UNDEFINED, (char *)WNA, s_array_inbp); default: scalar: - if NULLP(args) return BOOL_T; + if (NULLP(args)) return BOOL_T; wta(v, (char *)ARG1, s_array_inbp); case tc7_smob: if (ARRAYP(v)) { @@ -818,16 +818,16 @@ SCM aref(v, args) SCM v, args; { long pos; - if IMP(v) { + if (IMP(v)) { ASRTGO(NULLP(args), badarg); return v; } - else if ARRAYP(v) { + else if (ARRAYP(v)) { pos = aind(v, args, s_aref); v = ARRAY_V(v); } else { - if NIMP(args) { + if (NIMP(args)) { ASRTER(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aref); pos = INUM(CAR(args)); ASRTGO(NULLP(CDR(args)), wna); @@ -839,7 +839,7 @@ SCM aref(v, args) ASRTGO(pos >= 0 && pos < LENGTH(v), outrng); } switch TYP7(v) { - default: if NULLP(args) return v; + default: if (NULLP(args)) return v; badarg: wta(v, (char *)ARG1, s_aref); outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_aref); wna: wta(UNDEFINED, (char *)WNA, s_aref); @@ -995,12 +995,12 @@ SCM aset(v, obj, args) { long pos; ASRTGO(NIMP(v), badarg1); - if ARRAYP(v) { + if (ARRAYP(v)) { pos = aind(v, args, s_aset); v = ARRAY_V(v); } else { - if NIMP(args) { + if (NIMP(args)) { ASRTER(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aset); pos = INUM(CAR(args)); ASRTGO(NULLP(CDR(args)), wna); @@ -1067,7 +1067,7 @@ SCM array_contents(ra, strict) SCM ra, strict; { SCM sra; - if IMP(ra) return BOOL_F; + if (IMP(ra)) return BOOL_F; switch TYP7(ra) { default: return BOOL_F; @@ -1105,7 +1105,7 @@ SCM uve_read(v, port) { long sz, len, ans; long start=0; - if UNBNDP(port) port = cur_inp; + if (UNBNDP(port)) port = cur_inp; ASRTER(NIMP(port) && OPINFPORTP(port), port, ARG2, s_uve_rd); ASRTGO(NIMP(v), badarg1); len = LENGTH(v); @@ -1115,7 +1115,7 @@ SCM uve_read(v, port) case tc7_smob: v = array_contents(v, BOOL_T); ASRTGO(NIMP(v), badarg1); - if ARRAYP(v) { + if (ARRAYP(v)) { array_dim *d = ARRAY_DIMS(v); start = ARRAY_BASE(v); len = d->inc * (d->ubnd - d->lbnd + 1); @@ -1152,7 +1152,7 @@ SCM uve_read(v, port) if (0==len) return INUM0; /* An ungetc before an fread will not work on some systems if setbuf(0), so we read one element char by char. */ - if CRDYP(port) { + if (CRDYP(port)) { int i; for (i = 0; i < sz; i++) CHARS(v)[start*sz + i] = lgetc(port); @@ -1170,7 +1170,7 @@ SCM uve_write(v, port) { long sz, len, ans; long start=0; - if UNBNDP(port) port = cur_outp; + if (UNBNDP(port)) port = cur_outp; ASRTER(NIMP(port) && OPOUTFPORTP(port), port, ARG2, s_uve_wr); ASRTGO(NIMP(v), badarg1); len = LENGTH(v); @@ -1180,7 +1180,7 @@ SCM uve_write(v, port) case tc7_smob: v = array_contents(v, BOOL_T); ASRTGO(NIMP(v), badarg1); - if ARRAYP(v) { + if (ARRAYP(v)) { array_dim *d = ARRAY_DIMS(v); start = ARRAY_BASE(v); len = d->inc * (d->ubnd - d->lbnd + 1); @@ -1237,13 +1237,13 @@ SCM lcount(item, seq) i = ubnd/LONG_BIT; imin = lbnd/LONG_BIT; w = VELTS(seq)[i]; - if FALSEP(item) w = ~w; + if (FALSEP(item)) w = ~w; w <<= LONG_BIT-1-(ubnd%LONG_BIT); w >>= LONG_BIT-1-(ubnd%LONG_BIT); /* There may be only a partial word. */ while (imin < i--) { for(;w;w >>= 4) cnt += cnt_tab[w & 0x0f]; w = VELTS(seq)[i]; - if FALSEP(item) w = ~w; + if (FALSEP(item)) w = ~w; } w >>= (lbnd%LONG_BIT); for(;w;w >>= 4) cnt += cnt_tab[w & 0x0f]; @@ -1258,7 +1258,7 @@ SCM lcount(item, seq) n = ARRAY_DIMS(seq)->ubnd - ARRAY_DIMS(seq)->lbnd + 1; if (n<=0) return INUM0; seq = ARRAY_V(seq); - if FALSEP(item) { + if (FALSEP(item)) { for (;n--; i+=inc) if (!((VELTS(seq)[i/LONG_BIT]) & (1L<<(i%LONG_BIT)))) cnt++; } @@ -1300,7 +1300,7 @@ SCM bit_position(item, v, k) lenw = (len-1)/LONG_BIT; /* watch for part words */ i = pos/LONG_BIT; w = VELTS(v)[i]; - if FALSEP(item) w = ~w; + if (FALSEP(item)) w = ~w; xbits = (pos%LONG_BIT); pos -= xbits; w = ((w >> xbits) << xbits); @@ -1319,7 +1319,7 @@ SCM bit_position(item, v, k) if (++i > lenw) break; pos += LONG_BIT; w = VELTS(v)[i]; - if FALSEP(item) w = ~w; + if (FALSEP(item)) w = ~w; } return BOOL_F; case tc7_smob: ASRTGO(ARRAYP(v) && 1==ARRAY_NDIM(v) && !enclosed++, badarg2); @@ -1665,7 +1665,7 @@ SCM list2ura(ndim, prot, lst) aset(ra, CAR(lst), MAKINUM(k)); return ra; } - if NULLP(shp) { + if (NULLP(shp)) { aset(ra, lst, EOL); return ra; } @@ -1693,7 +1693,7 @@ static int l2ra(lst, ra, base, k) base += inc; lst = CDR(lst); } - if NNULLP(lst) return 0; + if (NNULLP(lst)) return 0; } else { while (n--) { @@ -1702,7 +1702,7 @@ static int l2ra(lst, ra, base, k) base += inc; lst = CDR(lst); } - if NNULLP(lst) return 0; + if (NNULLP(lst)) return 0; } return ok; } @@ -1746,7 +1746,7 @@ static void rapr1(ra, j, k, port, writing) } break; } - if ARRAY_NDIM(ra) { /* Could be zero-dimensional */ + if (ARRAY_NDIM(ra)) { /* Could be zero-dimensional */ inc = ARRAY_DIMS(ra)[k].inc; n = (ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1); } @@ -1821,7 +1821,7 @@ int raprin1(exp, port, writing) long ndim = ARRAY_NDIM(v); base = ARRAY_BASE(v); v = ARRAY_V(v); - if ARRAYP(v) { + if (ARRAYP(v)) { lputs("<enclosed-array ", port); rapr1(exp, base, 0, port, writing); lputc('>', port); @@ -1930,13 +1930,13 @@ SCM scm_logaref(args) ASRTER(NIMP(args), UNDEFINED, WNA, s_logaref); ra = CAR(args); ASRTER(NIMP(ra), ra, ARG1, s_logaref); - if ARRAYP(ra) rank = ARRAY_NDIM(ra); + if (ARRAYP(ra)) rank = ARRAY_NDIM(ra); inds = args = CDR(args); for (i = rank; i; i--) { ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref); args = CDR(args); } - if NULLP(args) return aref(ra, inds); + if (NULLP(args)) return aref(ra, inds); ASRTER(NIMP(args) && CONSP(args) && NULLP(CDR(args)), inds, WNA, s_logaref); ASRTER(INUMP(CAR(args)), CAR(args), ARGn, s_logaref); @@ -1964,13 +1964,13 @@ SCM scm_logaset(ra, obj, args) SCM oval, inds, ibit; int i, rank = 1; ASRTER(NIMP(ra), ra, ARG1, s_logaset); - if ARRAYP(ra) rank = ARRAY_NDIM(ra); + if (ARRAYP(ra)) rank = ARRAY_NDIM(ra); inds = args; for (i = rank; i; i--) { ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset); args = CDR(args); } - if NNULLP(args) { + if (NNULLP(args)) { ASRTER(NIMP(args) && CONSP(args) && NULLP(CDR(args)), inds, WNA, s_logaset); ASRTER(INUMP(CAR(args)), CAR(args), ARGn, s_logaset); @@ -96,7 +96,7 @@ SCM scm_acct(path) SCM path; { int val; - if FALSEP(path) { + if (FALSEP(path)) { SYSCALL(val = acct(0);); return val ? BOOL_F : BOOL_T; } diff --git a/version.txi b/version.txi index 5d3bd3e..00ff734 100644 --- a/version.txi +++ b/version.txi @@ -1,2 +1,2 @@ -@set SCMVERSION 5e1 -@set SCMDATE June 2005 +@set SCMVERSION 5e2 +@set SCMDATE February 2006 diff --git a/wbtab.scm b/wbtab.scm new file mode 100644 index 0000000..cf15647 --- /dev/null +++ b/wbtab.scm @@ -0,0 +1,525 @@ +;;; "wbtab.scm" database tables using WB b-trees. +; Copyright 1996, 2000, 2001, 2003 Aubrey Jaffer +; +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, and to use it for any purpose is +;granted, subject to the following restrictions and understandings. +; +;1. Any copy made of this software must include this copyright notice +;in full. +; +;2. I have made no warranty or representation that the operation of +;this software will be error-free, and I am under no obligation to +;provide any services, by way of maintenance, update, or otherwise. +; +;3. In conjunction with products arising from the use of this +;material, there shall be no use of my name in any advertising, +;promotional, or sales literature without prior written consent in +;each case. + +;;;; *catalog* is informed of 'wb-table binding by "scm/mkimpcat.scm". +(require 'wb) +(require 'byte) +(require 'byte-number) +(require 'relational-database) ;for make-relational-system + +;;; WB-SEG:LOCKS has one extra location at end for loop end test +(defvar wb-seg:locks (let ((locks (make-vector (+ 1 wb:num-segs) #f))) + (do ((i (+ -2 (vector-length locks)) (+ -1 i))) + ((negative? i) locks) + (vector-set! locks i (make-arbiter i))))) +(defvar wb-seg:files (make-vector (+ 1 wb:num-segs) #f)) +(defvar wb-seg:roots (make-vector (+ 1 wb:num-segs) #f)) +(defvar wb-seg:mut?s (make-vector (+ 1 wb:num-segs) #f)) +;@ +(define wb-table + ;; foiled indentation so etags will recognize definitions + (let ((make-handle list) + (handle->base-id car) + (handle->bt cadr) + (catalog-id 0) + (free-id "") + (root-name "rwb") + +;;;k30 is a key-coding system where adjacent key fields are separated +;;;by a byte with value in the range 0 (^@=#\nul) to 31 (^_=#\us). +;;;Strings are prefixed with 30 and extend to the the next byte +;;;smaller than 32, or end of the key. Numbers are prefixed by the +;;;string-length of the string representation of the number up to 30. +;;;Unsigned integers with less than 31 digits will thus sort in +;;;numerical order. Larger numbers and strings will sort +;;;lexicographically. +;;; +;;;Use of bytes with values less than 32 in key fields will wedge k30. + + (k30:true (bytes 1 (char->integer #\T))) + (k30:false (bytes 1 (char->integer #\F))) + (k30:s31 (bytes 31)) + (k30:s30 (bytes 30)) + (k30:s1 (bytes 1 (char->integer #\1))) + (k30:s0 (bytes 0))) + +;;;A suffix encoding the field number (with number length prepended) +;;;is appended to composite keys. COL-FIELD computes this field. +;;;k30:s0 and k30:s1 are constants for cases 0 and 1 respectively. +;;;Note that ks30:s0 has no digits! + +(define (k30:incr-key prefix) + (string-append prefix k30:s31)) + +(define (col-field i) + (let ((str (number->string i))) + (string-append (bytes (string-length str)) str))) + +(define (k30:number-keyifier n) + (define str (number->string n)) + (string-append (bytes (min 30 (string-length str))) str)) + +;;; These two NTHCDR procedures replicate those in "comlist.scm". +(define (nthcdr k list) + (do ((i k (+ -1 i)) + (lst list (cdr lst))) + ((<= i 0) lst))) + +(define (butnthcdr k lst) + (cond ((or (zero? k) (null? lst)) '()) + (else (let ((ans (list (car lst)))) + (do ((lst (cdr lst) (cdr lst)) + (tail ans (cdr tail)) + (k (+ -2 k) (+ -1 k))) + ((or (negative? k) (null? lst)) ans) + (set-cdr! tail (list (car lst)))))))) + +;;;; Segments + +(define (find-free-seg) + (do ((i 0 (+ 1 i)) + (arb (vector-ref wb-seg:locks 0) + (vector-ref wb-seg:locks (+ 1 i)))) + ((or (not arb) (try-arbiter arb)) + (and arb i)))) +(define (release-seg seg) + (and seg + (release-arbiter (vector-ref wb-seg:locks seg)) + #f)) + +;;;; Create, open, write, sync, or close database. + +(define (seg-open-base seg filename writable?) + (vector-set! wb-seg:files seg filename) + (vector-set! wb-seg:mut?s seg writable?) + (vector-set! wb-seg:roots seg (open-db seg root-name)) + (cond ((wb:err? (vector-ref wb-seg:roots seg)) + (close-base seg) + #f) + (else seg))) + +;;; Because B-trees grow in depth only very slowly, we might as well +;;; put everything into one B-tree named "rwb". + +(define (make-base filename dim types) + (define seg (find-free-seg)) + (cond ((not seg) #f) + ((wb:err? (make-seg seg filename 2048)) (release-seg seg) #f) + ((wb:err? (open-seg seg filename 2)) (release-seg seg) #f) + ((or (wb:err? (bt:put! (create-db seg #\T root-name) free-id "1")) + (wb:err? (bt:put! (open-bt seg 0 1) "base-table" "wb-table"))) + (release-seg seg) + (slib:error 'make-base "couldn't modify new base" filename) + #f) + (else (seg-open-base seg filename #t)))) + +(define (open-base filename writable?) + (define seg (find-free-seg)) + (cond ((wb:err? (open-seg seg filename (if writable? 2 0))) + (release-seg seg) #f) + (else (seg-open-base seg filename writable?)))) + +(define (write-base seg filename) + (cond ((and filename + (equal? filename (vector-ref wb-seg:files seg))) + (let ((status (close-seg seg #f))) + (cond ((wb:err? status) #f) + ((wb:err? (open-seg seg filename 2)) #f) + (else #t)))) + (else + ;;(slib:error 'write-base "WB can't change database filename" filename) + #f))) + +(define (sync-base seg) + (and seg (write-base seg (vector-ref wb-seg:files seg)))) + +(define (close-base seg) + (cond ((wb:err? (close-seg seg #f)) + (let ((status (close-seg seg #t))) + (release-seg seg) + (not (wb:err? status)))) + (else (release-seg seg) #t))) + +;;;; Make, open, and destroy tables. + +(define (make-table seg dim types) + (and (vector-ref wb-seg:mut?s seg) + (let* ((tns (bt:rem (vector-ref wb-seg:roots seg) free-id)) + (base-id (and (string? tns) (string->number tns)))) + (cond ((not tns) + (slib:error 'make-table 'free-id "in use?") + #f) + ((not base-id) + (bt:put (vector-ref wb-seg:roots seg) free-id tns) + (slib:error 'make-table "free-id corrupted" base-id) + #f) + ((not (bt:put (vector-ref wb-seg:roots seg) + free-id + (number->string (+ 1 base-id)))) + (slib:error 'make-table "free-id lock broken") + #f) + (else base-id))))) + +;;; OPEN-TABLE allocates a new handle (in call to open-db) so each +;;; table handle will have its own last-block-used + +(define (open-table seg base-id dim types) + (define (base-id->prefix base-id) + (define nstr (number->string base-id)) + (string-append (string #\T (integer->char (string-length nstr))) + nstr + (string (integer->char 1) #\D))) + (make-handle (base-id->prefix base-id) + (open-db seg root-name))) + +(define (kill-table seg base-id dim types) + (let* ((handle (open-table seg base-id dim types)) + (prefix (handle->base-id handle))) + (not (wb:err? (bt:rem* (handle->bt handle) + prefix + (k30:incr-key prefix)))))) + +;;;; Conversions from Scheme objects into and from strings. + +(define (object->wb-string type) + (case type + ((string) identity) + ((symbol) symbol->string) + ((integer number ordinal) number->string) + ((boolean) (lambda (b) (if b "Y" "N"))) + ((c64) (lambda (x) (string-append (ieee-double->bytes (real-part x)) + (ieee-double->bytes (imag-part x))))) + ((c32) (lambda (x) (string-append (ieee-float->bytes (real-part x)) + (ieee-float->bytes (imag-part x))))) + ((r64) (lambda (x) (ieee-double->bytes x))) + ((r32) (lambda (x) (ieee-single->bytes x))) + ((s64) (lambda (n) (integer->bytes n -8))) + ((s32) (lambda (n) (integer->bytes n -4))) + ((s16) (lambda (n) (integer->bytes n -2))) + (( s8) (lambda (n) (integer->bytes n -1))) + ((u64) (lambda (n) (integer->bytes n 8))) + ((u32) (lambda (n) (integer->bytes n 4))) + ((u16) (lambda (n) (integer->bytes n 2))) + (( u8) (lambda (n) (integer->bytes n 1))) + ((atom) (lambda (obj) + (cond ((number? obj) (number->string obj)) + ((not obj) "#f") + (else (symbol->string obj))))) + ((expression) (lambda (obj) (call-with-output-string + (lambda (port) (write obj port))))) + (else #f))) + +(define (wb-string->object type) + (case type + ((string) identity) + ((symbol) string->symbol) + ((integer number ordinal) string->number) + ((boolean) (lambda (str) (not (equal? str "N")))) + ((c64) (lambda (str) (make-rectangular + (bytes->ieee-double (substring str 0 8)) + (bytes->ieee-double (substring str 8 16))))) + ((c32) (lambda (str) (make-rectangular + (bytes->ieee-float (substring str 0 4)) + (bytes->ieee-float (substring str 4 8))))) + ((r64) (lambda (str) (bytes->ieee-double str))) + ((r32) (lambda (str) (bytes->ieee-single str))) + ((s64) (lambda (str) (integer->bytes str -8))) + ((s32) (lambda (str) (integer->bytes str -4))) + ((s16) (lambda (str) (integer->bytes str -2))) + (( s8) (lambda (str) (bytes->integer str -1))) + ((u64) (lambda (str) (integer->bytes str 8))) + ((u32) (lambda (str) (integer->bytes str 4))) + ((u16) (lambda (str) (integer->bytes str 2))) + (( u8) (lambda (str) (bytes->integer str 1))) + ((atom) (lambda (str) + (cond ((string->number str)) + ((string-ci=? "#f" str) #f) + (else (string->symbol str))))) + ((expression) (lambda (str) (call-with-input-string str read))) + (else #f))) + +(define (supported-type? type) + (case type + ((ordinal atom integer number boolean string symbol expression + c64 c32 r64 r32 s64 s32 s16 s8 u64 u32 u16 u8) #t) + (else #f))) + +(define (supported-key-type? type) + (case type + ((atom integer number symbol string boolean) #t) + (else #f))) + +;;;; Keys + +;;; unitary composite-key maker +(define (make-keyifier-1 type) + (case type + ((string) (lambda (s) (string-append k30:s30 s))) + ((symbol) (lambda (s) (string-append k30:s30 (symbol->string s)))) + ((integer number ordinal) k30:number-keyifier) + ((boolean) (lambda (b) (if b k30:true k30:false))) + ((atom) (lambda (obj) + (cond ((not obj) k30:false) + ((number? obj) (k30:number-keyifier obj)) + (else (string-append k30:s30 (symbol->string obj)))))) + (else (slib:error 'make-keyifier-1 'unsupported-type type)))) + +;;; composite-key maker +(define (make-list-keyifier prinum types) + (set! types (butnthcdr prinum types)) + ;; Special case when there is just one primary key. + (if (= 1 prinum) + (let ((proc (make-keyifier-1 (car types)))) + (lambda (lst) (proc (car lst)))) + (let ((procs (map make-keyifier-1 types))) + (lambda (lst) + (apply string-append (map (lambda (p v) (p v)) procs lst)))))) + +(define (k30:width type key pos kend) + (define flen (byte-ref key pos)) + (set! pos (+ 1 pos)) + (cond ((= flen 30) + (do ((i pos (+ 1 i))) + ((or (>= i kend) + (<= 0 (byte-ref key i) 30)) + (set! flen (- i pos)))))) + flen) + +;;; extracts one key-field from composite-key +(define (make-key-extractor primary-limit types index) + (define (wbstr->obj type) + (or (wb-string->object type) + (slib:error 'make-key-extractor 'unsupported-type type))) + (let ((proc (wbstr->obj (list-ref types (+ -1 index))))) + (lambda (key) + (define kend (string-length key)) + (let loop ((pos 0) (argind (+ -1 index)) (types types)) + (if (positive? argind) + (loop (+ 1 pos (k30:width (car types) key pos kend)) + (+ -1 argind) + (cdr types)) + (proc (substring key + (+ 1 pos) + (+ 1 pos (k30:width (car types) key pos kend)) + ))))))) + +;;; composite-key to list +(define (make-key->list prinum types) + (define (wbstr->obj type) + (or (wb-string->object type) + (slib:error 'make-key->list 'unsupported-type type))) + (let ((procs (map wbstr->obj (butnthcdr prinum types)))) + (lambda (key) + (define kend (string-length key)) + (let loop ((pos 0) (argind (+ -1 prinum)) (types types) (procs procs)) + (define flen (k30:width (car types) key pos kend)) + (cons ((car procs) (substring key (+ 1 pos) (+ 1 flen pos))) + (if (zero? argind) + '() + (loop (+ 1 flen pos) (+ -1 argind) (cdr types) (cdr procs)))))))) + +;;;; for-each-key, ordered-for-each-key, and map-key + +(define (list-of-false? lst) + (cond ((null? lst) #t) + ((car lst) #f) + (else (list-of-false? (cdr lst))))) + +(define (make-key-match? key-dimension column-types match-keys) + (if (list-of-false? match-keys) + (lambda (ckey) #t) + (let ((keyploder (make-key->list key-dimension column-types))) + (lambda (ckey) + (define (key-match? match-keys keys) + (cond ((null? match-keys) #t) + ((not (car match-keys)) + (key-match? (cdr match-keys) (cdr keys))) + ((equal? (car match-keys) (car keys)) + (key-match? (cdr match-keys) (cdr keys))) + ((not (procedure? (car match-keys))) + #f) + (((car match-keys) (car keys)) + (key-match? (cdr match-keys) (cdr keys))) + (else #f))) + (key-match? match-keys (keyploder ckey)))))) + +(define (ordered-for-each-key + handle operation key-dimension column-types match-keys) + (let* ((bt (handle->bt handle)) + (prefix (handle->base-id handle)) + (pl (string-length prefix)) + (prefix+ (k30:incr-key prefix)) + (key-match? (make-key-match? key-dimension column-types match-keys)) + (maproc + (lambda (k v) + (let ((i (+ -1 (string-length k)))) + (cond ((and (char=? #\1 (string-ref k i)) + (= 1 (byte-ref k (+ -1 i)))) + (and (key-match? (substring k pl (+ -1 i))) + (operation (substring k pl (+ -1 i))))) + ((= 0 (byte-ref k i)) + (and (key-match? (substring k pl i)) + (operation (substring k pl i)))))) + #f))) + (do ((res (bt:scan bt 0 prefix prefix+ maproc 1) + (bt:scan bt 0 (caddr res) prefix+ maproc 1))) + ((not (= -1 (car res))))))) + +(define (map-key handle operation key-dimension column-types match-keys) + (define lst (list 'dummy)) + (let ((tail lst)) + (ordered-for-each-key handle + (lambda (k) + (set-cdr! tail (list (operation k))) + (set! tail (cdr tail))) + key-dimension column-types match-keys) + (cdr lst))) + +;;;; getters and putters + +(define (make-getter prinum types) + (define (wbstr->obj type) + (or (wb-string->object type) + (slib:error 'make-getter 'unsupported-type type))) + (case (- (length types) prinum) + ((0) (lambda (handle key) + (and (bt:get (handle->bt handle) + (string-append (handle->base-id handle) key k30:s0)) + '()))) + ((1) (let ((proc (wbstr->obj (list-ref types prinum)))) + (lambda (handle key) + (define val + (bt:get + (handle->bt handle) + (string-append (handle->base-id handle) key k30:s1))) + (and val (list (proc val)))))) + (else (let ((procs (reverse (map wbstr->obj (nthcdr prinum types))))) + (lambda (handle key) + (let* ((bt (handle->bt handle)) + (prefix (string-append (handle->base-id handle) key)) + (prefix+ (k30:incr-key prefix)) + (lst '()) + (maproc (lambda (k v) (set! lst (cons v lst)) #t))) + (do ((res (bt:scan bt 0 prefix prefix+ maproc 1) + (bt:scan bt 0 (caddr res) prefix+ maproc 1))) + ((not (= -1 (car res))) + (and (not (zero? (cadr res))) + (do ((ps procs (cdr ps)) + (ls lst (cdr ls)) + (rl '() (cons ((car ps) (car ls)) rl))) + ((null? (cdr ls)) + (cons ((car ps) (car ls)) rl)))))))))))) + +(define (make-putter prinum types) + (define (obj->wbstr type) + (or (object->wb-string type) + (slib:error 'make-putter 'unsupported-type type))) + (case (- (length types) prinum) + ((0) (lambda (handle ckey restcols) + (bt:put! (handle->bt handle) + (string-append (handle->base-id handle) ckey k30:s0) + ""))) + ((1) (let ((proc (obj->wbstr (list-ref types prinum)))) + (lambda (handle ckey restcols) + (bt:put! (handle->bt handle) + (string-append (handle->base-id handle) ckey k30:s1) + (proc (car restcols)))))) + (else (let ((procs (map obj->wbstr (nthcdr prinum types)))) + (lambda (handle ckey restcols) + (define i 0) + (for-each + (lambda (proc val) + (set! i (+ 1 i)) + (cond ((wb:err? + (bt:put! (handle->bt handle) + (string-append (handle->base-id handle) + ckey + (col-field i)) + (proc val))) + (slib:error 'putter "couldn't put" + (string-append (handle->base-id handle) + ckey + (col-field i)) + (proc val))))) + procs restcols)))))) + +;;;; other table methods. + +(define (present? handle key) + (let* ((kc (string-append (handle->base-id handle) key)) + (kcl (string-length kc)) + (n (bt:next (handle->bt handle) kc))) + (and n + (<= (+ 1 kcl) (string-length n) (+ 2 kcl)) + (string=? kc (substring n 0 kcl))))) + +(define (delete handle key) + (let ((prefix (string-append (handle->base-id handle) key))) + (not (wb:err? (bt:rem* (handle->bt handle) + prefix + (k30:incr-key prefix)))))) + +(define (delete* handle key-dimension column-types match-keys) + (let ((prefix (string-append (handle->base-id handle) match-keys))) + (not (wb:err? (bt:rem* (handle->bt handle) + prefix + (k30:incr-key prefix)))))) + + (lambda (operation-name) + #+foo ; To trace methods use this wrapper: + ((lambda (proc) + (if (procedure? proc) + (lambda args + (let ((ans (apply proc args))) + (if (procedure? ans) + (tracef ans operation-name) + ans))) + proc)) + ) +;;(trace bt:scan bt:get map-key ordered-for-each-key make-key-extractor make-key->list) (set! *qp-width* 333) ;;(trace-all "rwb-isam.scm") + + (case operation-name + ((make-base) make-base) + ((open-base) open-base) + ((write-base) write-base) + ((sync-base) sync-base) + ((close-base) close-base) + ((make-table) make-table) + ((open-table) open-table) + ((kill-table) kill-table) + ((make-keyifier-1) make-keyifier-1) + ((make-list-keyifier) make-list-keyifier) + ((make-key->list) make-key->list) + ((make-key-extractor) make-key-extractor) + ((supported-type?) supported-type?) + ((supported-key-type?) supported-key-type?) + ((present?) present?) + ((make-putter) make-putter) + ((make-getter) make-getter) + ((delete) delete) + ((delete*) delete*) + ((for-each-key) ordered-for-each-key) + ((map-key) map-key) + ((ordered-for-each-key) ordered-for-each-key) + ((catalog-id) catalog-id) + (else #f))))) + +(set! *base-table-implementations* + (cons (list 'wb-table (make-relational-system wb-table)) + *base-table-implementations*)) @@ -320,7 +320,7 @@ SCM make_xwindow(display, screen_number, win, pxmp, rootp) static SCM mark_xwindow(ptr) SCM ptr; { - if CLOSEDP(ptr) return BOOL_F; + if (CLOSEDP(ptr)) return BOOL_F; return WINDOW(ptr)->display; } static sizet free_xwindow(ptr) @@ -366,7 +366,7 @@ static SCM mark_xcolormap(ptr) SCM ptr; { struct xs_Colormap *xcm; - if CLOSEDP(ptr) return BOOL_F; + if (CLOSEDP(ptr)) return BOOL_F; xcm = COLORMAP(ptr); gc_mark(CCC2SCM_P(XcmsCCCOfColormap(xcm->dpy, xcm->cm))); return xcm->display; @@ -422,7 +422,7 @@ SCM make_xdisplay(d) static SCM mark_xdisplay(ptr) SCM ptr; { - if CLOSEDP(ptr) return BOOL_F; + if (CLOSEDP(ptr)) return BOOL_F; { struct xs_Display *xsd = DISPLAY((SCM)ptr); struct xs_screen *scrns = (struct xs_screen *)(xsd + 1); @@ -524,7 +524,7 @@ SCM make_xcursor(display, cursor) static SCM mark_xcursor(ptr) SCM ptr; { - if CLOSEDP(ptr) return BOOL_F; + if (CLOSEDP(ptr)) return BOOL_F; return CURSOR(ptr)->display; } static sizet free_xcursor(ptr) @@ -601,7 +601,7 @@ SCM CCC2SCM(ccc) XcmsCCC ccc; { SCM s_ccc = CCC2SCM_P(ccc); - if FALSEP(s_ccc) { + if (FALSEP(s_ccc)) { NEWCELL(s_ccc); DEFER_INTS; CAR(s_ccc) = tc16_xccc; @@ -656,9 +656,9 @@ void scm2XPoint(signp, dat, ipr, pos, s_caller) char *pos, *s_caller; { SCM x, y; - if IMP(dat) badarg: wta(dat, pos, s_caller); - if CONSP(dat) { - if INUMP(CDR(dat)) { + if (IMP(dat)) badarg: wta(dat, pos, s_caller); + if (CONSP(dat)) { + if (INUMP(CDR(dat))) { x = CAR(dat); y = CDR(dat); } @@ -706,13 +706,13 @@ int scm2XColor(s_dat, xclr) SCM dat = s_dat; unsigned int ura[3]; int idx; -/* if INUMP(dat) { */ +/* if (INUMP(dat)) { */ /* xclr->red = (dat>>16 & 0x00ff) * 0x0101; */ /* xclr->green = (dat>>8 & 0x00ff) * 0x0101; */ /* xclr->blue = (dat & 0x00ff) * 0x0101; */ /* } */ /* else */ - if IMP(dat) return 0; + if (IMP(dat)) return 0; else if (3==ilength(dat)) for (idx = 0; idx < 3; idx++) { SCM clr = CAR(dat); @@ -754,15 +754,15 @@ void scm2display_screen(dat, optidx, dspscn, s_caller) char *s_caller; { ASRTGO(NIMP(dat), badarg); - if OPDISPLAYP(dat) { + if (OPDISPLAYP(dat)) { dspscn->display = dat; dspscn->dpy = XDISPLAY(dat); - if UNBNDP(optidx) dspscn->screen_number = DefaultScreen(dspscn->dpy); + if (UNBNDP(optidx)) dspscn->screen_number = DefaultScreen(dspscn->dpy); else if (INUMP(optidx) && (INUM(optidx) < DISPLAY(dat)->screen_count)) dspscn->screen_number = INUM(optidx); else wta(optidx, (char *)ARG2, s_caller); } - else if OPWINDOWP(dat) { + else if (OPWINDOWP(dat)) { struct xs_Window *xsw = WINDOW(dat); dspscn->display = xsw->display; dspscn->dpy = xsw->dpy; @@ -1002,7 +1002,7 @@ SCM x_open_display(dpy_name) SCM dpy_name; { Display *display; - if FALSEP(dpy_name) dpy_name = nullstr; + if (FALSEP(dpy_name)) dpy_name = nullstr; ASRTER(NIMP(dpy_name) && STRINGP(dpy_name), dpy_name, ARG1, s_x_open_display); display = XOpenDisplay(CHARS(dpy_name)); return (display ? make_xdisplay(display) : BOOL_F); @@ -1084,14 +1084,14 @@ SCM x_create_pixmap(obj, s_size, s_depth) Drawable drawable; Pixmap p; XPoint size; - if IMP(obj) badarg1: wta(obj, (char *)ARG1, s_x_create_pixmap); - if OPDISPLAYP(obj) { + if (IMP(obj)) badarg1: wta(obj, (char *)ARG1, s_x_create_pixmap); + if (OPDISPLAYP(obj)) { display = obj; dpy = XDISPLAY(display); scn = DefaultScreen(dpy); drawable = RootWindow(dpy, scn); } - else if OPWINDOWP(obj) { + else if (OPWINDOWP(obj)) { display = WINDOW(obj)->display; dpy = XDISPLAY(display); scn = WINDOW(obj)->screen_number; @@ -1200,10 +1200,10 @@ SCM x_close(obj) SCM obj; { ASRTER(NIMP(obj), obj, ARG1, s_x_close); - if WINDOWP(obj) { + if (WINDOWP(obj)) { Display *dpy; ASRTER(!(CAR((SCM)obj) & SCROOT), obj, ARG1, s_x_close); - if CLOSEDP(obj) return UNSPECIFIED; + if (CLOSEDP(obj)) return UNSPECIFIED; DEFER_INTS; dpy = XWINDISPLAY(obj); free_xwindow((CELLPTR)obj); @@ -1263,9 +1263,9 @@ SCM x_install_colormap(s_cm, s_flg) { struct xs_Colormap *xcm; ASRTER(NIMP(s_cm) && COLORMAPP(s_cm), s_cm, ARG1, s_x_install_colormap); - if UNBNDP(s_flg) s_flg = BOOL_T; + if (UNBNDP(s_flg)) s_flg = BOOL_T; xcm = COLORMAP(s_cm); - if FALSEP(s_flg) XUninstallColormap(XDISPLAY(xcm->display), xcm->cm); + if (FALSEP(s_flg)) XUninstallColormap(XDISPLAY(xcm->display), xcm->cm); XInstallColormap(XDISPLAY(xcm->display), xcm->cm); return UNSPECIFIED; } @@ -1310,7 +1310,7 @@ SCM x_alloc_color_cells(scmap, spxls, sargs) if (scm2XColor(CAR(sargs), &xclr)) { unsigned long rmask_return, gmask_return, bmask_return; sargs = CDR(sargs); - if NNULLP(sargs) contig = thebool(CAR(sargs), s_x_alloc_color_cells); + if (NNULLP(sargs)) contig = thebool(CAR(sargs), s_x_alloc_color_cells); sts = XAllocColorPlanes(xcm->dpy, xcm->cm, contig, VELTS(pxra), npixels, xclr.red, xclr.green, xclr.blue, @@ -1322,7 +1322,7 @@ SCM x_alloc_color_cells(scmap, spxls, sargs) } nplanes = theuint(CAR(sargs), s_x_alloc_color_cells); sargs = CDR(sargs); - if NNULLP(sargs) contig = thebool(CAR(sargs), s_x_alloc_color_cells); + if (NNULLP(sargs)) contig = thebool(CAR(sargs), s_x_alloc_color_cells); plra = make_uve(nplanes, MAKINUM(32L)); /* Uniform vector of long */ sts = XAllocColorCells(xcm->dpy, xcm->cm, contig, VELTS(plra), nplanes, VELTS(pxra), npixels); @@ -1607,7 +1607,7 @@ SCM x_create_cursor(sdpy, scsr, sargs) int sts; source_font = thefont(sdpy, s_x_create_cursor); GET_NEXT_INT(source_char, sargs, ARG2, s_x_create_cursor); - if FALSEP(CAR(sargs)) { + if (FALSEP(CAR(sargs))) { sargs = CDR(sargs); ASRTER(FALSEP(CAR(sargs)), sargs, ARG4, s_x_create_cursor); sargs = CDR(sargs); @@ -2110,7 +2110,7 @@ SCM x_draw_points(sdbl, sgc, sargs) ASRTER(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_x_draw_points); ASRTER(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_x_draw_points); loop: - if NULLP(sargs) return UNSPECIFIED; + if (NULLP(sargs)) return UNSPECIFIED; sarg = CAR(sargs); sargs = CDR(sargs); if (INUMP(sarg)) { ASRTER(NNULLP(sargs), sargs, WNA, s_x_draw_points); @@ -2144,7 +2144,7 @@ SCM xldraw_lines(sdbl, sgc, sargs, funcod, s_caller) ASRTER(NIMP(sdbl) && WINDOWP(sdbl), sdbl, ARG1, s_caller); ASRTER(NIMP(sgc) && GCONTEXTP(sgc), sgc, ARG2, s_caller); loop: - if NULLP(sargs) return UNSPECIFIED; + if (NULLP(sargs)) return UNSPECIFIED; sarg = CAR(sargs); sargs = CDR(sargs); if (INUMP(sarg)) { ASRTER(NNULLP(sargs), sargs, WNA, s_caller); @@ -2302,7 +2302,7 @@ static int print_xdisplay(exp, f, writing) SCM f; int writing; { - if CLOSEDP(exp) lputs("#<closed-X display>", f); + if (CLOSEDP(exp)) lputs("#<closed-X display>", f); else { lputs("#<X display \"", f); lputs(DisplayString(XDISPLAY(exp)), f); |